      SUBROUTINE DPLAB(IANS,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
CCCCC SUBROUTINE DPLAB(IANS,IWIDTH,IHARG,IHARG2,NUMARG, SEPT 1993
CCCCC SUBROUTINE DPLAB(IANS,IWIDTH,IHARG,NUMARG,
CCCCC THE ABOVE LINE WAS AUGMENTED AUGUST 1992
CCCCC THE FOLLOWING 5 LINES WERE AUGMENTED AUGUST 1992
CCCCC1IX1LTE,NCX1LA,
CCCCC1IX2LTE,NCX2LA,
CCCCC1IX3LTE,NCX3LA,
CCCCC1IY1LTE,NCY1LA,
CCCCC1IY2LTE,NCY2LA,
     1IX1LTE,NCX1LA,IX1AUT,
     1IX2LTE,NCX2LA,IX2AUT,
     1IX3LTE,NCX3LA,IX3AUT,
     1IY1LTE,NCY1LA,IY1AUT,
     1IY2LTE,NCY2LA,IY2AUT,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--EXTRACT THE STRING TO BE USED AS ONE
C              ON THE 5 LABELS AVAILABLE AROUND A PLOT--
C                 1 TO THE LEFT  OF THE LEFT  VERTICAL FRAME LINE;
C                 1 TO THE RIGHT OF THE RIGHT VERTICAL FRAME LINE;
C                 3 BELOW THE BOTTOM HORIZONTAL FRAME LINE.
C     INPUT  ARGUMENTS--IANS   (A  CHARACTER VECTOR)
C                     --IWIDTH
C                     --IHARG  (A  CHARACTER VECTOR)
C                     --IHARG2  (A  CHARACTER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--ILX1TE (A CHARACTER ARRAY
C                       CONTAINING THE FIRST  HORIZONTAL LABEL).
C                     --NCX1LA (AN INTEGER VARIABLE
C                       CONTAINING THE NUMBER OF CHARACTERS IN ILX1TE).
C                     --ILX2TE (A CHARACTER ARRAY
C                       CONTAINING THE SECOND HORIZONTAL LABEL).
C                     --NCX2LA (AN INTEGER VARIABLE
C                       CONTAINING THE NUMBER OF CHARACTERS IN ILX2TE).
C                     --ILX3TE (A CHARACTER ARRAY
C                       CONTAINING THE THIRD HORIZONTAL LABEL).
C                     --NCX3LA (AN INTEGER VARIABLE
C                       CONTAINING THE NUMBER OF CHARACTERS IN ILX3TE).
C                     --ILY1TE (A CHARACTER ARRAY
C                       CONTAINING THE FIRST VERTICAL LABEL).
C                     --NCY1LA (AN INTEGER VARIABLE
C                       CONTAINING THE NUMBER OF CHARACTERS IN ILY1TE).
C                     --ILY2TE (A CHARACTER ARRAY
C                       CONTAINING THE SECOND VERTICAL LABEL).
C                     --NCY2LA (AN INTEGER VARIABLE
C                       CONTAINING THE NUMBER OF CHARACTERS IN ILY2TE).
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--JANUARY    1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --AUGUST    1992. ADD SWITCHES FOR AUTOMATIC
C     UPDATED         --SEPTEMBER 1993. ALLOW LOWER CASE
C     UPDATED         --SEPTEMBER 1993. ACTIVATE   LABEL AUTOMATIC
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
CCCCC THE FOLLOWING LINE WAS CHANGED     SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
      CHARACTER*4 IHARG2
C
      CHARACTER*4 IX1LTE
      CHARACTER*4 IX2LTE
      CHARACTER*4 IX3LTE
      CHARACTER*4 IY1LTE
      CHARACTER*4 IY2LTE
C
CCCCC FOLLOWING LINES ADDED AUGUST 1992.
      CHARACTER*4 IX1AUT
      CHARACTER*4 IX2AUT
      CHARACTER*4 IX3AUT
      CHARACTER*4 IY1AUT
      CHARACTER*4 IY2AUT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ILABT
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
CCCCC THE FOLLOWING LINE WAS CHANGED     SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
      DIMENSION IANSLC(*)
      DIMENSION IHARG(*)
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
      DIMENSION IHARG2(*)
C
      DIMENSION IX1LTE(*)
      DIMENSION IX2LTE(*)
      DIMENSION IX3LTE(*)
      DIMENSION IY1LTE(*)
      DIMENSION IY2LTE(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGP2.NE.'ON')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPLAB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NCX1LA,NCX2LA,NCX3LA,NCY1LA,NCY2LA
   53 FORMAT('NCX1LA,NCX2LA,NCX3LA,NCY1LA,NCY2LA = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)(IX1LTE(I),I=1,NCX1LA)
   61 FORMAT('(IX1LTE(I),I=1,NCX1LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)(IX2LTE(I),I=1,NCX2LA)
   62 FORMAT('(IX2LTE(I),I=1,NCX2LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)(IX3LTE(I),I=1,NCX3LA)
   63 FORMAT('(IX3LTE(I),I=1,NCX3LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)(IY1LTE(I),I=1,NCY1LA)
   64 FORMAT('(IY1LTE(I),I=1,NCY1LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)(IY2LTE(I),I=1,NCY2LA)
   65 FORMAT('(IY2LTE(I),I=1,NCY2LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************************
C               **  STEP 1--                               **
C               **  DETERMINE THE COMMAND                  **
C               **  (       YLABEL = Y1LABEL, Y2LABEL,     **
C               **  XLABEL = X1LABEL, X2LABEL, X3LABEL)    **
C               *********************************************
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COLO')GOTO9000
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'COLO')GOTO9000
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'SIZE')GOTO9000
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'SIZE')GOTO9000
C
      DO1000I=1,IWIDTH
      I2=I
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IF(IANS(I).EQ.'Y'.AND.IANS(IP1).EQ.'L'
     1.AND.IANS(IP2).EQ.'A'.AND.IANS(IP3).EQ.'B'
     1.AND.IANS(IP4).EQ.'E'.AND.IANS(IP5).EQ.'L'
     1.AND.IANS(IP6).EQ.' ')
     1GOTO110
      IF(IANS(I).EQ.'Y'.AND.IANS(IP1).EQ.'1'
     1.AND.IANS(IP2).EQ.'L'.AND.IANS(IP3).EQ.'A'
     1.AND.IANS(IP4).EQ.'B'.AND.IANS(IP5).EQ.'E'
     1.AND.IANS(IP6).EQ.'L')
     1GOTO115
      IF(IANS(I).EQ.'Y'.AND.IANS(IP1).EQ.'2'
     1.AND.IANS(IP2).EQ.'L'.AND.IANS(IP3).EQ.'A'
     1.AND.IANS(IP4).EQ.'B'.AND.IANS(IP5).EQ.'E'
     1.AND.IANS(IP6).EQ.'L')
     1GOTO125
      IF(IANS(I).EQ.'X'.AND.IANS(IP1).EQ.'L'
     1.AND.IANS(IP2).EQ.'A'.AND.IANS(IP3).EQ.'B'
     1.AND.IANS(IP4).EQ.'E'.AND.IANS(IP5).EQ.'L'
     1.AND.IANS(IP6).EQ.' ')
     1GOTO210
      IF(IANS(I).EQ.'X'.AND.IANS(IP1).EQ.'1'
     1.AND.IANS(IP2).EQ.'L'.AND.IANS(IP3).EQ.'A'
     1.AND.IANS(IP4).EQ.'B'.AND.IANS(IP5).EQ.'E'
     1.AND.IANS(IP6).EQ.'L')
     1GOTO215
      IF(IANS(I).EQ.'X'.AND.IANS(IP1).EQ.'2'
     1.AND.IANS(IP2).EQ.'L'.AND.IANS(IP3).EQ.'A'
     1.AND.IANS(IP4).EQ.'B'.AND.IANS(IP5).EQ.'E'
     1.AND.IANS(IP6).EQ.'L')
     1GOTO225
      IF(IANS(I).EQ.'X'.AND.IANS(IP1).EQ.'3'
     1.AND.IANS(IP2).EQ.'L'.AND.IANS(IP3).EQ.'A'
     1.AND.IANS(IP4).EQ.'B'.AND.IANS(IP5).EQ.'E'
     1.AND.IANS(IP6).EQ.'L')
     1GOTO235
C
      IF(IANS(I).EQ.'L'.AND.IANS(IP1).EQ.'A'
     1.AND.IANS(IP2).EQ.'B'.AND.IANS(IP3).EQ.'E'
     1.AND.IANS(IP4).EQ.'L'.AND.IANS(IP5).EQ.' ')
     1GOTO240
      IF(IANS(I).EQ.'L'.AND.IANS(IP1).EQ.'A'
     1.AND.IANS(IP2).EQ.'B'.AND.IANS(IP3).EQ.'E'
     1.AND.IANS(IP4).EQ.'L'.AND.IANS(IP5).EQ.'S')
     1GOTO245
C
 1000 CONTINUE
      WRITE(ICOUT,1001)
 1001 FORMAT('***** ERROR IN DPLAB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1002)
 1002 FORMAT('      NO MATCH FOR COMMAND.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               **********************************************************
C               **  STEP 2--                                            **
C               **  DEFINE THE START POSITION (ISTART) FOR THE STRING.  **
C               **********************************************************
C
  110 CONTINUE
      ISTART=I2+7
      ILABT='Y'
      GOTO300
  115 CONTINUE
      ISTART=I2+8
      ILABT='Y1'
      GOTO300
  125 CONTINUE
      ISTART=I2+8
      ILABT='Y2'
      GOTO300
  210 CONTINUE
      ISTART=I2+7
      ILABT='X1'
      GOTO300
  215 CONTINUE
      ISTART=I2+8
      ILABT='X1'
      GOTO300
  225 CONTINUE
      ISTART=I2+8
      ILABT='X2'
      GOTO300
  235 CONTINUE
      ISTART=I2+8
      ILABT='X3'
      GOTO300
  240 CONTINUE
      ISTART=I2+6
      ILABT='ALL'
      GOTO300
  245 CONTINUE
      ISTART=I2+7
      ILABT='ALL'
      GOTO300
C
C               ********************************************************
C               **  STEP 3--                                          **
C               **  DEFINE THE STOP POSITION (ISTOP) FOR THE STRING.  **
C               ********************************************************
C
  300 CONTINUE
      ISTOP=0
      IF(ISTART.GT.IWIDTH)GOTO329
      DO320I=ISTART,IWIDTH
      IREV=IWIDTH-I+ISTART
      IF(IANS(IREV).NE.' ')GOTO325
  320 CONTINUE
      GOTO329
  325 CONTINUE
      ISTOP=IREV
  329 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  COPY OVER THE STRING OF INTEREST.  **
C               *****************************************
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ON')GOTO359
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'OFF')GOTO359
CCCCC IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO')GOTO359
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DEFA')GOTO359
      IF(NUMARG.EQ.0)GOTO359
C
      IF(ISTART.GT.ISTOP)GOTO359
      IF(ISTOP.EQ.0)GOTO359
      J=0
      DO350I=ISTART,ISTOP
      J=J+1
C
CCCCC THE FOLLOWING LINES WERE CHANGED   SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
CCCCC IF(ILABT.EQ.'Y1')IY1LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'Y2')IY2LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'X1')IX1LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'X2')IX2LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'X3')IX3LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'Y')IY1LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'Y')IY2LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'ALL')IY1LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'ALL')IY2LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'ALL')IX1LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'ALL')IX2LTE(J)=IANS(I)
CCCCC IF(ILABT.EQ.'ALL')IX3LTE(J)=IANS(I)
C
      IF(ILABT.EQ.'Y1')IY1LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'Y2')IY2LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'X1')IX1LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'X2')IX2LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'X3')IX3LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'Y')IY1LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'Y')IY2LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'ALL')IY1LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'ALL')IY2LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'ALL')IX1LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'ALL')IX2LTE(J)=IANSLC(I)
      IF(ILABT.EQ.'ALL')IX3LTE(J)=IANSLC(I)
C
  350 CONTINUE
C
      IF(ILABT.EQ.'Y1')NCY1LA=J
      IF(ILABT.EQ.'Y2')NCY2LA=J
      IF(ILABT.EQ.'X1')NCX1LA=J
      IF(ILABT.EQ.'X2')NCX2LA=J
      IF(ILABT.EQ.'X3')NCX3LA=J
      IF(ILABT.EQ.'Y')NCY1LA=J
      IF(ILABT.EQ.'Y')NCY2LA=J
      IF(ILABT.EQ.'ALL')NCY1LA=J
      IF(ILABT.EQ.'ALL')NCY2LA=J
      IF(ILABT.EQ.'ALL')NCX1LA=J
      IF(ILABT.EQ.'ALL')NCX2LA=J
      IF(ILABT.EQ.'ALL')NCX3LA=J
C
      GOTO800
  359 CONTINUE
C
C               ************************************
C               **  STEP 5--                      **
C               **  TREAT THE EMPTY-STRING CASE.  **
C               ************************************
C
      IF(ILABT.EQ.'Y1')NCY1LA=0
      IF(ILABT.EQ.'Y2')NCY2LA=0
      IF(ILABT.EQ.'X1')NCX1LA=0
      IF(ILABT.EQ.'X2')NCX2LA=0
      IF(ILABT.EQ.'X3')NCX3LA=0
      IF(ILABT.EQ.'Y')NCY1LA=0
      IF(ILABT.EQ.'Y')NCY2LA=0
      IF(ILABT.EQ.'ALL')NCY1LA=0
      IF(ILABT.EQ.'ALL')NCY2LA=0
      IF(ILABT.EQ.'ALL')NCX1LA=0
      IF(ILABT.EQ.'ALL')NCX2LA=0
      IF(ILABT.EQ.'ALL')NCX3LA=0
      GOTO800
C
C               ***************************
C               **  STEP 6--             **
C               **  PRINT OUT A MESSAGE  **
C               ***************************
C
  800 CONTINUE
      IF(ILABT.EQ.'Y1')GOTO810
      IF(ILABT.EQ.'Y2')GOTO820
      IF(ILABT.EQ.'X1')GOTO830
      IF(ILABT.EQ.'X2')GOTO840
      IF(ILABT.EQ.'X3')GOTO850
      IF(ILABT.EQ.'Y')GOTO860
      IF(ILABT.EQ.'ALL')GOTO870
C
  810 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING 6 LINES WERE ADDED AUGUST 1992
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND.
     1IHARG2(1).EQ.'MATI')THEN
         IY1AUT='ON'
      ELSE
         IY1AUT='OFF'
      ENDIF
      IF(IFEEDB.EQ.'OFF')GOTO819
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,811)
  811 FORMAT('THE LEFT   VERTICAL AXIS LABEL HAS JUST BEEN ',
     1'SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCY1LA.EQ.0)WRITE(ICOUT,999)
      IF(NCY1LA.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NCY1LA.GE.1)WRITE(ICOUT,812)(IY1LTE(I),I=1,NCY1LA)
  812 FORMAT(11X,119A1)
      IF(NCY1LA.GE.1)CALL DPWRST('XXX','BUG ')
  819 CONTINUE
      GOTO9000
C
  820 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING 6 LINES WERE ADDED AUGUST 1992
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND.
     1IHARG2(1).EQ.'MATI')THEN
         IY2AUT='ON'
      ELSE
         IY2AUT='OFF'
      ENDIF
      IF(IFEEDB.EQ.'OFF')GOTO829
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,821)
      CALL DPWRST('XXX','BUG ')
      IF(NCY2LA.EQ.0)WRITE(ICOUT,999)
      IF(NCY2LA.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NCY2LA.GE.1)WRITE(ICOUT,822)(IY2LTE(I),I=1,NCY2LA)
  821 FORMAT('THE RIGHT  VERTICAL AXIS LABEL HAS JUST BEEN ',
     1'SET TO')
      IF(NCY2LA.GE.1)CALL DPWRST('XXX','BUG ')
  822 FORMAT(11X,119A1)
  829 CONTINUE
      GOTO9000
C
  830 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING 6 LINES WERE ADDED AUGUST 1992
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND.
     1IHARG2(1).EQ.'MATI')THEN
         IX1AUT='ON'
      ELSE
         IX1AUT='OFF'
      ENDIF
      IF(IFEEDB.EQ.'OFF')GOTO839
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,831)
  831 FORMAT('THE FIRST  HORIZONTAL AXIS LABEL HAS JUST BEEN ',
     1'SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCX1LA.EQ.0)WRITE(ICOUT,999)
      IF(NCX1LA.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NCX1LA.GE.1)WRITE(ICOUT,832)(IX1LTE(I),I=1,NCX1LA)
  832 FORMAT(11X,119A1)
      IF(NCX1LA.GE.1)CALL DPWRST('XXX','BUG ')
  839 CONTINUE
      GOTO9000
C
  840 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING 6 LINES WERE ADDED AUGUST 1992
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND.
     1IHARG2(1).EQ.'MATI')THEN
         IX2AUT='ON'
      ELSE
         IX2AUT='OFF'
      ENDIF
      IF(IFEEDB.EQ.'OFF')GOTO849
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,841)
  841 FORMAT('THE SECOND HORIZONTAL AXIS LABEL HAS JUST BEEN ',
     1'SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCX2LA.EQ.0)WRITE(ICOUT,999)
      IF(NCX2LA.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NCX2LA.GE.1)WRITE(ICOUT,842)(IX2LTE(I),I=1,NCX2LA)
  842 FORMAT(11X,119A1)
      IF(NCX2LA.GE.1)CALL DPWRST('XXX','BUG ')
  849 CONTINUE
      GOTO9000
C
  850 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING 6 LINES WERE ADDED AUGUST 1992
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND.
     1IHARG2(1).EQ.'MATI')THEN
         IX3AUT='ON'
      ELSE
         IX3AUT='OFF'
      ENDIF
      IF(IFEEDB.EQ.'OFF')GOTO859
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,851)
  851 FORMAT('THE THIRD  HORIZONTAL AXIS LABEL HAS JUST BEEN ',
     1'SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCX3LA.EQ.0)WRITE(ICOUT,999)
      IF(NCX3LA.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NCX3LA.GE.1)WRITE(ICOUT,852)(IX3LTE(I),I=1,NCX3LA)
  852 FORMAT(11X,119A1)
      IF(NCX3LA.GE.1)CALL DPWRST('XXX','BUG ')
  859 CONTINUE
      GOTO9000
C
  860 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING 8 LINES WERE ADDED AUGUST 1992
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND.
     1IHARG2(1).EQ.'MATI')THEN
         IY1AUT='ON'
         IY2AUT='ON'
      ELSE
         IY1AUT='OFF'
         IY2AUT='OFF'
      ENDIF
      IF(IFEEDB.EQ.'OFF')GOTO869
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,861)
  861 FORMAT('THE LEFT AND RIGHT VERTICAL AXIS LABELS ',
     1'HAVE JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCY1LA.EQ.0)WRITE(ICOUT,999)
      IF(NCY1LA.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NCY1LA.GE.1)WRITE(ICOUT,862)(IY1LTE(I),I=1,NCY1LA)
  862 FORMAT(11X,119A1)
      IF(NCY1LA.GE.1)CALL DPWRST('XXX','BUG ')
  869 CONTINUE
      GOTO9000
C
  870 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING 14 LINES WERE ADDED AUGUST 1992
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND.
     1IHARG2(1).EQ.'MATI')THEN
         IY1AUT='ON'
         IY2AUT='ON'
         IX1AUT='ON'
         IX2AUT='ON'
         IX3AUT='ON'
      ELSE
         IY1AUT='OFF'
         IY2AUT='OFF'
         IX1AUT='OFF'
         IX2AUT='OFF'
         IX3AUT='OFF'
      ENDIF
CCCCC THE FOLLOWING LINES WERE COMMENTED OUT   SEPTEMBER 1993
CCCCC IY1AUT='OFF'
CCCCC IY2AUT='OFF'
CCCCC IX1AUT='OFF'
CCCCC IX2AUT='OFF'
CCCCC IX3AUT='OFF'
      IF(IFEEDB.EQ.'OFF')GOTO879
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,871)
  871 FORMAT('ALL 5 LABELS (THE 2 VERTICAL AND THE 3 BOTTOM ',
     1'HORIZONTAL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,872)
  872 FORMAT('HAVE JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCY1LA.EQ.0)WRITE(ICOUT,999)
      IF(NCY1LA.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NCY1LA.GE.1)WRITE(ICOUT,873)(IY1LTE(I),I=1,NCY1LA)
  873 FORMAT(11X,119A1)
      IF(NCY1LA.GE.1)CALL DPWRST('XXX','BUG ')
  879 CONTINUE
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT      **
C               ****************
C
 9000 CONTINUE
      IF(IBUGP2.NE.'ON')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPLAB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NCX1LA,NCX2LA,NCX3LA,NCY1LA,NCY2LA
 9013 FORMAT('NCX1LA,NCX2LA,NCX3LA,NCY1LA,NCY2LA = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)(IX1LTE(I),I=1,NCX1LA)
 9021 FORMAT('(IX1LTE(I),I=1,NCX1LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)(IX2LTE(I),I=1,NCX2LA)
 9022 FORMAT('(IX2LTE(I),I=1,NCX2LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)(IX3LTE(I),I=1,NCX3LA)
 9023 FORMAT('(IX3LTE(I),I=1,NCX3LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)(IY1LTE(I),I=1,NCY1LA)
 9024 FORMAT('(IY1LTE(I),I=1,NCY1LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)(IY2LTE(I),I=1,NCY2LA)
 9025 FORMAT('(IY2LTE(I),I=1,NCY2LA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLAAN(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFAN,
     1PX1LAN,PX2LAN,PX3LAN,PY1LAN,PY2LAN,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL ANGLES
C              FOR ANY OF THE 5 LABELS.
C              THE LABEL ANGLE SWITCHES FOR THE LABELS
C              ARE CONTAINED IN THE VARIABLES--
C                    PX1LAN,PX2LAN,PX3LAN,PY1LAN,PY2LAN
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --PDEFAN (DEFAULT ANGLE)
C     OUTPUT ARGUMENTS--PX1LAN,
C                       PX2LAN,
C                       PX3LAN,
C                       PY1LAN,
C                       PY2LAN
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--99/11
C     ORIGINAL VERSION--NOVEMBER  1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'ANGL')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IERROR='YES'
      GOTO9000
C
 1150 CONTINUE
      HOLD1=PDEFAN
      GOTO1180
C
 1160 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1LAN=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL ANGLE (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)HOLD1
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1250
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
      IERROR='YES'
      GOTO9000
C
 1250 CONTINUE
      HOLD1=PDEFAN
      GOTO1280
C
 1260 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX2LAN=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL ANGLE (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)HOLD1
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1350
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
      IERROR='YES'
      GOTO9000
C
 1350 CONTINUE
      HOLD1=PDEFAN
      GOTO1380
C
 1360 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX3LAN=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL ANGLE (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)HOLD1
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1450
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
      IERROR='YES'
      GOTO9000
C
 1450 CONTINUE
      HOLD1=90.0
      GOTO1480
C
 1460 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1LAN=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL ANGLE (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)HOLD1
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1550
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
      IERROR='YES'
      GOTO9000
C
 1550 CONTINUE
      HOLD1=90.0
      GOTO1580
C
 1560 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY2LAN=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL ANGLE (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)HOLD1
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH VERTICAL AXIS LABELS ARE TO BE CHANGED             **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1650
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
      IERROR='YES'
      GOTO9000
C
 1650 CONTINUE
      HOLD1=90.0
      GOTO1680
C
 1660 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY1LAN=HOLD1
      PY2LAN=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL ANGLE (FOR THE LEFT AND RIGHT VERTICAL ',
     1'LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)HOLD1
 1682 FORMAT('HAVE JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1750
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
      IERROR='YES'
      GOTO9000
C
 1750 CONTINUE
      HOLD1=PDEFAN
      HOLD2=90.0
      GOTO1780
C
 1760 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PX1LAN=HOLD1
      PX2LAN=HOLD1
      PX3LAN=HOLD1
      PY1LAN=HOLD2
      PY2LAN=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL ANGLE FOR ALL 3 HORIZONTAL LABELS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)HOLD1
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1786)
 1786 FORMAT('THE LABEL ANGLE FOR BOTH VERTICAL LABELS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1787)HOLD2
 1787 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPLACA(ICOM,IHARG,NUMARG,
     1IDEFCA,
     1IX1LCA,IX2LCA,IX3LCA,IY1LCA,IY2LCA,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL CASE SWITCHES
C              FOR ANY OF THE 5 LABELS.
C              SUCH LABEL CASE SWITCHES DEFINE THE CASE
C              FOR EACH OF THE 5 LABELS.
C              THE CONTENTS OF A LABEL CASE SWITCH ARE
C              A CASE.
C              THE LABEL CASE SWITCHES FOR THE 5 LABELS
C              ARE CONTAINED IN IX1LCA,IX2LCA,IX3LCA,IY1LCA,IY2LCA.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCA
C     OUTPUT ARGUMENTS--IX1LCA (A HOLLERITH VARIABLE
C                       DENOTING THE CASE OF THE FIRST HORIZ. LABEL
C                     --IX2LCA (A HOLLERITH VARIABLE
C                       DENOTING THE CASE OF THE SECOND HORIZ. LABEL
C                     --IX3LCA (A HOLLERITH VARIABLE
C                       DENOTING THE CASE OF THE THIRD HORIZ. LABEL
C                     --IY1LCA (A HOLLERITH VARIABLE
C                       DENOTING THE CASE OF THE FIRST VERT. LABEL
C                     --IY2LCA (A HOLLERITH VARIABLE
C                       DENOTING THE CASE OF THE SECOND VERT. LABEL
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFCA
C
      CHARACTER*4 IX1LCA
      CHARACTER*4 IX2LCA
      CHARACTER*4 IX3LCA
      CHARACTER*4 IY1LCA
      CHARACTER*4 IY2LCA
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CASE')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'CASE')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFCA
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1LCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL CASE (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFCA
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX2LCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL CASE (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFCA
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX3LCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL CASE (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFCA
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1LCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL CASE (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFCA
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY2LCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL CASE (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH LEFT AND RIGHT VERTICAL LABELS ARE TO BE CHANGED   **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFCA
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY1LCA=IHOLD
      IY2LCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL CASE (FOR THE LEFT AND RIGHT VERTICAL ',
     1'LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFCA
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IY1LCA=IHOLD
      IY2LCA=IHOLD
      IX1LCA=IHOLD
      IX2LCA=IHOLD
      IX3LCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL CASE (FOR ALL 5 ',
     1'LABELS--3 HORIZONTAL AND 2 VERTICAL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPLACL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IX1LCO,IX2LCO,IX3LCO,IY1LCO,IY2LCO,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL COLOR SWITCHES
C              FOR ANY OF THE 5 LABELS.
C              SUCH LABEL COLOR SWITCHES DEFINE THE COLOR
C              FOR EACH OF THE 5 LABELS.
C              THE CONTENTS OF A LABEL COLOR SWITCH ARE
C              A COLOR.
C              THE LABEL COLOR SWITCHES FOR THE 5 LABELS
C              ARE CONTAINED IN IX1LCO,IX2LCO,IX3LCO,IY1LCO,IY2LCO.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C     OUTPUT ARGUMENTS--IX1LCO (A HOLLERITH VARIABLE
C                       DENOTING THE COLOR OF THE FIRST HORIZ. LABEL
C                     --IX2LCO (A HOLLERITH VARIABLE
C                       DENOTING THE COLOR OF THE SECOND HORIZ. LABEL
C                     --IX3LCO (A HOLLERITH VARIABLE
C                       DENOTING THE COLOR OF THE THIRD HORIZ. LABEL
C                     --IY1LCO (A HOLLERITH VARIABLE
C                       DENOTING THE COLOR OF THE FIRST VERT. LABEL
C                     --IY2LCO (A HOLLERITH VARIABLE
C                       DENOTING THE COLOR OF THE SECOND VERT. LABEL
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFCO
C
      CHARACTER*4 IX1LCO
      CHARACTER*4 IX2LCO
      CHARACTER*4 IX3LCO
      CHARACTER*4 IY1LCO
      CHARACTER*4 IY2LCO
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'COLO')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFCO
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1LCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL COLOR (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFCO
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX2LCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL COLOR (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFCO
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX3LCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL COLOR (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFCO
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1LCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL COLOR (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFCO
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY2LCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL COLOR (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH LEFT AND RIGHT VERTICAL LABELS ARE TO BE CHANGED   **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFCO
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY1LCO=IHOLD
      IY2LCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL COLOR (FOR THE LEFT AND RIGHT VERTICAL ',
     1'LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFCO
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IY1LCO=IHOLD
      IY2LCO=IHOLD
      IX1LCO=IHOLD
      IX2LCO=IHOLD
      IX3LCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL COLOR (FOR ALL 5 ',
     1'LABELS--3 HORIZONTAL AND 2 VERTICAL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPLADI(ICOM,IHARG,NUMARG,
     1IDEFDI,
     1IX1LDI,IX2LDI,IX3LDI,IY1LDI,IY2LDI,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL DIRECTION SWITCHES
C              FOR ANY OF THE 5 LABELS.
C              SUCH LABEL DIRECTION SWITCHES DEFINE THE
C              DIRECTION FOR EACH OF THE 5 LABELS.
C              THE CONTENTS OF A LABEL DIRECTION SWITCH ARE
C              A DIRECTION.
C              THE LABEL DIRECTION SWITCHES FOR THE 5 LABELS
C              ARE CONTAINED IN IX1LDI,IX2LDI,IX3LDI,IY1LDI,IY2LDI.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFO
C     OUTPUT ARGUMENTS--IX1LDI (A HOLLERITH VARIABLE
C                       DENOTING THE DIRECTION OF THE FIRST HORIZ. LABEL
C                     --IX2LDI (A HOLLERITH VARIABLE
C                       DENOTING THE DIRECTION OF THE SECOND HORIZ. LABEL
C                     --IX3LDI (A HOLLERITH VARIABLE
C                       DENOTING THE DIRECTION OF THE THIRD HORIZ. LABEL
C                     --IY1LDI (A HOLLERITH VARIABLE
C                       DENOTING THE DIRECTION OF THE FIRST VERT. LABEL
C                     --IY2LDI (A HOLLERITH VARIABLE
C                       DENOTING THE DIRECTION OF THE SECOND VERT. LABEL
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--99/10
C     ORIGINAL VERSION--OCTOBER   1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFDI
C
      CHARACTER*4 IX1LDI
      CHARACTER*4 IX2LDI
      CHARACTER*4 IX3LDI
      CHARACTER*4 IY1LDI
      CHARACTER*4 IY2LDI
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
      CHARACTER*4 IHOL2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DIRE')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'DIRE')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFDI
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1LDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL DIRECTION (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFDI
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX2LDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL DIRECTION (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFDI
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX3LDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL DIRECTION (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD='VERT'
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1LDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL DIRECTION (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD='VERT'
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY2LDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL DIRECTION (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH LEFT AND RIGHT VERTICAL LABELS ARE TO BE CHANGED   **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD='VERT'
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY1LDI=IHOLD
      IY2LDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL DIRECTION (FOR THE LEFT AND RIGHT  ',
     1'VERTICAL LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFDI
      IHOL2='VERT'
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      IHOL2=IHOLD
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IY1LDI=IHOL2
      IY2LDI=IHOL2
      IX1LDI=IHOLD
      IX2LDI=IHOLD
      IX3LDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL DIRECTION FOR ALL 3 ',
     1'HORIZONTAL LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1783)
 1783 FORMAT('THE LABEL DIRECTION FOR BOTH ',
     1'VERITCAL LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOL2
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPLADS(ICOM,IHARG,ARG,NUMARG,
     1PDEFDS,
     1PX1LDS,PX2LDS,PX3LDS,PY1LDS,PY2LDS,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL DISPLACEMENT SWITCHES
C              FOR ANY OF THE 5 LABELS.
C              SUCH LABEL DISPLACEMENT SWITCHES DEFINE THE DISPLACEMENT
C              FOR EACH OF THE 5 LABELS.
C              THE CONTENTS OF A LABEL DISPLACEMENT SWITCH ARE
C              A DISPLACEMENT.
C              THE LABEL DISPLACEMENT SWITCHES FOR THE 5 LABELS
C              ARE CONTAINED IN PX1LDS,PX2LDS,PX3LDS,PY1LDS,PY2LDS.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFDS
C     OUTPUT ARGUMENTS--PX1LDS (A REAL VARIABLE
C                       DENOTING THE DISPLACEMENT OF THE FIRST HORIZ. LABEL
C                     --PX2LDS (A REAL VARIABLE
C                       DENOTING THE DISPLACEMENT OF THE SECOND HORIZ. LABEL
C                     --PX3LDS (A REAL VARIABLE
C                       DENOTING THE DISPLACEMENT OF THE THIRD HORIZ. LABEL
C                     --PY1LDS (A REAL VARIABLE
C                       DENOTING THE DISPLACEMENT OF THE FIRST VERT. LABEL
C                     --PY2LDS (A REAL VARIABLE
C                       DENOTING THE DISPLACEMENT OF THE SECOND VERT. LABEL
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, 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     VERSION NUMBER--89/8
C     ORIGINAL VERSION--JULY      1989.
C     UPDATED         --MAY       1992.   FIX DEFAULT VALUES
C     UPDATED         --DECEMBER  1992.   FIX MESSAGE FOR DEFAULT VALUE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DISP')GOTO1090
CCCCC LABEL OFFSET NOW REFERS TO HORIZONTAL POSITIONING.
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OFFS')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1150
      GOTO1160
C
 1150 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1992 (JJF)
CCCCC PHOLD=PDEFDS
      PHOLD=2.0+2.0*PDEFDS
      GOTO1180
C
 1160 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1LDS=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL DISPLACEMENT (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1250
      GOTO1260
C
 1250 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1992 (JJF)
CCCCC PHOLD=PDEFDS
      PHOLD=2.0+3.0*PDEFDS
      GOTO1280
C
 1260 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX2LDS=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL DISPLACEMENT (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)PHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1350
      GOTO1360
C
 1350 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1992 (JJF)
CCCCC PHOLD=PDEFDS
      PHOLD=2.0+4.0*PDEFDS
      GOTO1380
C
 1360 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX3LDS=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL DISPLACEMENT (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)PHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1450
      GOTO1460
C
 1450 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1992 (JJF)
CCCCC PHOLD=PDEFDS
      PHOLD=2.0+2.0*PDEFDS
      GOTO1480
C
 1460 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1LDS=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL DISPLACEMENT (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)PHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1550
      GOTO1560
C
 1550 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1992 (JJF)
CCCCC PHOLD=PDEFDS
      PHOLD=2.0+2.0*PDEFDS
      GOTO1580
C
 1560 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY2LDS=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL DISPLACEMENT (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)PHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH LEFT AND RIGHT VERTICAL LABELS ARE TO BE CHANGED   **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1650
      GOTO1660
C
 1650 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1992 (JJF)
CCCCC PHOLD=PDEFDS
      PHOLD=2.0+2.0*PDEFDS
      GOTO1680
C
 1660 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY1LDS=PHOLD
      PY2LDS=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL DISPLACEMENT (FOR THE LEFT AND RIGHT ',
     1'VERTICAL LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)PHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **        ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1750
      GOTO1760
C
 1750 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1992 (JJF)
CCCCC PHOLD=PDEFDS
      PX1LDS=2.0+2.0*PDEFDS
      PX2LDS=2.0+3.0*PDEFDS
      PX3LDS=2.0+4.0*PDEFDS
      PY1LDS=2.0+2.0*PDEFDS
      PY2LDS=2.0+2.0*PDEFDS
      GOTO1780
C
 1760 CONTINUE
      PHOLD=ARG(NUMARG)
CCCCC THE FOLLOWING 5 LINES WERE ADDED MAY 1992 (JJF)
      PX1LDS=PHOLD
      PX2LDS=PHOLD
      PX3LDS=PHOLD
      PY1LDS=PHOLD
      PY2LDS=PHOLD
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING 5 LINES WERE COMMENTED OUT MAY 1992 (JJF)
CCCCC PY1LDS=PHOLD
CCCCC PY2LDS=PHOLD
CCCCC PX1LDS=PHOLD
CCCCC PX2LDS=PHOLD
CCCCC PX3LDS=PHOLD
C
CCCCC DECEMBER 1992.  FIX MESSAGE.
CCCCC IF(IFEEDB.EQ.'OFF')GOTO1789
      IF(IFEEDB.EQ.'OFF')GOTO1798
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1781)
C1781 FORMAT('THE LABEL DISPLACEMENT (FOR ALL 5 ',
CCCCC1'LABELS--3 HORIZONTAL AND 2 VERTICAL)')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1782)PHOLD
C1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL DISPLACEMENT (FOR THE FIRST HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)PX1LDS
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1783)
 1783 FORMAT('THE LABEL DISPLACEMENT (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1784)PX2LDS
 1784 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1786)
 1786 FORMAT('THE LABEL DISPLACEMENT (FOR THE THIRD HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1787)PX3LDS
 1787 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1796)
 1796 FORMAT('THE LABEL DISPLACEMENT (FOR THE LEFT AND RIGHT ',
     1'VERTICAL LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1797)PY1LDS
 1797 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1798 CONTINUE
CCCCC END CHANGE
C1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPLAFI(ICOM,IHARG,NUMARG,
     1IDEFFI,
     1IX1LFI,IX2LFI,IX3LFI,IY1LFI,IY2LFI,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL FILL SWITCHES
C              FOR ANY OF THE 5 LABELS.
C              SUCH LABEL FILL SWITCHES DEFINE THE FILL
C              FOR EACH OF THE 5 LABELS.
C              THE CONTENTS OF A LABEL FILL SWITCH ARE
C              A FILL.
C              THE LABEL FILL SWITCHES FOR THE 5 LABELS
C              ARE CONTAINED IN IX1LFI,IX2LFI,IX3LFI,IY1LFI,IY2LFI.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFI
C     OUTPUT ARGUMENTS--IX1LFI (A HOLLERITH VARIABLE
C                       DENOTING THE FILL OF THE FIRST HORIZ. LABEL
C                     --IX2LFI (A HOLLERITH VARIABLE
C                       DENOTING THE FILL OF THE SECOND HORIZ. LABEL
C                     --IX3LFI (A HOLLERITH VARIABLE
C                       DENOTING THE FILL OF THE THIRD HORIZ. LABEL
C                     --IY1LFI (A HOLLERITH VARIABLE
C                       DENOTING THE FILL OF THE FIRST VERT. LABEL
C                     --IY2LFI (A HOLLERITH VARIABLE
C                       DENOTING THE FILL OF THE SECOND VERT. LABEL
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFFI
C
      CHARACTER*4 IX1LFI
      CHARACTER*4 IX2LFI
      CHARACTER*4 IX3LFI
      CHARACTER*4 IY1LFI
      CHARACTER*4 IY2LFI
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FILL')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'FILL')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1140
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1150
      GOTO1160
C
 1140 CONTINUE
      IHOLD='SOLI'
      GOTO1180
C
 1150 CONTINUE
      IHOLD=IDEFFI
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1LFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL FILL (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1240
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1250
      GOTO1260
C
 1240 CONTINUE
      IHOLD='SOLI'
      GOTO1280
C
 1250 CONTINUE
      IHOLD=IDEFFI
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX2LFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL FILL (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1340
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1350
      GOTO1360
C
 1340 CONTINUE
      IHOLD='SOLI'
      GOTO1380
C
 1350 CONTINUE
      IHOLD=IDEFFI
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX3LFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL FILL (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1440
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1450
      GOTO1460
C
 1440 CONTINUE
      IHOLD='SOLI'
      GOTO1480
C
 1450 CONTINUE
      IHOLD=IDEFFI
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1LFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL FILL (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1540
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1550
      GOTO1560
C
 1540 CONTINUE
      IHOLD='SOLI'
      GOTO1580
C
 1550 CONTINUE
      IHOLD=IDEFFI
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY2LFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL FILL (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH LEFT AND RIGHT VERTICAL LABELS ARE TO BE CHANGED   **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1640
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1650
      GOTO1660
C
 1640 CONTINUE
      IHOLD='SOLI'
      GOTO1680
C
 1650 CONTINUE
      IHOLD=IDEFFI
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY1LFI=IHOLD
      IY2LFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL FILL (FOR THE LEFT AND RIGHT VERTICAL ',
     1'LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1740
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1750
      GOTO1760
C
 1740 CONTINUE
      IHOLD='SOLI'
      GOTO1780
C
 1750 CONTINUE
      IHOLD=IDEFFI
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IY1LFI=IHOLD
      IY2LFI=IHOLD
      IX1LFI=IHOLD
      IX2LFI=IHOLD
      IX3LFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL FILL (FOR ALL 5 ',
     1'LABELS--3 HORIZONTAL AND 2 VERTICAL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPLAFO(ICOM,IHARG,NUMARG,
     1IDEFFO,
     1IX1LFO,IX2LFO,IX3LJU,IY1LFO,IY2LJU,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL FONT SWITCHES
C              FOR ANY OF THE 5 LABELS.
C              SUCH LABEL FONT SWITCHES DEFINE THE FONT
C              FOR EACH OF THE 5 LABELS.
C              THE CONTENTS OF A LABEL FONT SWITCH ARE
C              A FONT.
C              THE LABEL FONT SWITCHES FOR THE 5 LABELS
C              ARE CONTAINED IN IX1LFO,IX2LFO,IX3LJU,IY1LFO,IY2LJU.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFO
C     OUTPUT ARGUMENTS--IX1LFO (A HOLLERITH VARIABLE
C                       DENOTING THE FONT OF THE FIRST HORIZ. LABEL
C                     --IX2LFO (A HOLLERITH VARIABLE
C                       DENOTING THE FONT OF THE SECOND HORIZ. LABEL
C                     --IX3LJU (A HOLLERITH VARIABLE
C                       DENOTING THE FONT OF THE THIRD HORIZ. LABEL
C                     --IY1LFO (A HOLLERITH VARIABLE
C                       DENOTING THE FONT OF THE FIRST VERT. LABEL
C                     --IY2LJU (A HOLLERITH VARIABLE
C                       DENOTING THE FONT OF THE SECOND VERT. LABEL
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFFO
C
      CHARACTER*4 IX1LFO
      CHARACTER*4 IX2LFO
      CHARACTER*4 IX3LJU
      CHARACTER*4 IY1LFO
      CHARACTER*4 IY2LJU
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FONT')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'FONT')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFFO
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1LFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL FONT (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFFO
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX2LFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL FONT (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFFO
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX3LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL FONT (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFFO
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1LFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL FONT (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFFO
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY2LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL FONT (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH LEFT AND RIGHT VERTICAL LABELS ARE TO BE CHANGED   **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFFO
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY1LFO=IHOLD
      IY2LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL FONT (FOR THE LEFT AND RIGHT VERTICAL ',
     1'LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFFO
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IY1LFO=IHOLD
      IY2LJU=IHOLD
      IX1LFO=IHOLD
      IX2LFO=IHOLD
      IX3LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL FONT (FOR ALL 5 ',
     1'LABELS--3 HORIZONTAL AND 2 VERTICAL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPLAG(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE THE FOLLOWING PLOT--
C              A LAG PLOT;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --AUGUST    1993. FIX FORMAT STATEMENT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHVA21
      CHARACTER*4 IHVA22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.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
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPLA'
      ISUBN2='G   '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLV2=0
C
C               *******************************
C               **  TREAT THE LAG PLOT CASE  **
C               *******************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPLAG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
CCCCC AUGUST 1993.  FIX FORMAT STATEMENT
CCC54 FORMAT('NUMARG = 'I8)
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO69
      DO61I=1,NUMARG
      WRITE(ICOUT,62)I,IHARG(I),IARGT(I)
   62 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   69 CONTINUE
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'LAG'.AND.IARGT(1).EQ.'NUMB'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LAG'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      LAG=1
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      LAG=IARG(1)
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.               **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPLAG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A LAG PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ***********************************************
C               **  STEP 6--                                 **
C               **  CHECK FOR A VALID NUMBER                 **
C               **  OF VARIABLES                             **
C               **  (EITHER 1 OR 2)                          **
C               **  ALSO, FOR THE 2-VARIABLE CASE,           **
C               **  CHECK THE VALIDITY                       **
C               **  OF THE SECOND VARIABLE.                  **
C               **  DOES THE NAME EXIST IN THE TABLE?        **
C               **  DOES THE NUMBER OF ELEMENTS              **
C               **  IN THE SECOND VARIABLE                   **
C               **  AGREE WITH THE NUMBER OF ELEMENTS        **
C               **  IN THE FIRST VARIABLE?                   **
C               ***********************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO509
      GOTO550
C
  509 CONTINUE
      ICASPL='    '
      IF(NUMV2.EQ.1)ICASPL='LAG1'
      IF(NUMV2.EQ.2)ICASPL='LAG2'
      IF(NUMV2.LE.1)GOTO590
      IHVA21=IHARG(2)
      IHVA22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVA21,IHVA22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLV2=IVALUE(ILOCV)
      NVAR2=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,511)IHVA21,IHVA22,ICOLV2,NVAR2
  511 FORMAT('IHVA21,IHVA22,ICOLV2,NVAR2 = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NVAR2.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPLAG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A 2-VARIABLE LAG PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)
  553 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)
  556 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)NUMV2
  557 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPLAG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A 2-VARIABLE LAG PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,573)
  573 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,574)
  574 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,575)
  575 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,576)
  576 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,577)IHLEFT,IHLEF2,NLEFT
  577 FORMAT('      THE FIRST  VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)IHVA21,IHVA22,NVAR2
  578 FORMAT('      THE SECOND VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,580)(IANS(I),I=1,IWIDTH)
  580 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               **********************************************
C               **  STEP 7--                                **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE FIRST  VARIABLE; **
C               **  ALSO, FOR A 2-VARIABLE LAG PLOT,        **
C               **  FORM THE VARIABLE Y2(.)                 **
C               **  WHICH WILL CONTAIN THE SECOND VARIABLE. **
C               **  FORM THESE VARIABLES BY                 **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO610
      IF(ICASQ.EQ.'SUBS')GOTO620
      IF(ICASQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      IF(NQ.GE.MINN2)GOTO660
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,651)
  651 FORMAT('***** ERROR IN DPLAG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,652)
  652 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,653)IHLEFT,IHLEF2
  653 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,654)
  654 FORMAT('      (FOR WHICH AN AUTO OR 2-VARIABLE LAG PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,655)
  655 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,656)MINN2
  656 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,657)
  657 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,658)
  658 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,659)(IANS(I),I=1,IWIDTH)
  659 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  660 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO670I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO670
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
CCCCC IF(MAXV2.LE.1)GOTO670
      IF(NUMV2.LE.1)GOTO670
C
      IJ=MAXN*(ICOLV2-1)+I
      IF(ICOLV2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLV2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLV2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLV2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLV2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLV2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLV2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
  670 CONTINUE
      NS=J
C
C               ****************************************************************
C               **  STEP 9--                                                   *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                      *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.      *
C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .                *
C               **  THIS WILL BE BOTH ONES FOR BOTH CASES                      *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).              *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).              *
C               ****************************************************************
C
      ISTEPN='9'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPLAG2(Y1,Y2,NS,ICASPL,LAG,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLAG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)LAG
 9014 FORMAT('LAG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      IF(NUMARG.LE.0)GOTO9029
      DO9021I=1,NUMARG
      WRITE(ICOUT,9022)I,IHARG(I),IARGT(I)
 9022 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9029 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLAG2(Y1,Y2,N,ICASPL,LAG,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C                   1) A 1-VARIABLE LAG PLOT
C                   2) A 2-VARIABLE LAG PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
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
      ISUBN1='DPLA'
      ISUBN2='G2  '
C
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('***** AT THE BEGINNING OF DPLAG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,LAG
   71 FORMAT('N,ICASPL,LAG = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      WRITE(ICOUT,74)I,Y1(I),Y2(I)
   74 FORMAT('I, Y1(I), Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   80 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPLAG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)N
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(N.GE.2)GOTO49
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)
   46 FORMAT('***** ERROR IN DPLAG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)
   47 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,48)
   48 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   49 CONTINUE
C
C
C               ********************************************************
C               **  STEP 2--                                          **
C               **  CHECK THAT THE SPECIFIED LAG IS                   **
C               **  STRICTLY SMALLER THAN THE NUMBER OF OBSERVATIONS  **
C               ********************************************************
C
      LAG2=LAG
      IF(LAG.LT.0)LAG2=-LAG
C
      IF(LAG2.LT.N)GOTO190
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPLAG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('      THE SPECIFIED LAG EXCEEDS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)
  113 FORMAT('      THE NUMBER OF OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,114)LAG
  114 FORMAT('      THE SPECIFIED LAG            = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,115)N
  115 FORMAT('      THE NUMBER OF OBSERVATIONS N = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  190 CONTINUE
C
C               **************************************
C               **  STEP 3--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  AND DETERMINE PLOT COORDINATES  **
C               **************************************
C
      IF(ICASPL.EQ.'LAG1')GOTO1100
      IF(ICASPL.EQ.'LAG2')GOTO1200
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPLAG2 ',
     1'AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      ICASPL SHOULD BE EITHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      LAG1   OR    LAG2, BUT IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)ICASPL
 1014 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ************************************
C               **  STEP 4.1--                    **
C               **  FORM THE 1-VARIABLE LAG PLOT  **
C               ************************************
C
 1100 CONTINUE
      IMIN=1
      IMAX=N-LAG2
      IF(LAG.LT.0)IMIN=1+LAG2
      IF(LAG.LT.0)IMAX=N
      J=0
      DO1110I=IMIN,IMAX
      J=J+1
      IPLAG=I+LAG
      Y(J)=Y1(I)
      X(J)=Y1(IPLAG)
      D(J)=1.0
 1110 CONTINUE
      NPLOTP=J
      NPLOTV=2
      GOTO9000
C
C               ************************************
C               **  STEP 4.2--                    **
C               **  FORM THE 2-VARIABLE LAG PLOT  **
C               ************************************
C
 1200 CONTINUE
      IMIN=1
      IMAX=N-LAG2
      IF(LAG.LT.0)IMIN=1+LAG2
      IF(LAG.LT.0)IMAX=N
      J=0
      DO1210I=IMIN,IMAX
      J=J+1
      IPLAG=I+LAG
      Y(J)=Y1(I)
      X(J)=Y2(IPLAG)
      D(J)=1.0
 1210 CONTINUE
      NPLOTP=J
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLAG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,LAG,N,NPLOTP,IERROR
 9012 FORMAT('ICASPL,LAG,N,NPLOTP,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLAJU(ICOM,IHARG,NUMARG,
     1IDEFJU,
     1IX1LJU,IX2LJU,IX3LJU,IY1LJU,IY2LJU,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL JUSTIFICATION SWITCHES
C              FOR ANY OF THE 5 LABELS.
C              SUCH LABEL JUSTIFICATION SWITCHES DEFINE THE
C              JUSTIFICATION FOR EACH OF THE 5 LABELS.
C              THE CONTENTS OF A LABEL JUSTIFICATION SWITCH ARE
C              A JUSTIFICATION.
C              THE LABEL JUSTIFICATION SWITCHES FOR THE 5 LABELS
C              ARE CONTAINED IN IX1LJU,IX2LJU,IX3LJU,IY1LJU,IY2LJU.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFO
C     OUTPUT ARGUMENTS--IX1LJU (A HOLLERITH VARIABLE
C                       DENOTING THE JUSTIFICATION OF THE FIRST HORIZ. LABEL
C                     --IX2LJU (A HOLLERITH VARIABLE
C                       DENOTING THE JUSTIFICATION OF THE SECOND HORIZ. LABEL
C                     --IX3LJU (A HOLLERITH VARIABLE
C                       DENOTING THE JUSTIFICATION OF THE THIRD HORIZ. LABEL
C                     --IY1LJU (A HOLLERITH VARIABLE
C                       DENOTING THE JUSTIFICATION OF THE FIRST VERT. LABEL
C                     --IY2LJU (A HOLLERITH VARIABLE
C                       DENOTING THE JUSTIFICATION OF THE SECOND VERT. LABEL
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--99/10
C     ORIGINAL VERSION--OCTOBER   1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFJU
C
      CHARACTER*4 IX1LJU
      CHARACTER*4 IX2LJU
      CHARACTER*4 IX3LJU
      CHARACTER*4 IY1LJU
      CHARACTER*4 IY2LJU
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
      CHARACTER*4 IHOL2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'JUST')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'JUST')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD='CEBO'
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL JUSTIFICATION (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD='CEBO'
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX2LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL JUSTIFICATION (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD='CEBO'
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX3LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL JUSTIFICATION (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD='CECE'
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL JUSTIFICATION (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD='CECE'
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY2LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL JUSTIFICATION (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH LEFT AND RIGHT VERTICAL LABELS ARE TO BE CHANGED   **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD='CECE'
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY1LJU=IHOLD
      IY2LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL JUSTIFICATION (FOR THE LEFT AND RIGHT  ',
     1'VERTICAL LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD='CEBO'
      IHOL2='CECE'
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      IHOL2=IHOLD
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IY1LJU=IHOL2
      IY2LJU=IHOL2
      IX1LJU=IHOLD
      IX2LJU=IHOLD
      IX3LJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL JUSTIFICATION FOR ALL 3 ',
     1'HORIZONTAL LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1783)
 1783 FORMAT('THE LABEL JUSTIFICATION FOR BOTH ',
     1'VERITCAL LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOL2
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPLAOF(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFOF,
     1PX1LOF,PX2LOF,PX3LOF,PY1LOF,PY2LOF,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL OFFSETS
C              FOR ANY OF THE 5 LABELS.
C              THE LABEL OFFSET SWITCHES FOR THE LABELS
C              ARE CONTAINED IN THE VARIABLES--
C                    PX1LOF,PX2LOF,PX3LOF,PY1LOF,PY2LOF
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --PDEFOF (DEFAULT OFFSET)
C     OUTPUT ARGUMENTS--
C                           PX1LOF,
C                           PX2LOF,
C                           PX3LOF,
C                           PY1LOF,
C                           PY2LOF
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--99/10
C     ORIGINAL VERSION--OCTOBER   1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OFFS')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IERROR='YES'
      GOTO9000
C
 1150 CONTINUE
      HOLD1=PDEFOF
      GOTO1180
C
 1160 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1LOF=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL OFFSET (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)HOLD1
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1250
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
      IERROR='YES'
      GOTO9000
C
 1250 CONTINUE
      HOLD1=PDEFOF
      GOTO1280
C
 1260 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX2LOF=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL OFFSET (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)HOLD1
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1350
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
      IERROR='YES'
      GOTO9000
C
 1350 CONTINUE
      HOLD1=PDEFOF
      GOTO1380
C
 1360 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX3LOF=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL OFFSET (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)HOLD1
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN ALL 3                      **
C               **  HORIZONTAL AXIS LABELS ARE TO BE CHANGED       **
C               *****************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO2600
      GOTO2699
C
 2600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO2650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO2650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO2650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO2650
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO2650
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO2660
      IERROR='YES'
      GOTO9000
C
 2650 CONTINUE
      HOLD1=PDEFOF
      GOTO2680
C
 2660 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO2680
C
 2680 CONTINUE
      IFOUND='YES'
      PX1LOF=HOLD1
      PX2LOF=HOLD1
      PX3LOF=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO2689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2681)
 2681 FORMAT('THE LABEL OFFSET (FOR ALL 3 HORIZONTAL AXIS LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2682)HOLD1
 2682 FORMAT('HAVE JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 2689 CONTINUE
      GOTO1900
C
 2699 CONTINUE
C
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1450
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
      IERROR='YES'
      GOTO9000
C
 1450 CONTINUE
      HOLD1=PDEFOF
      GOTO1480
C
 1460 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1LOF=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL OFFSET (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)HOLD1
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1550
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
      IERROR='YES'
      GOTO9000
C
 1550 CONTINUE
      HOLD1=PDEFOF
      GOTO1580
C
 1560 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY2LOF=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL OFFSET (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)HOLD1
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH VERTICAL AXIS LABELS ARE TO BE CHANGED             **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1650
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
      IERROR='YES'
      GOTO9000
C
 1650 CONTINUE
      HOLD1=PDEFOF
      GOTO1680
C
 1660 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY1LOF=HOLD1
      PY2LOF=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL OFFSET (FOR THE LEFT AND RIGHT VERTICAL ',
     1'LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)HOLD1
 1682 FORMAT('HAVE JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFFS')GOTO1750
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
      IERROR='YES'
      GOTO9000
C
 1750 CONTINUE
      HOLD1=PDEFOF
      GOTO1780
C
 1760 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PX1LOF=HOLD1
      PX2LOF=HOLD1
      PX3LOF=HOLD1
      PY1LOF=HOLD1
      PY2LOF=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL OFFSET (FOR ALL 5 ',
     1'LABELS--3 HORIZONTAL AND 2 VERTICAL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)HOLD1
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPLASZ(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1PX1LHE,PX1LWI,PX1LVG,PX1LHG,
     1PX2LHE,PX2LWI,PX2LVG,PX2LHG,
     1PX3LHE,PX3LWI,PX3LVG,PX3LHG,
     1PY1LHE,PY1LWI,PY1LVG,PY1LHG,
     1PY2LHE,PY2LWI,PY2LVG,PY2LHG,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL SIZES
C              FOR ANY OF THE 5 LABELS.
C              THE LABEL SIZE SWITCHES FOR THE LABELS
C              ARE CONTAINED IN THE VARIABLES--
C                    PX1LHE,PX1LWI,PX1LVG,PX1LHG,
C                    PX2LHE,PX2LWI,PX2LVG,PX2LHG,
C                    PX3LHE,PX3LWI,PX3LVG,PX3LHG,
C                    PY1LHE,PY1LWI,PY1LVG,PY1LHG,
C                    PY2LHE,PY2LWI,PY2LVG,PY2LHG,
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --PDEFHE
C     OUTPUT ARGUMENTS--
C                           PX1LHE,PX1LWI,PX1LVG,PX1LHG,
C                           PX2LHE,PX2LWI,PX2LVG,PX2LHG,
C                           PX3LHE,PX3LWI,PX3LVG,PX3LHG,
C                           PY1LHE,PY1LWI,PY1LVG,PY1LHG,
C                           PY2LHE,PY2LWI,PY2LVG,PY2LHG,
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IERROR='YES'
      GOTO9000
C
 1150 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1180
C
 1160 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1LHE=HOLD1
      PX1LWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL SIZE (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)HOLD1
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1250
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
      IERROR='YES'
      GOTO9000
C
 1250 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1280
C
 1260 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX2LHE=HOLD1
      PX2LWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL SIZE (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)HOLD1
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1350
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
      IERROR='YES'
      GOTO9000
C
 1350 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1380
C
 1360 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX3LHE=HOLD1
      PX3LWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL SIZE (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)HOLD1
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1450
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
      IERROR='YES'
      GOTO9000
C
 1450 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1480
C
 1460 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1LHE=HOLD1
      PY1LWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL SIZE (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)HOLD1
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1550
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
      IERROR='YES'
      GOTO9000
C
 1550 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1580
C
 1560 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY2LHE=HOLD1
      PY2LWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL SIZE (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)HOLD1
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH VERTICAL AXIS LABELS ARE TO BE CHANGED             **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1650
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
      IERROR='YES'
      GOTO9000
C
 1650 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1680
C
 1660 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY1LHE=HOLD1
      PY2LHE=HOLD1
      PY1LWI=HOLD2
      PY2LWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL SIZE (FOR THE LEFT AND RIGHT VERTICAL ',
     1'LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)HOLD1
 1682 FORMAT('HAVE JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1750
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
      IERROR='YES'
      GOTO9000
C
 1750 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1780
C
 1760 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PY1LHE=HOLD1
      PY2LHE=HOLD1
      PX1LHE=HOLD1
      PX2LHE=HOLD1
      PX3LHE=HOLD1
      PY1LWI=HOLD2
      PY2LWI=HOLD2
      PX1LWI=HOLD2
      PX2LWI=HOLD2
      PX3LWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL SIZE (FOR ALL 5 ',
     1'LABELS--3 HORIZONTAL AND 2 VERTICAL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)HOLD1
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
C
      PX1LVG=PX1LHE*0.375
      PX2LVG=PX2LHE*0.375
      PX3LVG=PX3LHE*0.375
      PY1LVG=PY1LHE*0.375
      PY2LVG=PY2LHE*0.375
C
      PX1LHG=PX1LHE*0.125
      PX2LHG=PX2LHE*0.125
      PX3LHG=PX3LHE*0.125
      PY1LHG=PY1LHE*0.125
      PY2LHG=PY2LHE*0.125
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPLAT1(IHEAD,NHEAD,CAPTN,NCAP,IFLAG1)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              LATEK OUTPUT.  THIS ROUTINE IS USED TO INITIATE
C              THE LATEK OUTPUT AND STARTS THE FIRST TABLE.
C              THE ONLY OPTIONAL ELEMENT IS THE CAPTION.
C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
C                                THE TEXT FOR THE HEADER
C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                HEADER.
C                     --CAPTN  = THE CHARACTER STRING CONTAINING
C                                THE CAPTION.
C                     --NCAP   = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                CAPTION.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, 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     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) CAPTN
      CHARACTER*(*) IHEAD
C
      LOGICAL IFLAG1
C
      CHARACTER*1  IBASLC
      CHARACTER*10 IFORMT
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  STEP 1: END ASIS MODE AND WRITE A HEADER
C
      CALL DPCONA(92,IBASLC)
  999 FORMAT(1X)
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT('$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8013 FORMAT(A1,'end{center}')
C
      IF(IFLAG1)THEN
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      IF(NHEAD.GE.1)THEN
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        IFORMT=' '
        IFORMT(1:5)='(A  )'
        WRITE(IFORMT(3:4),'(I2)')NHEAD
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,IFORMT)IHEAD(1:NHEAD)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 8005 FORMAT('{',A1,'bf ')
 8006 FORMAT(' }')
 8011 FORMAT('{',A1,'bf ')
 8015 FORMAT('} ',A1,A1)
C
      IF(NCAP.GT.0)THEN
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        IFORMT=' '
        IFORMT(1:5)='(A  )'
        WRITE(IFORMT(3:4),'(I2)')NCAP
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,IFORMT)CAPTN(1:NCAP)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              LATEK OUTPUT.  THIS ROUTINE IS USED TO CLOSE THE
C              CURRENT TABLE AND TERMINATE THE LATEK OUTPUT.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, 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     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*1 IBASLC
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  STEP 1: END THE CURRENT TABLE
C
  999 FORMAT(1X)
 8091 FORMAT(A1,'end{tabular}')
 8092 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
      CALL DPCONA(92,IBASLC)
      IF(IFLAG1)THEN
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8092)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
      IF(IFLAG3)THEN
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C  STEP 2: RESET "ASIS" MODE
C
 8099 FORMAT(A1,'begin{verbatim}')
      IF(IFLAG2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              LATEK OUTPUT.  THIS ROUTINE IS USED TO GENERATE
C              A HEADER ROW FOR A TABLE.  YOU CAN ALSO OPTIONALLY
C              ADD A RULE LINE BEFORE OR AFTER THE HEADER.
C
C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING ARRAY
C                                 CONTAINING THE TEXT FOR THE
C                                 HEADER VALUES.
C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
C                                 THE NUMBER OF CHARACTERS IN THE
C                                 HEADER VALUES.
C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
C                                 THE NUMBER OF HEADER VALUES.
C                     --IFLAG1  = A LOGICAL VALUE THAT SPECIFIES
C                                 WHETHER A RULE LINE IS DRAWN BEFORE
C                                 THE HHEADER.
C                     --IFLAG2  = A LOGICAL VALUE THAT SPECIFIES
C                                 WHETHER A RULE LINE IS DRAWN AFTER
C                                 THE HHEADER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, 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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) IVALUE(NHEAD)
      INTEGER NCHAR(NHEAD)
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDIG(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
C
      CHARACTER*1  IBASLC
      CHARACTER*1  IAMP
      CHARACTER*1  IQUOTE
      CHARACTER*20 IFORMT
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
  999 FORMAT(1X)
      CALL DPCONA(92,IBASLC)
      CALL DPCONA(39,IQUOTE)
      IAMP='&'
C
C  STEP 2: GENERATE THE HEADER ROW
C
 8020 FORMAT(A1,'begin{center}')
 8021 FORMAT(A1,'begin{tabular}')
 8040 FORMAT(A1,'hline')
 8050 FORMAT(2X,A1,A1)
 8060 FORMAT(2X,A1)
      IF(NHEAD.GE.1)THEN
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        IFORMT=' '
        IFORMT(1:3)='( {'
        IFORMT(2:2)=IQUOTE
        ICNT=3
        DO8110I=1,NHEAD
          ICNT=ICNT+1
          IFORMT(ICNT:ICNT)=ALIGN(I)(1:1)
 8110   CONTINUE
        IFORMT(ICNT+1:ICNT+3)='} )'
        IFORMT(ICNT+2:ICNT+2)=IQUOTE
        WRITE(ICOUT,IFORMT)
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG1)THEN
          WRITE(ICOUT,8040)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        DO8120I=1,NHEAD
          IFORMT=' '
          IF(I.LT.NHEAD)THEN
            IF(NCHAR(I).LE.0)THEN
CCCCC         WRITE(ICOUT,8060)IAMP
CCCCC         CALL DPWRST('XXX','WRIT')
            ELSE
              IFORMT(1:11)='(A  ,1X,A1)'
              WRITE(IFORMT(3:4),'(I2)')NCHAR(I)
              WRITE(ICOUT,IFORMT)IVALUE(I)(1:NCHAR(I)),IAMP
              CALL DPWRST('XXX','WRIT')
            ENDIF
          ELSE
            IF(NCHAR(I).GT.0)THEN
              IFORMT(1:14)='(A  ,2X,A1,A1)'
              WRITE(IFORMT(3:4),'(I2)')NCHAR(I)
              WRITE(ICOUT,IFORMT)IVALUE(I)(1:NCHAR(I)),IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSE
CCCCC         WRITE(ICOUT,8050)IBASLC,IBASLC
CCCCC         CALL DPWRST('XXX','WRIT')
            ENDIF
          ENDIF
 8120   CONTINUE
        IF(IFLAG2)THEN
          WRITE(ICOUT,8040)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLAT5(IVALUE,NCHAR,AVALUE,NHEAD,IFLAG1)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              LATEX OUTPUT.  THIS ROUTINE IS USED TO GENERATE
C              A DATA ROW FOR A TABLE.  THE FIRST FIELD CAN
C              BE A TEXT VALUE (FOR A ROW LABEL).
C
C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING CONTAINING
C                                 THE TEXT FOR THE FIRST COLUMN.
C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
C                                 THE NUMBER OF CHARACTERS IN THE
C                                 FIRST TEXT FIELD.
C                     --AVALUE  = A REAL ARRAY CONTAINING THE DATA
C                                 TO BE GENERATED.
C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
C                                 THE NUMBER OF NUMERIC VALUES.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, 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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) IVALUE
      REAL AVALUE(NHEAD)
      INTEGER NCHAR
C
      LOGICAL IFLAG1
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDIG(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
C
      CHARACTER*20 IFORMT
      CHARACTER*1  IBASLC
      CHARACTER*1  IAMP
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  STEP 3: DEFINE A DATA ROW
C
      CALL DPCONA(92,IBASLC)
      IAMP='&'
C
C  STEP 1: FIRST COLUMN MAY BE A ROW LABEL
C
      IF(NCHAR.GT.0)THEN
        IFORMT=' '
        IFORMT(1:11)='(A  ,A1)'
        WRITE(IFORMT(3:4),'(I2)')NCHAR
        WRITE(ICOUT,IFORMT)IVALUE(1:NCHAR),IAMP
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
 8031 FORMAT(G15.7,' & ')
 8033 FORMAT(I12,' & ')
 8035 FORMAT(' & ')
 8131 FORMAT(G15.7,2X,A1,A1)
 8231 FORMAT(2X,A1,A1)
 8133 FORMAT(I12,2X,A1,A1)
 8135 FORMAT(' ',2X,A1,A1)
 8235 FORMAT(' &  ')
 8040 FORMAT(A1,'hline')
      IF(NHEAD.GE.1)THEN
        DO100I=1,NHEAD
          IFORMT=' '
          IF(I.LT.NHEAD)THEN
            IF(NUMDIG(I).GT.0)THEN
              IFORMT(1:13)='(F15. ,1X,A1)'
              WRITE(IFORMT(6:6),'(I1)')MIN(NUMDIG(I),9)
              WRITE(ICOUT,IFORMT)AVALUE(I),IAMP
              CALL DPWRST('XXX','WRIT')
            ELSEIF(NUMDIG(I).EQ.0)THEN
              WRITE(ICOUT,8033)INT(AVALUE(I)+0.5)
              CALL DPWRST('XXX','WRIT')
            ELSEIF(NUMDIG(I).EQ.-1)THEN
              WRITE(ICOUT,8035)
              CALL DPWRST('XXX','WRIT')
            ELSEIF(NUMDIG(I).EQ.-2)THEN
              WRITE(ICOUT,8031)AVALUE(I)
              CALL DPWRST('XXX','WRIT')
            ELSE
              WRITE(ICOUT,8235)IAMP
              CALL DPWRST('XXX','WRIT')
            ENDIF
          ELSE
            IF(NUMDIG(I).GT.0)THEN
              IFORMT(1:16)='(F15. ,2X,A1,A1)'
              WRITE(IFORMT(6:6),'(I1)')MIN(NUMDIG(I),9)
              WRITE(ICOUT,IFORMT)AVALUE(I),IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSEIF(NUMDIG(I).EQ.0)THEN
              WRITE(ICOUT,8133)INT(AVALUE(I)+0.5),IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSEIF(NUMDIG(I).EQ.-1)THEN
              WRITE(ICOUT,8135)IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSEIF(NUMDIG(I).EQ.-2)THEN
              WRITE(ICOUT,8131)AVALUE(I),IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSE
              WRITE(ICOUT,8231)IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ENDIF
          END IF
  100   CONTINUE
C
        IF(IFLAG1)THEN
          WRITE(ICOUT,8040)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              LATEK OUTPUT.  THIS ROUTINE IS USED TO EITHER
C              INITIATE OR END A TABLE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, 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     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*1 IBASLC
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  FOLLOWING ADDS A RULE LINE
C
 8001 FORMAT(A1,'end{verbatim}')
 8020 FORMAT(A1,'begin{table}')
 8040 FORMAT(A1,'end{table}')
      CALL DPCONA(92,IBASLC)
C
      IF(IFLAG3)THEN
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
      IF(IFLAG1)THEN
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
      IF(IFLAG2)THEN
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLAT7(IHEAD,NHEAD,AVAL)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              LATEK OUTPUT.  THIS ROUTINE IS USED TO WRITE A
C              A SINGLE LINE OF OUTPUT.
C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
C                                THE TEXT FOR THE LINE
C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                LINE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, 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     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) IHEAD
C
      CHARACTER*1  IBASLC
      CHARACTER*25 IFORMT
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  STEP 1: END ASIS MODE AND WRITE A HEADER
C
  999 FORMAT(1X)
      CALL DPCONA(92,IBASLC)
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 8005 FORMAT('{',A1,'bf ')
 8006 FORMAT(' }',2X,A1,A1)
C
      IF(NHEAD.GE.1)THEN
        IFORMT=' '
        IFORMT(1:23)='(A  ,2X,F12.5,2X,A1,A1)'
        WRITE(IFORMT(3:4),'(I2)')NHEAD
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,IFORMT)IHEAD(1:NHEAD),AVAL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLAT8(IHEAD,NHEAD,IFLAG1,IFLAG2)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              LATEK OUTPUT.  THIS ROUTINE IS USED TO INITIATE
C              THE LATEK OUTPUT AND GENERATE AN OVERALL TITLE.
C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
C                                THE TEXT FOR THE HEADER
C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                HEADER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, 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     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
C
      CHARACTER*(*) IHEAD
C
      CHARACTER*1  IBASLC
      CHARACTER*10 IFORMT
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  STEP 1: END ASIS MODE AND WRITE A HEADER
C
      CALL DPCONA(92,IBASLC)
  999 FORMAT(1X)
 8001 FORMAT(A1,'end{verbatim}')
 8005 FORMAT('{',A1,'bf ')
 8006 FORMAT(' }')
 8007 FORMAT('$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8013 FORMAT(A1,'end{center}')
      IF(IFLAG1)THEN
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      IF(NHEAD.GE.1)THEN
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        IFORMT=' '
        IFORMT(1:5)='(A  )'
        WRITE(IFORMT(3:4),'(I2)')NHEAD
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,IFORMT)IHEAD(1:NHEAD)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLATH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PX1LTH,PX2LTH,PX3LTH,PY1LTH,PY2LTH,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LABEL THICKNESS SWITCHES
C              FOR ANY OF THE 5 LABELS.
C              SUCH LABEL THICKNESS SWITCHES DEFINE THE THICKNESS
C              FOR EACH OF THE 5 LABELS.
C              THE CONTENTS OF A LABEL THICKNESS SWITCH ARE
C              A THICKNESS.
C              THE LABEL THICKNESS SWITCHES FOR THE 5 LABELS
C              ARE CONTAINED IN PX1LTH,PX2LTH,PX3LTH,PY1LTH,PY2LTH.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C     OUTPUT ARGUMENTS--PX1LTH (A REAL VARIABLE
C                       DENOTING THE THICKNESS OF THE FIRST HORIZ. LABEL
C                     --PX2LTH (A REAL VARIABLE
C                       DENOTING THE THICKNESS OF THE SECOND HORIZ. LABEL
C                     --PX3LTH (A REAL VARIABLE
C                       DENOTING THE THICKNESS OF THE THIRD HORIZ. LABEL
C                     --PY1LTH (A REAL VARIABLE
C                       DENOTING THE THICKNESS OF THE FIRST VERT. LABEL
C                     --PY2LTH (A REAL VARIABLE
C                       DENOTING THE THICKNESS OF THE SECOND VERT. LABEL
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'THIC')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE FIRST  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'XLAB')GOTO1100
      IF(ICOM.EQ.'X1LA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      PHOLD=PDEFTH
      GOTO1180
C
 1160 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1LTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LABEL THICKNESS (FOR THE FIRST  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE SECOND HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      PHOLD=PDEFTH
      GOTO1280
C
 1260 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX2LTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE LABEL THICKNESS (FOR THE SECOND HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)PHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE THIRD  HORIZONTAL LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X3LA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      PHOLD=PDEFTH
      GOTO1380
C
 1360 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX3LTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE LABEL THICKNESS (FOR THE THIRD  HORIZONTAL ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)PHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      PHOLD=PDEFTH
      GOTO1480
C
 1460 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1LTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE LABEL THICKNESS (FOR THE LEFT   VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)PHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   LABEL IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      PHOLD=PDEFTH
      GOTO1580
C
 1560 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY2LTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE LABEL THICKNESS (FOR THE RIGHT  VERTICAL   ',
     1'LABEL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)PHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  BOTH LEFT AND RIGHT VERTICAL LABELS ARE TO BE CHANGED   **
C               **************************************************************
C
      IF(ICOM.EQ.'YLAB')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      PHOLD=PDEFTH
      GOTO1680
C
 1660 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY1LTH=PHOLD
      PY2LTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE LABEL THICKNESS (FOR THE LEFT AND RIGHT VERTICAL ',
     1'LABELS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)PHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY ALL  5 LABELS ARE                   TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XYLA')GOTO1700
      IF(ICOM.EQ.'YXLA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      PHOLD=PDEFTH
      GOTO1780
C
 1760 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PY1LTH=PHOLD
      PY2LTH=PHOLD
      PX1LTH=PHOLD
      PX2LTH=PHOLD
      PX3LTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE LABEL THICKNESS (FOR ALL 5 ',
     1'LABELS--3 HORIZONTAL AND 2 VERTICAL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)PHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPLATT(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE LATTICES
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE VERTICES
C           OF THE LOWER LEFT CORNER OF THE LATTICE,
C           THE X AND Y INCREMENTS OF THE LATTICE
C           AND THE UPPER RIGHT CORNER OF THE LATTICE.
C           LATTICE X1 Y1 XINC YINC X2 Y2
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 3
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*3 = 6.
C NOTE-- THE FOLLOWING GENERALIZATIONS AND COMMENTS NEED CORRECTING  5/5/87
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LATTICE WILL GO
C           FROM THE LAST CURSOR POSITION
C           (ASSUMED TO BE AT VERTEX 1)
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT VERTEX 2)
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT VERTEX 3)
C           AND CONTINUING BACK THE START POINT TO CLOSE THE LATTICE.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LATTICE WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS RESULTING FORM THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT VERTEX 1)
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT VERTEX 2)
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS
C           (ASSUMED TO BE AT VERTEX 3)
C           AND THEN CONTINUING BACK THE START POINT TO CLOSE THE LATTICE.
C     NOTE--AND SO FORTH FOR 10, 14, 18, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--APRIL     1987.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
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
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LATT')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPLATT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='LATT'
      NUMPT=3
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPLATT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A LATTICE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH VERTICES (20,20), (50,20), (35,40)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      LATTICE 20 20 50 20 35 40')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      LATTICE ABSOLUTE 20 20 50 20 35 40')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X3,X3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X3=X2+X3
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y3,Y3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y3=Y2+Y3
C
      CALL DPLAT2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X3
      Y1=Y3
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X3
      PYEND=Y3
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LATT')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLATT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2,X3,Y3
 9013 FORMAT('X1,Y1,X2,Y2,X3,Y3 = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLAT2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A LATTICE
C              WITH ONE CORNER AT (X1,Y1),
C              WITH GRID LINES SPACED AT DISTANCES OF X2 AND Y2,
C              AND WITH THE OPPOSING CORNER AT (X3,Y3).
C      NOTE--IF THE SPACING IS SET TO 0, THEN NO INTERMEDIATE
C            GRID LINES WILL RESULT.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--87/6
C     ORIGINAL VERSION--MAY       1987.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(10)
      DIMENSION PY(10)
CCCCC DIMENSION PX3(10)
CCCCC DIMENSION PY3(10)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
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
      PX31=(-999)
      PY31=(-999)
C
      PXINC=(-999)
      PYINC=(-999)
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRI2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPLAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)X3,Y3
   55 FORMAT('X3,Y3 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      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 11--                  **
C               **  DETERMINE THE COORDINATES  **
C               **  AND                        **
C               **  FILL THE FIGURE            **
C               **  (IF CALLED FOR)            **
C               *********************************
C
      IF(IREFSW(1).EQ.'OFF')GOTO1190
C
      PX(1)=X1
      PY(1)=Y1
C
      PX(2)=X3
      PY(2)=Y1
C
      PX(3)=X3
      PY(3)=Y3
C
      PX(4)=X1
      PY(4)=Y3
C
      PX(5)=X1
      PY(5)=Y1
C
      NP=5
C
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      IFIG='BOX'
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
      IFIG='LATT'
C
 1190 CONTINUE
C
C               *********************************
C               **  STEP 20--                  **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE LATTICE            **
C               **  AND                        **
C               **  DRAW OUT THE FIGURE        **
C               *********************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      NP=2
C
C               ***********************************
C               **  STEP 21--                    **
C               **  DRAW OUT THE VERTICAL LINES  **
C               ***********************************
C
      IF(X2.EQ.0.0)GOTO2100
      GOTO2200
C
 2100 CONTINUE
      PX(1)=X1
      PY(1)=Y1
      PX(2)=X1
      PY(2)=Y3
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      PX(1)=X3
      PY(1)=Y1
      PX(2)=X3
      PY(2)=Y3
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      GOTO2900
C
 2200 CONTINUE
      PX31=X3-X1
      PXINC=X2
      IF(PX31.GT.0.0.AND.X2.LT.0.0)PXINC=(-X2)
      IF(PX31.LT.0.0.AND.X2.GT.0.0)PXINC=(-X2)
      IF(PX31.GT.0.0)PXCUT=X3+0.001
      IF(PX31.LT.0.0)PXCUT=X3-0.001
      NLOOP=ABS(PX31/PXINC)
      NLOOP=NLOOP+5
      DO2210I=1,NLOOP
      IM1=I-1
      AIM1=IM1
      PXNEW=X1+AIM1*PXINC
      PX(1)=PXNEW
      PY(1)=Y1
      PX(2)=PXNEW
      PY(2)=Y3
      IF(PX31.GT.0.0.AND.PXNEW.GT.PXCUT)GOTO2290
      IF(PX31.LT.0.0.AND.PXNEW.LT.PXCUT)GOTO2290
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 2210 CONTINUE
 2290 CONTINUE
      GOTO2900
C
 2900 CONTINUE
C
C               *************************************
C               **  STEP 31--                      **
C               **  DRAW OUT THE HORIZONTAL LINES  **
C               *************************************
C
      IF(Y2.EQ.0.0)GOTO3100
      GOTO3200
C
 3100 CONTINUE
      PX(1)=X1
      PY(1)=Y1
      PX(2)=X3
      PY(2)=Y1
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      PX(1)=X1
      PY(1)=Y3
      PX(2)=X3
      PY(2)=Y3
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      GOTO3900
C
 3200 CONTINUE
      PY31=Y3-Y1
      PYINC=Y2
      IF(PY31.GT.0.0.AND.Y2.LT.0.0)PYINC=(-Y2)
      IF(PY31.LT.0.0.AND.Y2.GT.0.0)PYINC=(-Y2)
      IF(PY31.GT.0.0)PYCUT=Y3+0.001
      IF(PY31.LT.0.0)PYCUT=Y3-0.001
      NLOOP=ABS(PY31/PYINC)
      NLOOP=NLOOP+5
      DO3210I=1,NLOOP
      IM1=I-1
      AIM1=IM1
      PYNEW=Y1+AIM1*PYINC
      PX(1)=X1
      PY(1)=PYNEW
      PX(2)=X3
      PY(2)=PYNEW
      IF(PY31.GT.0.0.AND.PYNEW.GT.PYCUT)GOTO3290
      IF(PY31.LT.0.0.AND.PYNEW.LT.PYCUT)GOTO3290
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 3210 CONTINUE
 3290 CONTINUE
      GOTO3900
C
 3900 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRI2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NP
 9013 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)X1,Y1,X2,Y2,X3,Y3
 9014 FORMAT('X1,Y1,X2,Y2,X3,Y3 = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9018)PX31,PY31,PXINC,PYINC
 9018 FORMAT('PX31,PY31,PXINC,PYINC = ',4E15.7)
      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 DPLEAN(IHARG,IARGT,IARG,ARG,NUMARG,PDEFAN,
     1MAXLEG,PLEGAN,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE ANGLE FOR A LEGEND.
C              THE ANGLE FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE REAL
C              VECTOR PLEGAN(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFAN
C                     --MAXLEG
C     OUTPUT ARGUMENTS--PLEGAN (A REAL VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              ANGLE FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PLEGAN(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'ANGL')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'ANGL')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      PHOLD=PDEFAN
      GOTO1130
C
 1125 CONTINUE
      PHOLD=ARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      PLEGAN(I)=PHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)PLEGAN(I)
 1136 FORMAT('ALL LEGEND ANGLES HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLEAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... ANGLE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 ANGLE 45 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLEAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... ANGLE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      PHOLD=PDEFAN
      GOTO1180
C
 1175 CONTINUE
      PHOLD=ARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PLEGAN(I)=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,PLEGAN(I)
 1186 FORMAT('THE ANGLE FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLECA(IHARG,IARGT,IARG,NUMARG,IDEFCA,
     1MAXLEG,ILEGCA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE CASE FOR A LEGEND.
C              THE CASE FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ILEGCA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCA
C                     --MAXLEG
C     OUTPUT ARGUMENTS--ILEGCA (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              CASE FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFCA
      CHARACTER*4 ILEGCA
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ILEGCA(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CASE')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'CASE')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFCA
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      ILEGCA(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)ILEGCA(I)
 1136 FORMAT('ALL LEGEND CASES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLECA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... CASE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 CASE UPPER')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLECA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... CASE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFCA
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ILEGCA(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,ILEGCA(I)
 1186 FORMAT('THE CASE FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLECL(IHARG,IARGT,IARG,NUMARG,IDEFCO,
     1MAXLEG,ILEGCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR A LEGEND.
C              THE COLOR FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ILEGCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C                     --MAXLEG
C     OUTPUT ARGUMENTS--ILEGCO (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              COLOR FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFCO
      CHARACTER*4 ILEGCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ILEGCO(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COLO')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFCO
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      ILEGCO(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)ILEGCO(I)
 1136 FORMAT('ALL LEGEND COLORS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLECL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 COLOR GREEN')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLECL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFCO
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ILEGCO(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,ILEGCO(I)
 1186 FORMAT('THE COLOR FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLECO(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1MAXLEG,PLEGXC,PLEGYC,IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE (X,Y) COORDINATES FOR A LEGEND.
C              THE (X,Y) COORDINATES WILL BE PLACED IN THE
C              I-TH ELEMENT OF PLEGXC(.) AND PLEGYC(.) RESPECTIVELY.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXLEG
C     OUTPUT ARGUMENTS--PLEGXC (A FLOATING POINT VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              X COORDINATE FOR LEGEND I.
C                     --PLEGYC (A FLOATING POINT VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              Y COORDINATE FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASE
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IANS(*)
C
      DIMENSION PLEGXC(*)
      DIMENSION PLEGYC(*)
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
      ISUBN1='DPLE'
      ISUBN2='CO  '
C
      IFOUND='NO'
      IERROR='NO'
C
      HOLD1=0.0
      HOLD2=0.0
C
      IF(NUMARG.EQ.0)GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COOR')GOTO1140
      GOTO9000
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      IF(NUMARG.GE.3)GOTO1125
C
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPLECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN THE LEGEND ... COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      THE COORDINATES ARE SPECIFIED BY 2 NUMBERS, ',
     1'AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      LEGEND 3 COORDINATES 30 80')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1120 CONTINUE
      ICASE='AUTO'
      GOTO1130
C
 1125 CONTINUE
      ICASE='NORM'
      DO1126J=2,3
      IF(IARGT(J).EQ.'NUMB')GOTO1127
      GOTO1128
 1127 CONTINUE
      IF(J.EQ.2)HOLD1=ARG(J)
      IF(J.EQ.3)HOLD2=ARG(J)
      GOTO1126
 1128 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.2)HOLD1=VALUE(ILOC)
      IF(J.EQ.3)HOLD2=VALUE(ILOC)
 1126 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1131I=1,MAXLEG
      AI=I
      DEL=(AI-1.0)*4.0
      IF(ICASE.EQ.'AUTO')PLEGXC(I)=20.0
      IF(ICASE.EQ.'AUTO')PLEGYC(I)=84.0-DEL
      IF(ICASE.NE.'AUTO')PLEGXC(I)=HOLD1
      IF(ICASE.NE.'AUTO')PLEGYC(I)=HOLD2
 1131 CONTINUE
      IF(ICASE.EQ.'AUTO')GOTO1135
C
      IF(IFEEDB.EQ.'OFF')GOTO1134
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1132)
 1132 FORMAT('ALL LEGEND COORDINATES HAVE JUST BEEN SET TO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)PLEGXC(I),PLEGYC(I)
 1133 FORMAT('    X = ',E15.7,'           Y = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1134 CONTINUE
      GOTO9000
C
 1135 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('ALL LEGEND COORDINATES HAVE BEEN AUTOMATICALLY SET ',
     1'AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      DO1137I=1,4
      WRITE(ICOUT,1186)I
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)PLEGXC(I),PLEGYC(I)
      CALL DPWRST('XXX','BUG ')
 1137 CONTINUE
      WRITE(ICOUT,1138)MAXLEG
 1138 FORMAT('    ... AND SO ON FOR ALL ',I8,' LEGENDS')
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO9000
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 COORDINATES 30 80')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      IF(NUMARG.GE.4)GOTO1175
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1170 CONTINUE
      AI=I
      DEL=(AI-1.0)*4.0
      HOLD1=20.0
      HOLD2=84.0-DEL
      GOTO1180
C
 1175 CONTINUE
      DO1176J=3,4
      IF(IARGT(J).EQ.'NUMB')GOTO1177
      GOTO1178
 1177 CONTINUE
      IF(J.EQ.3)HOLD1=ARG(J)
      IF(J.EQ.4)HOLD2=ARG(J)
      GOTO1176
 1178 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.3)HOLD1=VALUE(ILOC)
      IF(J.EQ.4)HOLD2=VALUE(ILOC)
 1176 CONTINUE
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PLEGXC(I)=HOLD1
      PLEGYC(I)=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I
 1186 FORMAT('THE COORDINATES FOR LEGEND ',I8,
     1' HAVE JUST BEEN SET TO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)PLEGXC(I),PLEGYC(I)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLEDI(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFDI,
     1MAXLEG,ILEGDI,IFOUND,IERROR)
CCCCC THE FOLLOWING LINE WAS FIXED (SEE ABOVE) FEBRUARY 1992
CCCCC SUBROUTINE DPLEDI(IHARG,IARGT,IARG,NUMARG,IDEFDI,
C
C     PURPOSE--DEFINE THE DIRECTION FOR A LEGEND.
C              THE DIRECTION FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ILEGDI(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IHARG2 (A HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFDI
C                     --MAXLEG
C     OUTPUT ARGUMENTS--ILEGDI (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              DIRECTION FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --FEBRUARY  1992 FIX CONFLICT WITH LITERAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1992
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFDI
      CHARACTER*4 ILEGDI
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
CCCCC THE FOLLOWING LINE WAS ADDED FEBRAURY 1992
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ILEGDI(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
CCCCC THE FOLLOWING LINE WAS FIXED FEBRUARY 1992
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DIRE')GOTO1110
      IF(NUMARG.GE.1.AND.
     1   IHARG(1).EQ.'DIRE'.AND.IHARG2(1).EQ.'CTIO'.AND.
     1   NUMARG.EQ.2)GOTO1110
CCCCC THE FOLLOWING LINE WAS FIXED FEBRUARY 1992
CCCCC IF(NUMARG.GE.2.AND.IHARG(2).EQ.'DIRE')GOTO1140
      IF(NUMARG.GE.2.AND.
     1   IHARG(2).EQ.'DIRE'.AND.IHARG2(2).EQ.'CTIO'.AND.
     1   NUMARG.EQ.3)GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFDI
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      ILEGDI(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)ILEGDI(I)
 1136 FORMAT('ALL LEGEND DIRECTIONS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLEDI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... DIRECTION COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 DIRECTION HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLEDI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... DIRECTION COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFDI
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ILEGDI(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,ILEGDI(I)
 1186 FORMAT('THE DIRECTION FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLEFI(IHARG,IARGT,IARG,NUMARG,IDEFFI,
     1MAXLEG,ILEGFI,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FILL FOR A LEGEND.
C              THE FILL FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ILEGFI(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFI
C                     --MAXLEG
C     OUTPUT ARGUMENTS--ILEGFI (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              FILL FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFFI
      CHARACTER*4 ILEGFI
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ILEGFI(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FILL')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'FILL')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFFI
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      ILEGFI(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)ILEGFI(I)
 1136 FORMAT('ALL LEGEND FILLS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLEFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... FILL COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 FILL ON')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLEFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... FILL COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFFI
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ILEGFI(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,ILEGFI(I)
 1186 FORMAT('THE FILL FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLEFO(IHARG,IARGT,IARG,NUMARG,IDEFFO,
     1MAXLEG,ILEGFO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FONT FOR A LEGEND.
C              THE FONT FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ILEGFO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFO
C                     --MAXLEG
C     OUTPUT ARGUMENTS--ILEGFO (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              FONT FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFFO
      CHARACTER*4 ILEGFO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ILEGFO(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FONT')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'FONT')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFFO
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      ILEGFO(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)ILEGFO(I)
 1136 FORMAT('ALL LEGEND FONTS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLEFO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... FONT COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 FONT SIMPLEX')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLEFO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... FONT COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFFO
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ILEGFO(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,ILEGFO(I)
 1186 FORMAT('THE FONT FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLEG(IHARG,IARG,ARG,IARGT,NUMARG,IANS,IANSLC,
     1IWIDTH,
CCCCC SUBROUTINE DPLEG(IHARG,IARG,ARG,IARGT,NUMARG,IANS,IWIDTH,
CCCCC THE ABOVE LINE WAS COMMENTED OUT     SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE              SEPTEMBER 1993
     1ILEGNA,ILEGST,ILEGSP,NUMLEG,MAXLEG,
     1ILEGTE,NCLEG,MXCLEG,IFOUND,IERROR,IBUGP2)
C
C     PURPOSE--DETERMINE THE LEGEND.
C              CONVERT A STRING TO BE USED AS A LEGEND
C              ON A TEKTRONIX (OR EQUIVALENT) PLOT INTO THE PROPER FORM
C              (ASCII INTEGER REPRESENTATION) FOR USE
C              BY THE TEKTRONIX (OR EQUIVALENT) SOFTWARE.
C              ALSO SAVE THE ORIGINAL STRING FOR USE
C              ON PRINTER PLOTS.
C     OUTPUT ARGUMENTS--ILEGNA (A  CHARACTER VECTOR)
C                     --ILEGST (AN INTEGER VECTOR)
C                     --ILEGSP (AN INTEGER VECTOR)
C                     --ILEGTE (A  CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--MARCH     1979.
C     UPDATED         --JULY      1980.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --SEPTEMBER 1993. ALLOW LOWER CASE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IANS
CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
      CHARACTER*4 IANSLC
      CHARACTER*4 ILEGNA
      CHARACTER*4 ILEGTE
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 IBUGP2
C
      CHARACTER*4 ICASLE
      CHARACTER*4 ISTH
      CHARACTER*4 ILEGN2
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
CCCCC THE FOLLOWING LINE WAS ADDED SEPTEBMER 1993
CCCCC TO ALLOW FOR LOWER CASE      SEPTEMBER 1993
      DIMENSION IANSLC(*)
C
      DIMENSION IHARG(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
      DIMENSION IARGT(*)
C
      DIMENSION ILEGNA(*)
      DIMENSION ILEGST(*)
      DIMENSION ILEGSP(*)
C
      DIMENSION ILEGTE(*)
C
      DIMENSION ISTH(1000)
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
      IFOUND='NO'
      IERROR='NO'
C
      ILEGNU=(-999)
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPLEG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N2,NCLEG,MXCLEG
   52 FORMAT('N2,NCLEG,MXCLEG = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(ILEGTE(I),I=1,NCLEG)
   55 FORMAT('ILEGTE(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMLEG,MAXLEG
   56 FORMAT('NUMLEG,MAXLEG = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO60I=1,NUMLEG
      WRITE(ICOUT,61)I,ILEGNA(I),ILEGST(I),ILEGSP(I)
   61 FORMAT('I,ILEGNA(I),ILEGST(I),ILEGSP(I) = ',I4,3X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
   90 CONTINUE
C
      IF(NUMARG.EQ.0)GOTO105
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'HW')GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COLO')GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COOR')GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'SIZE')GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'HW')GOTO9000
      GOTO105
C
  105 CONTINUE
C
C               **********************************************************
C               **  STEP 1--                                            **
C               **  DETERMINE THE LOCATION OF THE WORD    LEGEND     .  **
C               **********************************************************
C
      ICASLE='1'
      IF(NUMARG.EQ.0)GOTO110
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ON')GOTO110
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'OFF')GOTO110
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO')GOTO110
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DEFA')GOTO110
      GOTO150
C
  110 CONTINUE
      ICASLE='ALL'
      NUMLEG=0
      DO120I=1,MAXLEG
      ILEGNA(I)=' '
      ILEGST(I)=0
      ILEGSP(I)=0
  120 CONTINUE
      NCLEG=0
      DO130I=1,MXCLEG
      ILEGTE(I)=' '
  130 CONTINUE
      GOTO800
C
  150 CONTINUE
      DO160I=1,IWIDTH
      I2=I
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IF(IP5.GT.IWIDTH)GOTO169
      IF(IANS(I).EQ.'L'.AND.IANS(IP1).EQ.'E'
     1.AND.IANS(IP2).EQ.'G'.AND.IANS(IP3).EQ.'E'
     1.AND.IANS(IP4).EQ.'N'.AND.IANS(IP5).EQ.'D')
     1GOTO180
  160 CONTINUE
  169 CONTINUE
C
      WRITE(ICOUT,171)
  171 FORMAT('***** ERROR IN DPLEG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,172)
  172 FORMAT('      THE WORD     LEGEND    NOT FOUND.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
  180 CONTINUE
      ISTOPL=IP5
C
C               **********************************************
C               **  STEP 2--                                **
C               **  DETERMINE THE NAME ASSOCIATED WITH      **
C               **  THE LEGEND PRESENTLY BEING DEFINED.     **
C               **********************************************
C
      ISTART=ISTOPL+1
      IF(ISTART.GT.IWIDTH)GOTO209
      DO200I=ISTART,IWIDTH
      I2=I
      IF(IANS(I).NE.' ')GOTO220
  200 CONTINUE
  209 CONTINUE
C
      WRITE(ICOUT,211)
  211 FORMAT('***** ERROR IN DPLEG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,212)
  212 FORMAT('      NO NAME (E.G., 1, 2, 3, ...) FOUND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,213)
  213 FORMAT('      FOR THE CURRENT LEGEND BEING DEFINED.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
  220 CONTINUE
      ISTARN=I2
C
      DO230I=ISTARN,IWIDTH
      I2=I
      IF(IANS(I).EQ.' ')GOTO240
  230 CONTINUE
      I2=I2+1
  240 CONTINUE
      ISTOPN=I2-1
C
CCCCC CALL DP1H4H(ISTARN,ISTOPN,IANS,
CCCCC1IWORD1,IWORD2,IWORD3,NUMWD,NUMCH,IBUGP2,IERROR)
C
      IF(IARGT(1).EQ.'NUMB')GOTO249
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,241)
  241 FORMAT('***** ERROR IN DPLEG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,242)
  242 FORMAT('      IN THE LEGEND ... COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,243)
  243 FORMAT('      THE LEGEND MUST BE IDENTIFIED BY A NUMBER,' )
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,244)
  244 FORMAT('      AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,245)
  245 FORMAT('         LEGEND 2 CARBON DIOXIDE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,246)
  246 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,247)
  247 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,248)(IANS(I),I=1,IWIDTH)
  248 FORMAT(100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      GOTO9000
  249 CONTINUE
C
      ILEGN2=IHARG(1)
      ILEGNU=IARG(1)
      IF(1.LE.ILEGNU.AND.ILEGNU.LE.MAXLEG)GOTO259
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,251)
  251 FORMAT('***** ERROR IN DPLEG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,252)
  252 FORMAT('      IN THE LEGEND ... COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,253)
  253 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,254)MAXLEG
  254 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,255)
  255 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,256)I
  256 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  259 CONTINUE
C
C               *********************************************
C               **  STEP 3--                               **
C               **  DETERMINE THE START POSITION (ISTARS)  **
C               **  FOR THE LEGEND STRING.                 **
C               *********************************************
C
      ISTARS=ISTOPN+2
C
C               ********************************************
C               **  STEP 4--                              **
C               **  DETERMINE THE STOP POSITION (ISTOPS)  **
C               **  FOR THE LEGEND STRING.                **
C               ********************************************
C
      ISTOPS=IWIDTH
      IMIN=ISTARS
      IF(IMIN.GT.IWIDTH)GOTO490
      DO400I=IMIN,IWIDTH
      IREV=IWIDTH-I+IMIN
      IF(IANS(IREV).NE.' ')GOTO420
  400 CONTINUE
      GOTO490
  420 CONTINUE
      ISTOPS=IREV
  490 CONTINUE
C
C               ***********************************************
C               **  STEP 5- -                                **
C               **  COPY OVER THE STRING OF INTEREST.        **
C               **  CONVERT TO ASCII NUMERIC REPRESENTATION. **
C               ***********************************************
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ON')GOTO570
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'OFF')GOTO570
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'AUTO')GOTO570
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'DEFA')GOTO570
      IF(NUMARG.EQ.1)GOTO570
      GOTO540
C
  540 CONTINUE
      J=0
      IF(ISTARS.GT.ISTOPS)GOTO570
      DO550I=ISTARS,ISTOPS
      J=J+1
CCCCC THE FOLLOWING LINE AS CHANGED      SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
CCCCC ISTH(J)=IANS(I)
      ISTH(J)=IANSLC(I)
  550 CONTINUE
      N2=J
      GOTO590
C
  570 CONTINUE
      J=1
      ISTH(1)=' '
      N2=J
      GOTO590
C
  590 CONTINUE
C
C               ****************************************************************
C               **  STEP 6--                                                   *
C               **  INSERT THE CHARACTER STRING IN LOCATIONS                   *
C               **  1 TO N2        OF ISTH(.) INTO THE                         *
C               **  PACKED  INTERNAL DATAPLOT TABLE ILEGTE(.).
C               **  UPDATE (IF NECESSARY) THE INTERNAL TABLES                  *
C               **  ILEGNA(.), ILEGST(.), AND ILEGSP(.).                       *
C               ****************************************************************
C
CCCCC MAY NEED TO ADD IANSLC TO THE ARG LIST BELOW???  SEPTEMBER 1993
      CALL DPINLE(ILEGN2,ISTH,N2,ILEGNA,ILEGST,ILEGSP,
     1NUMLEG,MAXLEG,ILEGTE,NCLEG,MXCLEG,IANS,IWIDTH,IBUGP2,
     1IERROR)
C
C               ***************************
C               **  STEP 7--             **
C               **  PRINT OUT A MESSAGE  **
C               ***************************
C
  800 CONTINUE
      IF(ICASLE.EQ.'ALL')GOTO820
C
  810 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO819
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,811)ILEGNA(ILEGNU)
  811 FORMAT('LEGEND ',A4,' HAS JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(N2.EQ.0)WRITE(ICOUT,999)
      IF(N2.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(N2.GE.1)WRITE(ICOUT,812)(ISTH(I),I=1,N2)
  812 FORMAT(12X,118A1)
      IF(N2.GE.1)CALL DPWRST('XXX','BUG ')
  819 CONTINUE
      GOTO9000
C
  820 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO829
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,821)
  821 FORMAT('ALL LEGENDS HAVE JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
  829 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLEG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N2,NCLEG,MXCLEG
 9012 FORMAT('N2,NCLEG,MXCLEG = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)(ISTH(I),I=1,N2)
 9013 FORMAT('ISTH(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(ILEGTE(I),I=1,NCLEG)
 9015 FORMAT('ILEGTE(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)ILEGNU,IARG(1),NUMLEG,MAXLEG
 9017 FORMAT('ILEGNU,IARG(1),NUMLEG,MAXLEG = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,NUMLEG
      WRITE(ICOUT,9021)I,ILEGNA(I),ILEGST(I),ILEGSP(I)
 9021 FORMAT('I,ILEGNA(I),ILEGST(I),ILEGSP(I) = ',I4,3X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLEHW(IHARG,IARGT,IARG,ARG,NUMARG,
     1PDEFHE,
     1MAXLEG,
     1PLEGHE,PLEGWI,PLEGVG,PLEGHG,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE HEIGHT AND WIDTH FOR A LEGEND.
C              THE HEIGHT FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE FLOATING POINT
C              VECTOR PLEGHE(.).
C              THE WIDTH FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE FLOATING POINT
C              VECTOR PLEGWI(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --PDEFHE
C                     --MAXLEG
C     OUTPUT ARGUMENTS--PLEGHE (A FLOATING POINT VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              SIZE (= HEIGHT) FOR LEGEND I.
C                     --PLEGWI = LEGEND WIDTH
C                     --PLEGVG = LEGEND VERTICAL GAP
C                     --PLEHG = LEGEND GHORIZONTAL GAP
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--JUNE      1980.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PLEGHE(*)
      DIMENSION PLEGWI(*)
      DIMENSION PLEGVG(*)
      DIMENSION PLEGHG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'HW')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'HW')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.2)GOTO1120
      IF(IHARG(3).EQ.'ON')GOTO1120
      IF(IHARG(3).EQ.'OFF')GOTO1120
      IF(IHARG(3).EQ.'AUTO')GOTO1120
      IF(IHARG(3).EQ.'DEFA')GOTO1120
      IF(NUMARG.GE.3.AND.
     1IARGT(2).EQ.'NUMB'.AND.
     1IARGT(3).EQ.'NUMB')GOTO1125
C
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPLEHW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN THE LEGEND ... HW COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      THE HEIGHT & WIDTH IS SPECIFIED BY 2 NUMBERS, ',
     1'AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      LEGEND 3 HW 1.5 1')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1120 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFHE*0.5
      GOTO1130
C
 1125 CONTINUE
      HOLD1=ARG(2)
      HOLD2=ARG(3)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      PLEGHE(I)=HOLD1
      PLEGWI(I)=HOLD2
      PLEGVG(I)=PLEGHE(I)*0.375
      PLEGHG(I)=PLEGWI(I)*0.250
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)PLEGHE(I),PLEGWI(I)
 1136 FORMAT('ALL LEGEND HEIGHT & WIDTHS HAVE JUST BEEN SET TO ',
     12E15.7)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLEHW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... HW COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 HW 1.5 1')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLEHW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... HW COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.3)GOTO1170
      IF(IHARG(4).EQ.'ON')GOTO1170
      IF(IHARG(4).EQ.'OFF')GOTO1170
      IF(IHARG(4).EQ.'AUTO')GOTO1170
      IF(IHARG(4).EQ.'DEFA')GOTO1170
      IF(NUMARG.GE.4.AND.
     1IARGT(3).EQ.'NUMB'.AND.
     1IARGT(4).EQ.'NUMB')GOTO1175
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1170 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFHE*0.5
      GOTO1180
C
 1175 CONTINUE
      HOLD1=ARG(3)
      HOLD2=ARG(4)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PLEGHE(I)=HOLD1
      PLEGWI(I)=HOLD2
      PLEGVG(I)=PLEGHE(I)*0.375
      PLEGHG(I)=PLEGWI(I)*0.250
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,PLEGHE(I),PLEGWI(I)
 1186 FORMAT('THE HEIGHT & WIDTH FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLEJU(IHARG,IARGT,IARG,NUMARG,IDEFJU,
     1MAXLEG,ILEGJU,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE JUSTIFICATION FOR A LEGEND.
C              THE JUSTIFICATION FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ILEGJU(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFJU
C                     --MAXLEG
C     OUTPUT ARGUMENTS--ILEGJU (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              JUSTIFICATION FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFJU
      CHARACTER*4 ILEGJU
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ILEGJU(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'JUST')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'JUST')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFJU
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      ILEGJU(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)ILEGJU(I)
 1136 FORMAT('ALL LEGEND JUSTIFICATIONS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLEJU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... JUSTIFICATION COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 JUSTIFICATION CENTER')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLEJU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... JUSTIFICATION COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFJU
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ILEGJU(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,ILEGJU(I)
 1186 FORMAT('THE JUSTIFICATION FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLESZ(IHARG,IARGT,IARG,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1MAXLEG,
     1PLEGHE,PLEGWI,PLEGVG,PLEGHG,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SIZE FOR A LEGEND.
C              THE SIZE FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE FLOATING POINT
C              VECTOR ILEGCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --PDEFHE
C                     --PDEFWI
C                     --MAXLEG
C     OUTPUT ARGUMENTS--PLEGHE (A FLOATING POINT VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              SIZE (= HEIGHT) FOR LEGEND I.
C                     --PLEGWI = LEGEND WIDTH
C                     --PLEGVG = LEGEND VERTICAL GAP
C                     --PLEHG = LEGEND GHORIZONTAL GAP
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1988.   DEFAULT WIDTH
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PLEGHE(*)
      DIMENSION PLEGWI(*)
      DIMENSION PLEGVG(*)
      DIMENSION PLEGHG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'HEIG')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'SIZE')GOTO1140
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'HEIG')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      IF(NUMARG.GE.2.AND.
     1IARGT(2).EQ.'NUMB')GOTO1125
C
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPLESZ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN THE LEGEND ... SIZE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      THE SIZE IS SPECIFIED BY 1 NUMBER, ',
     1'AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      LEGEND 3 SIZE 1.5')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1120 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1130
C
 1125 CONTINUE
      HOLD1=ARG(2)
      HOLD2=HOLD1*0.5
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      PLEGHE(I)=HOLD1
      PLEGWI(I)=HOLD2
      PLEGVG(I)=PLEGHE(I)*0.375
      PLEGHG(I)=PLEGHE(I)*0.125
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)PLEGHE(I)
 1136 FORMAT('ALL LEGEND SIZES HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLESZ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... SIZE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 SIZE 1.5')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLESZ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... SIZE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      IF(NUMARG.GE.3.AND.
     1IARGT(3).EQ.'NUMB')GOTO1175
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1170 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1180
C
 1175 CONTINUE
      HOLD1=ARG(3)
      HOLD2=HOLD1*0.5
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PLEGHE(I)=HOLD1
      PLEGWI(I)=HOLD2
      PLEGVG(I)=PLEGHE(I)*0.375
      PLEGHG(I)=PLEGHE(I)*0.125
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,PLEGHE(I)
 1186 FORMAT('THE SIZE FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLET(IANGLU,ISEED,IBUGA2,IBUGA3,IBUGCO,IBUGEV,IBUGQ,
     1TEMP,TEMP2,XTEMP1,XTEMP2,MAXNXT,
CCCCC AUGUST 1995.  ADD IFTORD
CCCCC1IFTEXP,
     1IFTEXP,IFTORD,
CCCCC ADD FOLLOWING LINE.  FEBRUARY 1994.
CCCCC ADD OPTACC.          JUNE 1994.
CCCCC ADD IOPTME,IOPTHE,   FEBRUARY 1995.
     1ROOTAC,OPTACC,IOPTME,IOPTHE,
     1ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT THE LET COMMAND.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--NOVEMBER  1977.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --JANUARY   1979.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --JUNE      1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1986.
C     UPDATED         --NOVEMBER  1986.
C     UPDATED         --APRIL     1987.
C     UPDATED         --JUNE      1987.  EXP DESIGN
C     UPDATED         --SEPTEMBER 1987.  PRIME NUMBERS
C     UPDATED         --AUGUST    1988.  PRINCIPLE COMPONENTS
C     UPDATED         --SEPTEMBER 1987.  FIBONNACCI NUMBERS
C     UPDATED         --DECEMBER  1988.  ELIM. SHORT VERS. OF SEQUENCE
C     UPDATED         --DECEMBER  1988.  SHORTEN: LET Y = SEQU 1 1 N
C     UPDATED         --JANUARY   1989.  CHECK FOR ARITHMETIC OPERATORS
C     UPDATED         --JANUARY   1989.  (SIMULATED) EXPERIMENT
C     UPDATED         --APRIL     1989.  LOGISTIC SEQUENCE
C     UPDATED         --APRIL     1989.  CANTOR SET
C     UPDATED         --OCTOBER   1991.  NORMAL ORD. STAT. MED.
C     UPDATED         --MAY       1993.  EV1, EV2, WEIB. ORD. STAT. MED.
C     UPDATED         --JULY      1993.  BUG FIX FOR SING VALUE DECOMP
C     UPDATED         --SEPTEMBER 1993.  ADD ISUBRO TO CALL TO DPRK
C     UPDATED         --FEBRUARY  1994.  LET A = (TAGUCHI) SN- COMMAND
C     UPDATED         --FEBRUARY  1994.  LET A = (TAGUCHI) SN+ COMMAND
C     UPDATED         --FEBRUARY  1994.  ROOTAC ARGUMENT
C     UPDATED         --JUNE      1994.  ADD OPTIMIZATION COMMAND
C     UPDATED         --FEBRUARY  1995.  ADD ARGUMENTS TO OPTIMIZATION
C     UPDATED         --SEPTEMBER 1997.  BERNOULI NUMBERS
C     UPDATED         --SEPTEMBER 1997.  EULER NUMBERS
C     UPDATED         --JULY      2002.  ARGUMENT LIST FOR DPSTAC
C     UPDATED         --APRIL     2003.  ARGUMENT LIST FOR DPSTAC,
C                                        ADDITIONAL SCRATCH ARRAYS
C     UPDATED         --JANUARY   2004.  NUMERICAL DERIVATIVE
C     UPDATED         --JANUARY   2004.  CHARACTER CODE
C     UPDATED         --JANUARY   2004.  ALPHABETIC CHARACTER CODE
C     UPDATED         --JANUARY   2004.  GROUP LABEL
C     UPDATED         --JANUARY   2004.  ROW LABEL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASLE
      CHARACTER*4 ITYPEL
      CHARACTER*4 IFOUNZ
      CHARACTER*4 ITYPE
      CHARACTER*4 IHOL
      CHARACTER*4 IHOL2
      CHARACTER*4 IERRO1
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IFOUNR
      CHARACTER*4 IFOUN7
      CHARACTER*4 IFOUN8
      CHARACTER*4 ICASL7
      CHARACTER*4 ICASS7
      CHARACTER*4 ICASL8
      CHARACTER*4 ICASRA
      CHARACTER*4 ITYW1L
      CHARACTER*4 ICAT1L
      CHARACTER*4 INLI1L
      CHARACTER*4 ITYW2L
      CHARACTER*4 ITYW1R
      CHARACTER*4 ICAT1R
      CHARACTER*4 INLI1R
      CHARACTER*4 ITYW2R
C
      CHARACTER*4 IFTEXP
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IFTORD
C
      CHARACTER*4 IHAR14
      CHARACTER*4 IHAR15
C
CCCCC CHARACTER*4 ICASEX
CCCCC CHARACTER*4 ITEXEX
CCCCC CHARACTER*4 IPAGEX
C
CCCCC CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 IMSUBC
      CHARACTER*4 IOPTME
      CHARACTER*4 IOPTHE
C
CCCCC THE FOLLOWING LINE WAS ADDED JANUARY 1989
      CHARACTER*4 ICASAR
C
      CHARACTER*4 IWRITE
C
C---------------------------------------------------------------------
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION IFOUNZ(30)
      DIMENSION IBEGIN(30)
      DIMENSION IEND(30)
      DIMENSION ITYPE(30)
      DIMENSION IHOL(30)
      DIMENSION IHOL2(30)
      DIMENSION INT1(30)
      DIMENSION FLOAT1(30)
      DIMENSION IERRO1(30)
C
CCCCC DIMENSION ITYPEH(225)
CCCCC DIMENSION IW21HO(225)
CCCCC DIMENSION IW22HO(225)
CCCCC DIMENSION W2HOLD(225)
      DIMENSION ITYPEH(1000)
      DIMENSION IW21HO(1000)
      DIMENSION IW22HO(1000)
      DIMENSION W2HOLD(1000)
C
C     NOTE--THE DIMENSION OF IA SHOULD BE THE SAME AS
C           THE DIMENSION OF IB IN SUBROUTINE COMPIM
C           (THE DIMENSION OF IB IS 1000 (JULY 1986))
C     NOTE--IF MAKE DIMENSION ADJUSTMENTS HERE IN DPLET,
C           THEN ALSO MAKE DIMENSION ADJUSTMENTS IN
C           DPLETF, DPFIT, DPPREF, DPPLOT,
C           COMPIM, AND COMPID.
C
CCCCC DIMENSION IA(225)
      DIMENSION IA(1000)
      DIMENSION PARAM(100)
      DIMENSION IPARN(100)
      DIMENSION IPARN2(100)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
      INCLUDE 'DPCOZI.INC'
      INCLUDE 'DPCOZZ.INC'
C
      DIMENSION XTEMP3(MAXOBV)
      INTEGER ITEMP1(MAXOBV)
      INTEGER ITEMP2(MAXOBV)
      INTEGER ITEMP3(MAXOBV)
      INTEGER ITEMP4(MAXOBV)
      INTEGER ITEMP5(MAXOBV)
      INTEGER ITEMP6(MAXOBV)
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5(1))
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6(1))
      EQUIVALENCE (GARBAG(IGARB1),XTEMP3(1))
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='DPLE'
      ISUBN2='T   '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      ICASLE='UNKN'
      IMSUBC='UNKN'
C
C     ***** THE FOLLOWING 6 LINES INSERTED AUGUST 1983 *****
CCCCC DO40I=1,225
      DO40I=1,1000
      ITYPEH(I)='    '
      IW21HO(I)='    '
      IW22HO(I)='    '
      W2HOLD(I)=0.0
   40 CONTINUE
C
C               **************************
C               **  TREAT THE LET CASE  **
C               **************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPLET--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IANGLU,ISEED
   52 FORMAT('IANGLU,ISEED = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3
   53 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGCO,IBUGEV
   54 FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGQ
   55 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)MAXNXT
   56 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFTEXP
   57 FORMAT('IFTEXP = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  CHECK THE INPUT ARGUMENTS  **
C               *********************************
C
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=   ')GOTO1019
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'=   ')GOTO1019
CCCCC JULY 1993.  FOLLOWING LINE FOR SINGULAR VALUE DECOMPOSITION
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'=   ')GOTO1019
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** ERROR IN DPLET--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      IMPROPER FORM FOR THE    LET   ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      NO EQUAL SIGN FOUND AFTER THE ',
     1'VARIABLE/PARAMETER NAME.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)
 1014 FORMAT('      THE ENTERED COMMAND LINE IS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1015)(IANS(I),I=1,IWIDTH)
 1015 FORMAT('      ',120A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,1016)
 1016 FORMAT(1X)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1019 CONTINUE
C
CCCCC IF(NUMARG.GE.3)GOTO1029
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'=   ')GOTO1029
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'=   ')GOTO1029
CCCCC JULY 1993.  FOLLOWING LINE FOR SINGULAR VALUE DECOMPOSITION
      IF(NUMARG.GE.5.AND.IHARG(4).EQ.'=   ')GOTO1029
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1021)
 1021 FORMAT('***** ERROR IN DPLET--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1022)
 1022 FORMAT('      IMPROPER FORM FOR THE    LET   ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1023)
 1023 FORMAT('      NOTHING FOUND TO THE RIGHT OF THE EQUAL SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1024)
 1024 FORMAT('      THE ENTERED COMMAND LINE IS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1025)(IANS(I),I=1,IWIDTH)
 1025 FORMAT('      ',120A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,1026)
 1026 FORMAT(1X)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1029 CONTINUE
C
C               **************************************
C               **  STEP 2--                        **
C               **  TREAT THE VARIOUS LET SUBCASES  **
C               **************************************
C
C               *********************************************
C               **  STEP 2.0--                             **
C               **  TREAT THE EXPERIMENT DESIGN            **
C               **  GENERATION SUBCASE                     **
C               *********************************************
C
CCCCC IF(IHARG(NUMARG).EQ.'DESI'.AND.IHARG2(NUMARG).EQ.'GN')GOTO1010
CCCCC GOTO1090
C
C1010 CONTINUE
CCCCC ICASLE='DESI'
CCCCC CALL DPDESI(IBUGA3,IBUGQ,IFOUND,IERROR)
CCCCC GOTO9000
C
C1090 CONTINUE
C
C               *********************************************
C               **  STEP 2.11--                            **
C               **  TREAT THE SEQUENCE GENERATION SUBCASE  **
C               *********************************************
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'SEQU'.AND.
     1IHARG(4).EQ.'DIFF')GOTO1190
      IF(IHARG(3).EQ.'SEQU'.AND.IHARG2(3).EQ.'ENCE')GOTO1130
CCCCC THE FOLLOWING LINE WAS ADDED           (DECEMBER 1988)
CCCCC SO NEED NOT SPELL OUT    SEQUENCE     FULLY. (DECEMBER 1988)
      IF(IHARG(3).EQ.'SEQU')GOTO1130
CCCCC THE BRANCH POINT OF THE FOLLOWING LINE (DECEMBER)
CCCCC WAS CHANGED FROM 1130 TO 1110 (DECEMBER 1988)
CCCCC TO ELIMINATE THE CONFLICT OF FUNCTION EVALUATION VERSUS (DECEMBER 1988)
CCCCC SEQUENCE GENERATION.  FOR EXAMPLE, (DECEMBER 1988)
CCCCC LET X = 1 +1 +5 YIELDING A NUMBER (1+1+5=7) (DECEMBER 1988)
CCCCC OR YIELDING A SEQUENCE 1, 2, 3, 4, 5 (DECEMBER 1988)
      IF(NUMARG.GE.5.AND.IHARG(2).EQ.'='.AND.
     1IARGT(3).EQ.'NUMB'.AND.IARGT(4).EQ.'NUMB'.AND.
     1IARGT(5).EQ.'NUMB')GOTO1110
      GOTO1190
C
 1110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** CAUTION FROM SUBROUTINE DPLET--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      DUE TO CONFLICTS WITH OTHER FORMS OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      LET COMMAND, THE 3-ARGUMENT SHORT-CUT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      SYNTAX THAT YOU USED TO GENERATE A SEQUENCE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('      IS NOW (JANUARY 1989) ILLEGAL.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('      THE OPERATION WILL BE CARRIED OUT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('      BUT IN THE FUTURE, PLEASE USE THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1118)
 1118 FORMAT('      FULL SYNTAX WHICH CONTAINS THE WORD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1119)
 1119 FORMAT('      SEQUENCE   EXPLICITLY.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1120)
 1120 FORMAT('      FOR EXAMPLE, REPLACE  LET X = 1 1 10')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('                   BY       LET X = SEQUENCE 1 1 10')
      CALL DPWRST('XXX','BUG ')
C
      IHAR14=IHARG(4)
      IHAR15=IHARG(5)
      IF((IHAR14(1:1).EQ.'+'.OR.IHAR14(1:1).EQ.'-').AND.
     1(IHAR15(1:1).EQ.'+'.OR.IHAR15(1:1).EQ.'-'))GOTO1190
      GOTO1130
C
 1130 CONTINUE
      ICASLE='SEQU'
      CALL DPSEQU(IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 1190 CONTINUE
C
C               ********************************************
C               **  STEP 2.12--                           **
C               **  TREAT THE PATTERN GENERATION SUBCASE  **
C               ********************************************
C
      IF(IHARG(3).EQ.'PATT'.AND.IHARG2(3).EQ.'ERN ')GOTO1210
      IF(IHARG(3).EQ.'DATA'.AND.IHARG2(3).EQ.'    ')GOTO1210
      GOTO1290
C
 1210 CONTINUE
      ICASLE='PATT'
      CALL DPPAT(IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 1290 CONTINUE
C
C               **************************************************
C               **  STEP 2.13--                                 **
C               **  TREAT THE RANDOM NUMBER GENERATION SUBCASE  **
C               **  (AND THE RANDOM PERMUTATION SUBCASE)        **
C               **  (AND THE BOOTSTRAP INDEX SUBCASE == THE     **
C               **  DISCRETE UNIFORM RANDOM NUMBER SUBCASE)     **
C               **************************************************
C
      CALL CKRAND(ICASRA,ILOCNU,IBUGA3,IFOUNR,IERROR)
      IF(IFOUNR.EQ.'YES')GOTO1310
      GOTO1390
C
 1310 CONTINUE
      ICASLE='RAND'
      CALL DPRAND(ICASRA,ISEED,ILOCNU,
     1IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 1390 CONTINUE
C
C               *******************************
C               **  STEP 2.14--              **
C               **  TREAT THE ROOTS SUBCASE  **
C               *******************************
C
      IF(IHARG(3).EQ.'ROOT'.AND.IHARG2(3).EQ.'S   ')GOTO1400
      IF(IHARG(3).EQ.'ROOT'.AND.IHARG2(3).EQ.'    ')GOTO1400
      IF(IHARG(3).EQ.'ZERO'.AND.IHARG2(3).EQ.'S   ')GOTO1400
      IF(IHARG(3).EQ.'ZERO'.AND.IHARG2(3).EQ.'    ')GOTO1400
      IF(IHARG(3).EQ.'SOLV'.AND.IHARG2(3).EQ.'E   ')GOTO1400
      GOTO1490
C
 1400 CONTINUE
      ICASLE='ROOT'
      IFOUND='YES'
      CALL DPROOT(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
CCCCC ADD FOLLOWING LINE.  FEBRUARY 1994.
     1ROOTAC,
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IERROR)
      GOTO9000
C
 1490 CONTINUE
C
C               ************************************
C               **  STEP 2.15--                   **
C               **  TREAT THE DERIVATIVE SUBCASE  **
C               ************************************
C
      IF(IHARG(3).EQ.'DERI'.AND.IHARG2(3).EQ.'VATI')GOTO1500
      GOTO1590
C
 1500 CONTINUE
      ICASLE='DERI'
      IFOUND='YES'
      ITYPEL='V'
      CALL DPDERV(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
     1IFOUNZ,IBEGIN,IEND,ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1,
     1NUMCL,NUMPL,NUMAOL,ITYW1L,ICAT1L,INLI1L,ITYW2L,
     1NUMCR,NUMPR,NUMAOR,ITYW1R,ICAT1R,INLI1R,ITYW2R,
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,IFOUND,IERROR)
CCCCC WRITE(ICOUT,1511)
C1511 FORMAT('***** THE DIFFERENTIATION CAPABILITY')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1512)
C1512 FORMAT('      HAS NOT YET BEEN IMPLEMENTED')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1513)
C1513 FORMAT('      AT THIS COMPUTER INSTALLATION.')
CCCCC CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1590 CONTINUE
C
C               **********************************
C               **  STEP 2.16--                 **
C               **  TREAT THE INTEGRAL SUBCASE  **
C               **********************************
C
      IF(IHARG(3).EQ.'INTE'.AND.IHARG2(3).EQ.'GRAL')GOTO1610
      GOTO1690
C
 1610 CONTINUE
      DO1620I=1,NUMARG
      IF(IHARG(I).EQ.'WRT ')GOTO1600
 1620 CONTINUE
      GOTO1690
C
 1600 CONTINUE
      ICASLE='INTE'
      IFOUND='YES'
      ITYPEL='V'
      CALL DPINTE(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IERROR)
      GOTO9000
C
 1690 CONTINUE
C
C               **********************************************
C               **  STEP 2.16B--                            **
C               **  TREAT THE NUMERICAL DERIVATIVE SUBCASE  **
C               **********************************************
C
      IF(IHARG(3).EQ.'NUME'.AND.IHARG(4).EQ.'DERI')THEN
        ICASLE='NDER'
        IFOUND='YES'
        ITYPEL='P'
        CALL DPNDER(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1              IA,PARAM,IPARN,IPARN2,
     1              IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,IERROR)
        GOTO9000
      ENDIF
C
C
C               *************************************************
C               **  STEP 2.17--                                **
C               **  TREAT THE RUNGE-KUTTA (DIFF. EQ.) SUBCASE  **
C               *************************************************
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'RUNG'.AND.IHARG(4).EQ.'KUTT')GOTO1700
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'RUNG'.AND.IHARG(5).EQ.'KUTT')GOTO1700
      GOTO1790
C
 1700 CONTINUE
      ICASLE='RUNG'
      IFOUND='YES'
      ITYPEL='V'
      CALL DPRK(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
CCCCC THE FOLLOWING LINE WAS AUGMENTED     SEPTEMBER 1993
CCCCC1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IERROR)
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,IERROR)
      GOTO9000
C
 1790 CONTINUE
C
CCCCC FOLLOWING SECTION ADDED JUNE 1994.
C               **************************************
C               **  STEP 2.18--                     **
C               **  TREAT THE OPTIMIZATION SUBCASE  **
C               **************************************
C
      IF(IHARG(3).EQ.'OPTI')GOTO1800
      GOTO1890
C
 1800 CONTINUE
      ICASLE='OPTI'
      IFOUND='YES'
      CALL DPOPT(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
CCCCC FEBRUARY 1995.  ADD ARGUMENTS
CCCCC1OPTACC,
     1OPTACC,IOPTME,IOPTHE,
     1ISUBRO,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IERROR)
      GOTO9000
C
 1890 CONTINUE
C
C               **********************************************
C               **  STEP 2.19--                             **
C               **  TREAT THE CHARACTER CODE       SUBCASE  **
C               **********************************************
C
      IF(IHARG(3).EQ.'CHAR'.AND.IHARG(4).EQ.'CODE')THEN
        ICASLE='CCOD'
        IFOUND='YES'
        ITYPEL='V'
        CALL CODECH(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1              IA,PARAM,IPARN,IPARN2,
     1              'ON  ',
     1              IBUGA3,ISUBRO,IERROR)
        GOTO9000
      ENDIF
C
C               **************************************************
C               **  STEP 2.19B-                                 **
C               **  TREAT THE ALPHABETIC CHARACTER CODE SUBCASE **
C               **************************************************
C
      IF(IHARG(3).EQ.'ALPH'.AND.IHARG(4).EQ.'CHAR'.AND.
     1   IHARG(5).EQ.'CODE')THEN
        ICASLE='CCO2'
        IFOUND='YES'
        ITYPEL='V'
        CALL CODEC2(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1              IA,PARAM,IPARN,IPARN2,
     1              'ON  ',
     1              IBUGA3,ISUBRO,IERROR)
        GOTO9000
      ENDIF
C
C               **********************************************
C               **  STEP 2.19C--                            **
C               **  TREAT THE ROW   LABEL          SUBCASE  **
C               **********************************************
C
      IF(NUMARG.EQ.3.AND.
     1  IHARG(1).EQ.'ROWL'.AND.IHARG2(1).EQ.'ABEL'.AND.
     1  IHARG(2).EQ.'=   ')THEN
        ICASLE='RLAB'
        IFOUND='YES'
        ITYPEL='V'
        CALL DPROLA(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1              IA,PARAM,IPARN,IPARN2,
     1              'ON  ',
     1              IBUGA3,ISUBRO,IERROR)
        GOTO9000
      ENDIF
C
C               **********************************************
C               **  STEP 2.19D--                            **
C               **  TREAT THE GROUP LABEL          SUBCASE  **
C               **********************************************
C
      IF(IHARG(3).EQ.'GROU'.AND.IHARG(4).EQ.'LABE')THEN
        ICASLE='GLAB'
        IFOUND='YES'
        ITYPEL='V'
        IWRITE='ON  '
        CALL DPGROL(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1              IA,PARAM,IPARN,IPARN2,
     1              IWRITE,
     1              IBUGA3,ISUBRO,IERROR)
        GOTO9000
      ENDIF
C
C               **********************************************
C               **  STEP 2.20--                             **
C               **  TREAT THE MATH CALCULATIONS SUBCASE     **
C               **   (INPUT = A VECTOR; OUTPUT = A VECTOR)  **
C               **********************************************
C
      CALL CKMATH(IBUGA3,ISUBRO,IFOUN7,ICASL7,ICASS7,IMSUBC,ILOCV)
      IF(IFOUN7.EQ.'YES'.AND.ICASL7.NE.'UNKN'.AND.
     1ILOCV.GE.1)GOTO2000
      GOTO2090
C
 2000 CONTINUE
      ICASLE='MANI'
CCCCC AUGUST 1995.  ADD IFTORD ARGUMENT
CCCCC OCTOBER 1998.  BREAK DPMATC INTO 2 ROUTINES (STARTING TO
CCCCC CHOKE SOME COMPILERS)
CCCCC MAY 2002.  ADD ISEED TO DPMAT2 CASE
CCCCC CALL DPMATC(ICASL7,ILOCV,IFTEXP,
      IFOUND='NO'
      CALL DPMATC(ICASL7,ICASS7,ILOCV,IFTEXP,IFTORD,
     1IMSUBC,
     1ISEED,
     1IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
      CALL DPMAT2(ICASL7,ICASS7,ILOCV,IFTEXP,IFTORD,
     1IMSUBC,
     1ISEED,
     1IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
      GOTO9000
C
 2090 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS REWRITTEN    OCTOBER 1991
C               *********************************************
C               **  STEP 2.21--                            **
C               **  TREAT THE ORDER STATISTIC MEDIAN GENERATION SUBCASE
C               **        UNIFORM DISTRIBUTION
C               **        NORMAL DISTRIBUTION
C               **        HALFNORMAL DISTRIBUTION
C               **        EV1 (GUMBEL) DISTRIBUTION
C               **        EV2 (FRECHET) DISTRIBUTION
C               **        WEIBULL  DISTRIBUTION
C               *********************************************
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'UNIF'.AND.IHARG(4).EQ.'ORDE'.AND.
     1IHARG(5).EQ.'STAT'.AND.IHARG(6).EQ.'MEDI')GOTO2110
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'NORM'.AND.IHARG(4).EQ.'ORDE'.AND.
     1IHARG(5).EQ.'STAT'.AND.IHARG(6).EQ.'MEDI')GOTO2120
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'HALF'.AND.IHARG(4).EQ.'ORDE'.AND.
     1IHARG(5).EQ.'STAT'.AND.IHARG(6).EQ.'MEDI')GOTO2130
      IF(NUMARG.GE.7.AND.
     1IHARG(3).EQ.'HALF'.AND.IHARG(4).EQ.'NORM'.AND.
     1IHARG(5).EQ.'ORDE'.AND.IHARG(6).EQ.'STAT'.AND.
     1IHARG(7).EQ.'MEDI')GOTO2130
C
CCCCC THE FOLLOWING SECTION WAS ADDED    MAY 1993
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'EV1'.AND.IHARG(4).EQ.'ORDE'.AND.
     1IHARG(5).EQ.'STAT'.AND.IHARG(6).EQ.'MEDI')GOTO2140
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'GUMB'.AND.IHARG(4).EQ.'ORDE'.AND.
     1IHARG(5).EQ.'STAT'.AND.IHARG(6).EQ.'MEDI')GOTO2140
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'EV2'.AND.IHARG(4).EQ.'ORDE'.AND.
     1IHARG(5).EQ.'STAT'.AND.IHARG(6).EQ.'MEDI')GOTO2150
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'FREC'.AND.IHARG(4).EQ.'ORDE'.AND.
     1IHARG(5).EQ.'STAT'.AND.IHARG(6).EQ.'MEDI')GOTO2150
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'WEIB'.AND.IHARG(4).EQ.'ORDE'.AND.
     1IHARG(5).EQ.'STAT'.AND.IHARG(6).EQ.'MEDI')GOTO2160
C
      GOTO2190
C
 2110 CONTINUE
      ICASLE='UOSM'
      CALL DPOSM(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2120 CONTINUE
      ICASLE='NOSM'
      CALL DPOSM(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2130 CONTINUE
      ICASLE='HOSM'
      CALL DPOSM(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MAY 1993
 2140 CONTINUE
      ICASLE='E1OM'
      CALL DPOSM(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MAY 1993
 2150 CONTINUE
      ICASLE='E2OM'
      CALL DPOSM(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MAY 1993
 2160 CONTINUE
      ICASLE='WOSM'
      CALL DPOSM(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2190 CONTINUE
C
C               *********************************************
C               **  STEP 2.24--                            **
C               **  TREAT THE WEIBULL ADJUSTED RANKS SUBCASE  ZZ
C               *********************************************
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'WEIB'.AND.IHARG(4).EQ.'ADJU'.AND.
     1IHARG(5).EQ.'RANK')GOTO2410
      GOTO2490
C
 2410 CONTINUE
      ICASLE='WEAR'
      CALL DPWEAR(IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2490 CONTINUE
C
C               *************************************************
C               **  STEP 2.25--                                **
C               **  TREAT THE PRIME NUMBER GENERATION SUBCASE  **
C               *************************************************
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'PRIM'.AND.IHARG(4).EQ.'NUMB')GOTO2510
      GOTO2590
C
 2510 CONTINUE
      ICASLE='PRIM'
      CALL DPGENS(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2590 CONTINUE
C
C               ******************************************************
C               **  STEP 2.26--                                     **
C               **  TREAT THE FIBONNACCI NUMBER GENERATION SUBCASE  **
C               ******************************************************
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'FIBO'.AND.IHARG(4).EQ.'NUMB')GOTO2610
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'FIBO'.AND.IHARG(4).EQ.'SEQU')GOTO2610
      GOTO2690
C
 2610 CONTINUE
      ICASLE='FIBO'
      CALL DPGENS(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2690 CONTINUE
C
CCCCC THE FOLLOWING LOGISTIC SECTION WAS ADDED APRIL 1989
C               ******************************************************
C               **  STEP 2.27--                                     **
C               **  TREAT THE LOGISTIC SEQUENCE GENERATION SUBCASE  **
C               ******************************************************
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LOGI'.AND.IHARG(4).EQ.'NUMB')GOTO2710
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LOGI'.AND.IHARG(4).EQ.'SEQU')GOTO2710
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LOGI'.AND.IHARG(4).EQ.'SET')GOTO2710
      GOTO2790
C
 2710 CONTINUE
      ICASLE='LOGI'
      CALL DPGENS(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2790 CONTINUE
C
CCCCC THE FOLLOWING CANTOR SET SECTION WAS ADDED APRIL 1989
CCCCC NOTE THAT SOME SUCCEEDING SECTIONS WERE RENUMBERED APRIL 1989
C               ******************************************************
C               **  STEP 2.28--                                     **
C               **  TREAT THE CANTOR SET GENERATION SUBCASE         **
C               ******************************************************
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CANT'.AND.IHARG(4).EQ.'NUMB')GOTO2810
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CANT'.AND.IHARG(4).EQ.'SEQU')GOTO2810
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CANT'.AND.IHARG(4).EQ.'SET')GOTO2810
      GOTO2890
C
 2810 CONTINUE
      ICASLE='CANT'
      CALL DPGENS(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2890 CONTINUE
C
C               ******************************************************
C               **  STEP 2.29--                                     **
C               **  TREAT THE BERNOULLI  NUMBER GENERATION SUBCASE  **
C               ******************************************************
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BERN'.AND.IHARG(4).EQ.'NUMB')GOTO2910
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BERN'.AND.IHARG(4).EQ.'SEQU')GOTO2910
      GOTO2990
C
 2910 CONTINUE
      ICASLE='BERN'
      CALL DPGENS(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2990 CONTINUE
C
C
C               ******************************************************
C               **  STEP 2.30--                                     **
C               **  TREAT THE EULER      NUMBER GENERATION SUBCASE  **
C               ******************************************************
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'EULE'.AND.IHARG(4).EQ.'NUMB')GOTO3010
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'EULE'.AND.IHARG(4).EQ.'SEQU')GOTO3010
      GOTO3090
C
 3010 CONTINUE
      ICASLE='EULE'
      CALL DPGENS(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 3090 CONTINUE
C
C
C               **************************************************
C               **  STEP 2.41--                                 **
C               **  TREAT THE STATISTICAL CALCULATIONS SUBCASE  **
C               **  (INPUT = A VECTOR; OUTPUT = A PARAMETER)    **
C               **************************************************
C
      CALL DPTYP2(IANS,IWIDTH,IHNAME,IHNAM2,NUMNAM,MAXNAM,IBUGA3,
     1           IUSE,IVALUE,VALUE,IN,
     1           IFOUNZ,IBEGIN,IEND,
     1           ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1,
     1           NUMCL,NUMPL,NUMAOL,ITYW1L,ICAT1L,INLI1L,ITYW2L,
     1           NUMCR,NUMPR,NUMAOR,ITYW1R,ICAT1R,INLI1R,ITYW2R)
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED JANUARY 1988
      CALL CKARIT(IFOUNZ,IBEGIN,IANS,IWIDTH,ICASAR,IBUGA3)
CCCCC THE FOLLOWING 10 LINES WERE ADDED                 FEBRUARY 1994
CCCCC TO ALLOW DETECTION OF THE                         FEBRUARY 1994
CCCCC    LET A = (TAGUCHI) SN- Y COMMAND      AND THE   FEBRUARY 1994
CCCCC    LET A = (TAGUCHI) SN+ Y COMMAND                FEBRUARY 1994
C
      IF(NUMARG.GE.3)THEN
         IF(IHARG(3).EQ.'SN- ')GOTO4000
         IF(IHARG(3).EQ.'SN+ ')GOTO4000
      ENDIF
      IF(NUMARG.GE.4)THEN
         IF(IHARG(3).EQ.'TAGU')THEN
            IF(IHARG(4).EQ.'SN- ')GOTO4000
            IF(IHARG(4).EQ.'SN+ ')GOTO4000
         ENDIF
      ENDIF
CCCCC THE FOLLOWING SECTION  WAS  ADDED                 MARCH    2003
CCCCC TO ALLOW DETECTION OF THE HODGES-LEHMAN AND
CCCCC DIFFERENCE OF HODGES-LEHMAN
C
      IF(NUMARG.GE.4)THEN
         IF(IHARG(3).EQ.'HODG'.AND.IHARG(4).EQ.'LEHM')GOTO4000
      ENDIF
      IF(NUMARG.GE.6)THEN
         IF(IHARG(5).EQ.'HODG'.AND.IHARG(6).EQ.'LEHM')GOTO4000
      ENDIF
C
      IF(ICASAR.EQ.'YES')GOTO4190
C
CCCCC THE FOLLOWING LINE WAS ADDED     FEBRUARY 1994
 4000 CONTINUE
      CALL CKSTAT(IBUGA3,IFOUN8,ICASL8,ILOCV)
      IF(IFOUN8.EQ.'YES'.AND.ICASL8.NE.'UNKN'.AND.
     1ILOCV.GE.1)GOTO4100
      GOTO4190
C
 4100 CONTINUE
      ICASLE='STAT'
      CALL DPSTAC(ICASL8,ILOCV,
     1IFOUNZ,IBEGIN,IEND,ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1,
     1TEMP,TEMP2,XTEMP1,XTEMP2,XTEMP3,MAXNXT,
CCCCC JULY 2002.  ADD FOLLOWING FOR HODGES-LEHMAN
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IBUGA3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 4190 CONTINUE
C
C               ***************************************
C               **  STEP 2.42--                      **
C               **  TREAT THE INTERPOLATION SUBCASE  **
C               ***************************************
C
      IF(IHARG(3).EQ.'INTE'.AND.IHARG2(3).EQ.'RPOL')GOTO4210
      GOTO4290
C
 4210 CONTINUE
      DO4220I=1,NUMARG
      IF(IHARG(I).EQ.'WRT ')GOTO4200
 4220 CONTINUE
      GOTO4290
C
 4200 CONTINUE
      ICASLE='INTR'
      IFOUND='YES'
      ITYPEL='V'
CCCCC CALL DPINTR(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
CCCCC1IA,PARAM,IPARN,IPARN2,
CCCCC1IANGLU,IBUGA3,IBUGQ,IBUGCO,IBUGEV,IERROR)
      GOTO9000
C
 4290 CONTINUE
C
C               ******************************************************
C               **  STEP 2.43--                                     **
C               **  TREAT THE (SIMULATED) EXPERIMENT SUBCASE        **
C               ******************************************************
C
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'EXPE')GOTO4310
      GOTO4390
C
 4310 CONTINUE
CCCCC ICASLE='EXPE'
CCCCC CALL DPEXPE(ICASEX,ITEXEX,IPAGEX,ISEED,
CCCCC1IBUGA3,IBUGQ,IFOUND,IERROR)
CCCCC GOTO9000
C
 4390 CONTINUE
C
C               *********************************************
C               **  STEP 2.50--                            **
C               **  TREAT THE FUNCTION EVALUATION SUBCASE  **
C               *********************************************
C
 5000 CONTINUE
      ICASLE='FUNC'
      CALL DPFUEV(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
     1IFOUNZ,IBEGIN,IEND,ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1,
     1NUMCL,NUMPL,NUMAOL,ITYW1L,ICAT1L,INLI1L,ITYW2L,
     1NUMCR,NUMPR,NUMAOR,ITYW1R,ICAT1R,INLI1R,ITYW2R,
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
C               *********************************
C               **  STEP 80--                  **
C               **  GENERATE AN ERROR MESSAGE  **
C               **  (IF NECESSARY)             **
C               *********************************
C
C8000 CONTINUE
CCCCC IERROR='YES'
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8071)
C8071 FORMAT('***** ERROR IN DPLET--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8072)
C8072 FORMAT('      IMPROPER FORM FOR THE    LET   ',
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC1'COMMAND')
CCCCC WRITE(ICOUT,8073)
C8073 FORMAT('      IMPROPER SYNTAX')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8074)ICASLE
C8074 FORMAT('      ICASLE = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8075)
C8075 FORMAT('      THE ENTERED COMMAND LINE IS AS FOLLOWS--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IF(IWIDTH.GE.1)WRITE(ICOUT,8076)(IANS(I),I=1,IWIDTH)
C8076 FORMAT('      ',120A1)
CCCCC IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
CCCCC IF(IWIDTH.LE.0)WRITE(ICOUT,8077)
C8077 FORMAT(1X)
CCCCC IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
CCCCC GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLET--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IANGLU,ISEED
 9012 FORMAT('IANGLU,ISEED = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGA2,IBUGA3
 9013 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IBUGCO,IBUGEV
 9014 FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IBUGQ
 9015 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ICASLE,IMSUBC
 9016 FORMAT('ICASLE,IMSUBC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFOUND,IERROR
 9017 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IFTEXP
 9018 FORMAT('IFTEXP = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLETE(IANS,IWIDTH)
C
C     PURPOSE--GENERATE AN ERROR MESSAGE
C              IN CONNECTION WITH THE LET COMMAND.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
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
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,101)
  101 FORMAT('***** ERROR (FROM DPLETE) IN DPTYP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,102)
  102 FORMAT('      ILLEGAL OR UNKNOWN SYNTAX FOR THE LET COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,103)(IANS(I),I=1,IWIDTH)
  103 FORMAT('      COMMAND LINE--',80A1)
      CALL DPWRST('XXX','BUG ')
C
      RETURN
      END
      SUBROUTINE DPLETF(IANGLU,IBUGA2,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,
CCCCC APRIL 1996.  ADD FOLLOWING ARGUMENT
     1ISFLAG,
     1IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT THE LET FUNCTION COMMAND.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--NOVEMBER  1977.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --JANUARY   1979.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --JUNE      1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     1996.  PRESERVE CASE FOR LET STRING
C     UPDATED         --AUGUST    2005.  CODE FOR LET FUNCTION ... = DERIVATIVE
C                                        WAS NOT BEING RECOGNIZED
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASLF
C
      CHARACTER*4 IFOUNZ
      CHARACTER*4 ITYPE
      CHARACTER*4 IHOL
      CHARACTER*4 IHOL2
      CHARACTER*4 IERRO1
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 ITYW1L
      CHARACTER*4 ICAT1L
      CHARACTER*4 INLI1L
      CHARACTER*4 ITYW2L
      CHARACTER*4 ITYW1R
      CHARACTER*4 ICAT1R
      CHARACTER*4 INLI1R
      CHARACTER*4 ITYW2R
C
      CHARACTER*4 ITYPEL
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC APRIL 1996.  ADD FOLLOWING LINE
      CHARACTER*10 ISFLAG
      CHARACTER*4 ISTEPN
C
      DIMENSION IFOUNZ(30)
      DIMENSION IBEGIN(30)
      DIMENSION IEND(30)
      DIMENSION ITYPE(30)
      DIMENSION IHOL(30)
      DIMENSION IHOL2(30)
      DIMENSION INT1(30)
      DIMENSION FLOAT1(30)
      DIMENSION IERRO1(30)
C
CCCCC DIMENSION ITYPEH(225)
CCCCC DIMENSION IW21HO(225)
CCCCC DIMENSION IW22HO(225)
CCCCC DIMENSION W2HOLD(225)
      DIMENSION ITYPEH(1000)
      DIMENSION IW21HO(1000)
      DIMENSION IW22HO(1000)
      DIMENSION W2HOLD(1000)
C
C     NOTE--THE DIMENSION OF IA SHOULD BE THE SAME AS
C           THE DIMENSION OF IB IN SUBROUTINE COMPIM
C           (THE DIMENSION OF IB IS 1000 (JULY 1986)).
C
CCCCC DIMENSION IA(225)
      DIMENSION IA(1000)
      DIMENSION PARAM(100)
      DIMENSION IPARN(100)
      DIMENSION IPARN2(100)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.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
      ISUBN1='DPLE'
      ISUBN2='TF  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      ICASLF='UNKN'
C
C     ***** THE FOLLOWING 6 LINES INSERTED AUGUST 1983 *****
CCCCC DO40I=1,225
      DO40I=1,1000
      ITYPEH(I)='    '
      IW21HO(I)='    '
      IW22HO(I)='    '
      W2HOLD(I)=0.0
   40 CONTINUE
C
C               ***********************************
C               **  TREAT THE LET FUNCTION CASE  **
C               ***********************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPLETF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  CHECK THE INPUT ARGUMENTS  **
C               *********************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'=   '.AND.
     1IHARG2(3).EQ.'    ')GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPLETF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IMPROPER FORM FOR THE    LET FUNCTION   ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      NO EQUAL SIGN FOUND AFTER THE FUNCTION NAME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      THE ENTERED COMMAND LINE IS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1115)(IANS(I),I=1,IWIDTH)
 1115 FORMAT('      ',120A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,1116)
 1116 FORMAT(1X)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(NUMARG.GE.4)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPLETF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      IMPROPER FORM FOR THE    LET FUNCTION   ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      NOTHING FOUND TO THE RIGHT OF THE EQUAL SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      THE ENTERED COMMAND LINE IS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1125)(IANS(I),I=1,IWIDTH)
 1125 FORMAT('      ',120A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,1126)
 1126 FORMAT(1X)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
C               *****************************************
C               **  STEP 2--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE  **
C               *****************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC FEBRUARY 2003: CHECK WHETHER FUNCTION OR STRING IS
CCCCC BEING CALLED FOR.
CCCCC AUGUST 2005: CHECK FOR 'FUNC' SHOULD BE IN IHARG(1), NOT
CCCCC              NOT IHARG(2)
C
      IF(IHARG(4).EQ.'DERI'.AND.IHARG2(4).EQ.'VATI')THEN
        IF(IHARG(1).EQ.'FUNC')GOTO1140
      ENDIF
      IF(IHARG(4).EQ.'DIFF'.AND.IHARG2(4).EQ.'EREN')THEN
        IF(IHARG(1).EQ.'FUNC')GOTO1140
      ENDIF
      IF(IHARG(4).EQ.'PART'.AND.IHARG2(4).EQ.'IAL ')THEN
        IF(IHARG(1).EQ.'FUNC')GOTO1140
      ENDIF
C
      IF(IHARG(4).EQ.'INTE'.AND.IHARG2(4).EQ.'GRAL')THEN
        IF(IHARG(1).EQ.'FUNC')GOTO1150
      ENDIF
C
      GOTO1130
C
C               *********************************************
C               **  STEP 3.1--                              **
C               **  TREAT THE FUNCTION DEFINITION SUBCASE  **
C               *********************************************
C
 1130 CONTINUE
C
      ISTEPN='3.1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUND='YES'
      ICASLF='DEFI'
CCCCC APRIL 1996.  ADD ISFLAG ARGUMENT
CCCCC CALL DPFUNC(IBUGA3,IERROR)
      CALL DPFUNC(IBUGA3,IERROR,ISFLAG)
      GOTO9000
C
C               *********************************************
C               **  STEP 3.2--                             **
C               **  TREAT THE ANALYTIC DERIVATIVE SUBCASE  **
C               *********************************************
C
 1140 CONTINUE
C
      ISTEPN='3.2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUND='YES'
      ICASLF='DERI'
C
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1141)
C1141 FORMAT('***** NOTE--THE DIFFERENTIATION ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1142)
C1142 FORMAT('      CAPABILITY HAS BEEN TEMPORARILY ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1143)
C1143 FORMAT('      DISCONNECTED (FOR DEBUGGING PURPOSES)')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1144)
C1144 FORMAT('      FROM DATAPLOT')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC GOTO9000
C
CCCCC CALL DPDERV(ICASLF,IHARG,IARG,ARG,IARGT,NUMARG,IHNAME,IVALUE,
CCCCC1VALUE,IUSE,IN,NUMNAM,MAXNAM,IANS,IWIDTH,IANGLE,NUMCOL,MAXCOL,
CCCCC1V,PRED,RES,N,MAXN,
CCCCC1IFSTAR,IFSTOP,IFUNC,NCTIF,MAXNIF,IFUNC2,IFUNC3,
CCCCC1ITYPEH,IW2HOL,W2HOLD,NWHOLD,
CCCCC1IBUGA3,IBUGQ,ISUB,NS,IERROR)
      ICASLF='DERI'
      IFOUND='YES'
CCCCC ITYPEL='V'
      ITYPEL='F'
      CALL DPDERV(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
     1IFOUNZ,IBEGIN,IEND,ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1,
     1NUMCL,NUMPL,NUMAOL,ITYW1L,ICAT1L,INLI1L,ITYW2L,
     1NUMCR,NUMPR,NUMAOR,ITYW1R,ICAT1R,INLI1R,ITYW2R,
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,IFOUND,IERROR)
      GOTO9000
C
C               *********************************************
C               **  STEP 3.3--                             **
C               **  TREAT THE INDEFINITE INTEGRAL SUBCASE  **
C               *********************************************
C
 1150 CONTINUE
C
      ISTEPN='3.3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUND='YES'
      ICASLF='INTE'
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** NOTE--THE INTEGRATION ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      CAPABILITY HAS BEEN TEMPORARILY ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      DISCONNECTED (FOR DEBUGGING PURPOSES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)
 1154 FORMAT('      FROM DATAPLOT')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
CCCCC CALL DPINTG(ICASLF,IHARG,IARG,ARG,IARGT,NUMARG,IHNAME,IVALUE,
CCCCC1VALUE,IUSE,IN,NUMNAM,MAXNAM,IANS,IWIDTH,IANGLE,NUMCOL,MAXCOL,
CCCCC1V,PRED,RES,N,MAXN,
CCCCC1IFSTAR,IFSTOP,IFUNC,NCTIF,MAXNIF,IFUNC2,IFUNC3,
CCCCC1ITYPEH,IW2HOL,W2HOLD,NWHOLD,
CCCCC1IBUGIN,IBUGQ,ISUB,NS,IERROR)
CCCCC GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLETF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICASLF
 9014 FORMAT('ICASLF = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFOUND,IERROR
 9015 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLETH(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1MAXLEG,PLEGTH,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE THICKNESS FOR A LEGEND.
C              THE THICKNESS FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE REAL
C              VECTOR PLEGTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C                     --MAXLEG
C     OUTPUT ARGUMENTS--PLEGTH (A REAL VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              THICKNESS FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PLEGTH(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'THIC')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      PHOLD=PDEFTH
      GOTO1130
C
 1125 CONTINUE
      PHOLD=ARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      PLEGTH(I)=PHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)PLEGTH(I)
 1136 FORMAT('ALL LEGEND THICKNESSS HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLETH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 THICKNESS 0.3')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLETH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      PHOLD=PDEFTH
      GOTO1180
C
 1175 CONTINUE
      PHOLD=ARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PLEGTH(I)=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,PLEGTH(I)
 1186 FORMAT('THE THICKNESS FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLEUN(IHARG,IARGT,IARG,NUMARG,IDEFUZ,
     1MAXLEG,ILEGUN,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE UNITS FOR A LEGEND.
C              (SCREEN OR DATA).
C              THE UNITS FOR LEGEND I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ILEGUN(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFUZ
C                     --MAXLEG
C     OUTPUT ARGUMENTS--ILEGUN (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              UNITS FOR LEGEND I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--99/12
C     ORIGINAL VERSION--DECEMBER  1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFUZ
      CHARACTER*4 ILEGUN
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ILEGUN(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'UNIT')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'UNIT')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFUZ
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      IF(IHOLD.NE.'DATA')IHOLD='SCRE'
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLEG
      ILEGUN(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)ILEGUN(I)
 1136 FORMAT('ALL LEGEND UNITSS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPLEUN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE LEGEND ... UNITS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE LEGEND IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      LEGEND 3 UNITS DATA')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXLEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPLEUN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE LEGEND ... UNITS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF LEGENDS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXLEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'LEGEND.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFUZ
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      IF(IHOLD.NE.'DATA')IHOLD='SCRE'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ILEGUN(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,ILEGUN(I)
 1186 FORMAT('THE UNITS FOR LEGEND ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLF(IHARG,NUMARG,
     1IDEFLF,
     1ITEXLF,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LINE FEED SWITCH (ON OR OFF) FOR
C              TEXT SCRIPT.
C              THE LINE FEED SWITCH WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXLF.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFLF
C                     --IBUGD2
C     OUTPUT ARGUMENTS--ITEXLF
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFLF
      CHARACTER*4 ITEXLF
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPLF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFLF
   53 FORMAT('IDEFLF = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************
C               **  TREAT THE LINE FEED CASE  **
C               ********************************
C
      IF(NUMARG.LE.0)GOTO1161
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'FEED')GOTO1161
      IF(IHARG(NUMARG).EQ.'ON')GOTO1161
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1162
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      GOTO1170
C
 1161 CONTINUE
      ITEXLF='ON'
      GOTO1180
C
 1162 CONTINUE
      ITEXLF='OFF'
      GOTO1180
C
 1165 CONTINUE
      ITEXLF=IDEFLF
      GOTO1180
C
 1170 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1171)
 1171 FORMAT('***** ERROR IN DPLF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('      ILLEGAL ENTRY FOR LINE FEED ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)
 1173 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)
 1174 FORMAT('      SUPPOSE THE THE ANALYST WISHES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1175)
 1175 FORMAT('      TO HAVE A LINE FEED AFTER THE TEXT ',
     1'COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1177)
 1177 FORMAT('      THEN ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1178)
 1178 FORMAT('           LINE FEED ON     (OR   LF ON) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1179)
 1179 FORMAT('           LINE FEED        (OR   LF) ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE LINE FEED (AFTER TEXT) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ITEXLF
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
 9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDEFLF,ITEXLF
 9013 FORMAT('IDEFLF,ITEXLF = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLIB1(IH,IH2,X,SAVE1,SAVE2,SAVE3,I,IANGLU,
     1TERM,IBUGEV,IFOUND,IERROR)
C
C     PURPOSE--PERFORM A LIBRARY FUNCTION EVALUATION.
C     NOTE--THIS IS PART 1
C           (EVALUATE MANY OF THE USUAL FORTRAN LIBRARY FUNCTIONS)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JANUARY  1979.
C     UPDATED         --NOVEMBER  1979.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JULY      1986.
C     UPDATED         --JUNE      1987.    FRACT(.)
C     UPDATED         --SEPTEMBER 1987.    ROUND(.)
C     UPDATED         --SEPTEMBER 1987.    LSD(.)
C     UPDATED         --SEPTEMBER 1988.    IND(.) = INDICATOR FUNCTION
C     UPDATED         --OCTOBER   1988.    ROUND(.) WITH 2ND ARGUMENT
C     UPDATED         --DECEMBER  1988.    LSD(.) RENAMED AS MSD(.)
C     UPDATED         --MARCH     1989.    JULIA(.)
C     UPDATED         --MARCH     1989.    SAVE3 AS INPUT ARGUMENT (JULIA)
C     UPDATED         --JANUARY   1990.    BINPAT(.,.)
C     UPDATED         --FEBRUARY  1993.    ARG CHECK FOR ROUND()
C     UPDATED         --JULY      1993.    FIX JULIA (ALAN)
C     UPDATED         --SEPTEMBER 1994.    ADD BETA, BETAI, LNBETA (FOR
C                                          COMPLETE, INCOMPLETE BETA,
C                                          LOG BETA)
C     UPDATED         --SEPTEMBER 1994.    GAMMAI (INCOMPLETE GAMMA)
C     UPDATED         --SEPTEMBER 1994.    GAMMAR (RECIPROCAL GAMMA)
C     UPDATED         --SEPTEMBER 1994.    DIGAMMA (DIGAMMA)
C     UPDATED         --SEPTEMBER 1994.    TRICOMI (TRICOMI GAMMA)
C     UPDATED         --SEPTEMBER 1994.    GAMMAIC (COMPLEMENTARY
C                                          INCOMPLETE GAMMA)
C     UPDATED         --SEPTEMBER 1994.    POCH (POCHHAMMER GENERALIZED
C                                          SYMBOL)
C     UPDATED         --SEPTEMBER 1994.    POCH (POCHHAMMER GENERALIZED
C                                          SYMBOL FIRST ORDER)
C     UPDATED         --SEPTEMBER 1994.    CHU (LOG CONFLUENT HYPERGE.)
C     UPDATED         --MARCH     1995.    HEAVE (HEAVESIDE FUNCTION)
C     UPDATED         --MARCH     1995.    STEP (STEP FUNCTION)
C     UPDATED         --MARCH     1995.    CEIL (CEILING FUNCTION)
C     UPDATED         --MARCH     1995.    GCD (GREATEST COMMON DIVISOR FUNCTION)
C     UPDATED         --JANUARY   1997.    ADD LOGBETA AND LNGAMMA AS
C                                          SYNONYMS
C     UPDATED         --MARCH     1997.    ADD LAMBDA, STRUVE FUNCTIONS
C     UPDATED         --JULY      1997.    CHM (M CONFLUENT HYPERGEOMETRIC)
C     UPDATED         --AUGUST    1997.    CGAMMA, CGAMMAI (COMPLEX GAMMA)
C     UPDATED         --AUGUST    1997.    CLNGAM, CLNGAM (COMPLEX LOG GAMMA)
C     UPDATED         --AUGUST    1997.    CPSI, CPSII (COMPLEX PSI)
C     UPDATED         --AUGUST    1997.    HYPERGEO (HYPERGEOMETRIC)
C     UPDATED         --AUGUST    1997.    PARABOLIC CYLINDER FUNCTIONS
C                                          PBDV, PBDV1
C                                          PBVV, PBVV1
C                                          PBWA, PBWA1
C     UPDATED         --AUGUST    1997.    CLNBETA, CLNBETAI (COMPLEX
C                                          LOG BETA)
C     UPDATED         --AUGUST    1997.    CBETA, CBETAI (COMPLEX BETA)
C     UPDATED         --SEPTEMBER 1997.    PSI SYNONYM FOR DIGAMMA
C     UPDATED         --SEPTEMBER 1997.    KELVIN FUNCTIONS
C                                          (BER, BERI, BER1, BERI1,
C                                           KER, KERI, KER1, KERI1)
C     UPDATED         --SEPTEMBER 1997.    ZETA, ETA, CATLAN BETA
C     UPDATED         --OCTOBER   1997.    PSIFN
C     UPDATED         --APRIL     1998.    ADD IGACDF, IGAPDF, IGAPPF
C                                          (INVERTED GAMMA)
C     UPDATED         --APRIL     1998.    ADD SUPPORT FOR LOCATION AND
C                                          SCALE PARAMETERS WHERE 
C                                          APPROPRIATE FOR CDF, PDF,
C                                          PPF, AND SF FUNCTIONS
C     UPDATED         --MAY       2002.    FERMDIRA
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGEV
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISIGN
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C     FOLLOWING SECTION ADDED SEPTEMBER 1994.
C
      DOUBLE PRECISION DTEMP1(1000)
      DOUBLE PRECISION DTEMP2(1000)
      DOUBLE PRECISION DRESLT
      DOUBLE PRECISION DRSLT2
      DOUBLE PRECISION DRSLT3
      DOUBLE PRECISION DRSLT4
      DOUBLE PRECISION DRSLT5
      DOUBLE PRECISION DRSLT6
      DOUBLE PRECISION DRSLT7
      DOUBLE PRECISION DRSLT8
      DOUBLE PRECISION DARG1
      DOUBLE PRECISION DARG2
      DOUBLE PRECISION DARG3
      DOUBLE PRECISION DARG4
      DOUBLE PRECISION DBETAI
      DOUBLE PRECISION DBETA
      DOUBLE PRECISION DLBETA
      DOUBLE PRECISION DGAMI
      DOUBLE PRECISION DGAMR
      DOUBLE PRECISION DGAMIP
      DOUBLE PRECISION DGAMIC
      DOUBLE PRECISION DGAMIT
      DOUBLE PRECISION DPOCH
      DOUBLE PRECISION DPOCH1
      DOUBLE PRECISION DPSI
      DOUBLE PRECISION DCHU
      DOUBLE PRECISION FDM0P5
      DOUBLE PRECISION FDP0P5
      DOUBLE PRECISION FDP1P5
      DOUBLE PRECISION FDP2P5
C
C     FOLLOWING SECTION ADDED AUGUST 1997
C
      COMPLEX ZRESLT
      COMPLEX ZARG
      COMPLEX CPSI
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-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.1415926536/
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPLI'
      ISUBN2='B1  '
C
      IF(IBUGEV.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPLIB1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IH,IH2,X
   52 FORMAT('IH,IH2,X = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)SAVE1,SAVE2,SAVE3,I,IANGLU
   53 FORMAT('SAVE1,SAVE2,SAVE3,I,IANGLU = ',3E15.7,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)TERM,IBUGEV,NUMBPW
   54 FORMAT('TERM,IBUGEV,NUMBPW = ',E15.7,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IFOUND,IERROR
   55 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
C
      IF(IH.EQ.'SQRT'.AND.IH2.EQ.'    ')GOTO401
      IF(IH.EQ.'EXP '.AND.IH2.EQ.'    ')GOTO402
      IF(IH.EQ.'LN  '.AND.IH2.EQ.'    ')GOTO403
      IF(IH.EQ.'LOG '.AND.IH2.EQ.'    ')GOTO403
      IF(IH.EQ.'LOGE'.AND.IH2.EQ.'    ')GOTO403
      IF(IH.EQ.'LOG2'.AND.IH2.EQ.'    ')GOTO405
      IF(IH.EQ.'ALOG'.AND.IH2.EQ.'    ')GOTO403
      IF(IH.EQ.'ALOG'.AND.IH2.EQ.'E   ')GOTO403
      IF(IH.EQ.'LOG1'.AND.IH2.EQ.'0   ')GOTO404
      IF(IH.EQ.'ALOG'.AND.IH2.EQ.'10  ')GOTO404
C
      IF(IH.EQ.'ATAN'.AND.IH2.EQ.'    ')GOTO463
      IF(IH.EQ.'ATAN'.AND.IH2.EQ.'2   ')GOTO408
      IF(IH.EQ.'ABS '.AND.IH2.EQ.'    ')GOTO410
      IF(IH.EQ.'AINT'.AND.IH2.EQ.'    ')GOTO411
      IF(IH.EQ.'INT '.AND.IH2.EQ.'    ')GOTO411
      IF(IH.EQ.'INTE'.AND.IH2.EQ.'GER ')GOTO411
      IF(IH.EQ.'AMOD'.AND.IH2.EQ.'    ')GOTO412
      IF(IH.EQ.'MOD '.AND.IH2.EQ.'    ')GOTO412
      IF(IH.EQ.'MODU'.AND.IH2.EQ.'LO  ')GOTO412
      IF(IH.EQ.'SIGN'.AND.IH2.EQ.'    ')GOTO413
      IF(IH.EQ.'FRAC'.AND.IH2.EQ.'T   ')GOTO414
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT DECEMBER 1988
CCCCC AND REPLACED BY THE SUCCEEDING LINE (DECEMBER 1988)
CCCCC IF(IH.EQ.'LSD '.AND.IH2.EQ.'    ')GOTO415
      IF(IH.EQ.'MSD '.AND.IH2.EQ.'    ')GOTO415
      IF(IH.EQ.'ROUN'.AND.IH2.EQ.'D   ')GOTO417
      IF(IH.EQ.'IND '.AND.IH2.EQ.'    ')GOTO418
      IF(IH.EQ.'OCTA'.AND.IH2.EQ.'L   ')GOTO421
      IF(IH.EQ.'OCTD'.AND.IH2.EQ.'EC  ')GOTO421
      IF(IH.EQ.'DECO'.AND.IH2.EQ.'CT  ')GOTO422
C
      IF(IH.EQ.'ERF '.AND.IH2.EQ.'    ')GOTO441
      IF(IH.EQ.'ERFC'.AND.IH2.EQ.'    ')GOTO442
      IF(IH.EQ.'MIN '.AND.IH2.EQ.'    ')GOTO443
      IF(IH.EQ.'MAX '.AND.IH2.EQ.'    ')GOTO444
      IF(IH.EQ.'GAMM'.AND.IH2.EQ.'A   ')GOTO445
      IF(IH.EQ.'LOGG'.AND.IH2.EQ.'AMMA')GOTO446
CCCCC JANUARY 1997.  LNGAMMA ADDED AS SYNONYM
      IF(IH.EQ.'LNGA'.AND.IH2.EQ.'MMA ')GOTO446
      IF(IH.EQ.'DIM '.AND.IH2.EQ.'    ')GOTO447
      IF(IH.EQ.'JULI'.AND.IH2.EQ.'A   ')GOTO510
CCCCC THE FOLLOWING LINE WAS ADDED MARCH 1989
      IF(IH.EQ.'BINP'.AND.IH2.EQ.'AT  ')GOTO610
CCCCC THE FOLLOWING 2 LINES ADDED SEPTEMBER 1994
      IF(IH.EQ.'BETA'.AND.IH2.EQ.'    ')GOTO620
      IF(IH.EQ.'BETA'.AND.IH2.EQ.'I   ')GOTO630
      IF(IH.EQ.'LNBE'.AND.IH2.EQ.'TA  ')GOTO640
CCCCC JANUARY 1997.  LOGBETA ADDED AS SYNONYM
      IF(IH.EQ.'LOGB'.AND.IH2.EQ.'ETA ')GOTO640
      IF(IH.EQ.'GAMM'.AND.IH2.EQ.'AI  ')GOTO650
      IF(IH.EQ.'GAMM'.AND.IH2.EQ.'AIP ')GOTO652
      IF(IH.EQ.'GAMM'.AND.IH2.EQ.'AIC ')GOTO655
      IF(IH.EQ.'GAMM'.AND.IH2.EQ.'AR  ')GOTO660
      IF(IH.EQ.'DIGA'.AND.IH2.EQ.'MMA ')GOTO670
CCCCC SEPTEMBER 1997.  ADD FOLLOWING LINE
      IF(IH.EQ.'PSI '.AND.IH2.EQ.'    ')GOTO670
CCCCC OCTOBER 1997.  ADD FOLLOWING LINE
      IF(IH.EQ.'PSIF'.AND.IH2.EQ.'N   ')GOTO1670
      IF(IH.EQ.'TRIC'.AND.IH2.EQ.'OMI ')GOTO680
      IF(IH.EQ.'POCH'.AND.IH2.EQ.'    ')GOTO690
      IF(IH.EQ.'POCH'.AND.IH2.EQ.'1   ')GOTO700
      IF(IH.EQ.'CHU '.AND.IH2.EQ.'    ')GOTO710
CCCCC THE FOLLOWING SECTION ADDED MARCH 1995.
      IF(IH.EQ.'HEAV'.AND.IH2.EQ.'E   ')GOTO810
      IF(IH.EQ.'STEP'.AND.IH2.EQ.'    ')GOTO820
      IF(IH.EQ.'CEIL'.AND.IH2.EQ.'    ')GOTO830
      IF(IH.EQ.'FLOO'.AND.IH2.EQ.'R   ')GOTO840
      IF(IH.EQ.'GCD '.AND.IH2.EQ.'    ')GOTO850
CCCCC THE FOLLOWING SECTION ADDED JANUARY 1997
      IF(IH.EQ.'LAMB'.AND.IH2.EQ.'DA  ')GOTO860
      IF(IH.EQ.'LAMB'.AND.IH2.EQ.'DAP ')GOTO870
      IF(IH.EQ.'H0  '.AND.IH2.EQ.'    ')GOTO880
      IF(IH.EQ.'H1  '.AND.IH2.EQ.'    ')GOTO890
      IF(IH.EQ.'HV  '.AND.IH2.EQ.'    ')GOTO900
      IF(IH.EQ.'L0  '.AND.IH2.EQ.'    ')GOTO910
      IF(IH.EQ.'L1  '.AND.IH2.EQ.'    ')GOTO920
      IF(IH.EQ.'LV  '.AND.IH2.EQ.'    ')GOTO930
CCCCC THE FOLLOWING SECTION ADDED JULY 1997
      IF(IH.EQ.'CHM '.AND.IH2.EQ.'    ')GOTO940
CCCCC THE FOLLOWING SECTION ADDED AUGUST 1997
      IF(IH.EQ.'CGAM'.AND.IH2.EQ.'MA  ')GOTO950
      IF(IH.EQ.'CLNG'.AND.IH2.EQ.'AM  ')GOTO955
      IF(IH.EQ.'CGAM'.AND.IH2.EQ.'MAI ')GOTO960
      IF(IH.EQ.'CLNG'.AND.IH2.EQ.'AMI ')GOTO965
      IF(IH.EQ.'CPSI'.AND.IH2.EQ.'    ')GOTO970
      IF(IH.EQ.'CPSI'.AND.IH2.EQ.'I   ')GOTO980
      IF(IH.EQ.'HYPE'.AND.IH2.EQ.'RGEO')GOTO990
      IF(IH.EQ.'PBDV'.AND.IH2.EQ.'    ')GOTO1000
      IF(IH.EQ.'PBDV'.AND.IH2.EQ.'1   ')GOTO1010
      IF(IH.EQ.'PBVV'.AND.IH2.EQ.'    ')GOTO1020
      IF(IH.EQ.'PBVV'.AND.IH2.EQ.'1   ')GOTO1030
      IF(IH.EQ.'PBWA'.AND.IH2.EQ.'    ')GOTO1040
      IF(IH.EQ.'PBWA'.AND.IH2.EQ.'1   ')GOTO1050
      IF(IH.EQ.'CLNB'.AND.IH2.EQ.'ETA ')GOTO1060
      IF(IH.EQ.'CLNB'.AND.IH2.EQ.'ETAI')GOTO1070
      IF(IH.EQ.'CBET'.AND.IH2.EQ.'A   ')GOTO1080
      IF(IH.EQ.'CBET'.AND.IH2.EQ.'AI  ')GOTO1090
      IF(IH.EQ.'ZETA'.AND.IH2.EQ.'    ')GOTO1100
      IF(IH.EQ.'BER '.AND.IH2.EQ.'    ')GOTO1110
      IF(IH.EQ.'BERI'.AND.IH2.EQ.'    ')GOTO1120
      IF(IH.EQ.'BER1'.AND.IH2.EQ.'    ')GOTO1130
      IF(IH.EQ.'BERI'.AND.IH2.EQ.'1   ')GOTO1140
      IF(IH.EQ.'KER '.AND.IH2.EQ.'    ')GOTO1150
      IF(IH.EQ.'KERI'.AND.IH2.EQ.'    ')GOTO1160
      IF(IH.EQ.'KER1'.AND.IH2.EQ.'    ')GOTO1170
      IF(IH.EQ.'KERI'.AND.IH2.EQ.'1   ')GOTO1180
      IF(IH.EQ.'ETA '.AND.IH2.EQ.'    ')GOTO1190
      IF(IH.EQ.'CATL'.AND.IH2.EQ.'AN  ')GOTO1200
      IF(IH.EQ.'FERM'.AND.IH2.EQ.'DIRA')GOTO1210
C
      IFOUND='NO'
      GOTO9000
C
  401 CONTINUE
      IF(X.GE.0.0)GOTO1801
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1501)
 1501 FORMAT('***** ERROR IN DPLIB1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1601)
 1601 FORMAT('      ATTEMPT TO TAKE SQUARE ROOT OF NEGATIVE NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1701)X
 1701 FORMAT('      THE NEGATIVE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1801 CONTINUE
      IF(X.EQ.0.0)TERM=X
      IF(X.GT.0.0)TERM=SQRT(X)
      GOTO9000
C
  402 CONTINUE
      ARG=X
      IF(ARG.GT.80.0)TERM=CPUMAX
      IF(ARG.LT.-80.0)TERM=0.0
      IF(-80.0.LE.ARG.AND.ARG.LE.80.0)TERM=EXP(ARG)
      GOTO9000
C
  403 CONTINUE
      IF(X.GT.0.0)GOTO1803
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1503)
 1503 FORMAT('***** ERROR IN DPLIB1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1603)
 1603 FORMAT('      ATTEMPT TO TAKE LOG OF NON-POSITIVE NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1703)X
 1703 FORMAT('      THE NON-POSITIVE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1803 CONTINUE
      TERM=ALOG(X)
      GOTO9000
C
  404 CONTINUE
      IF(X.GT.0.0)GOTO1804
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1504)
 1504 FORMAT('***** ERROR IN DPLIB1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1604)
 1604 FORMAT('      ATTEMPT TO TAKE LOG OF NON-POSITIVE NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1704)X
 1704 FORMAT('      THE NON-POSITIVE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1804 CONTINUE
      TERM=ALOG10(X)
      GOTO9000
C
  405 CONTINUE
      IF(X.GT.0.0)GOTO1805
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1505)
 1505 FORMAT('***** ERROR IN DPLIB1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1605)
 1605 FORMAT('      ATTEMPT TO TAKE LOG OF NON-POSITIVE NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1705)X
 1705 FORMAT('      THE NON-POSITIVE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1805 CONTINUE
      TERM=ALOG(X)/ALOG(2.0)
      GOTO9000
C
  463 CONTINUE
      ARG=X
      RESULT=ATAN(ARG)
      IF(IANGLU.EQ.'DEGR')RESULT=(180.0/PI)*RESULT
      IF(IANGLU.EQ.'GRAD')RESULT=(200.0/PI)*RESULT
      TERM=RESULT
      GOTO9000
C
  408 CONTINUE
      ARG1=X
      ARG2=SAVE1
      RESULT=ATAN2(ARG1,ARG2)
      TERM=RESULT
      GOTO9000
C
  410 CONTINUE
      TERM=ABS(X)
      GOTO9000
C
  411 CONTINUE
      TERM=AINT(X)
      GOTO9000
C
  412 CONTINUE
      TERM=AMOD(X,SAVE1)
      GOTO9000
C
  413 CONTINUE
      TERM=1.0
      IF(X.LT.0.0)TERM=-1.0
      GOTO9000
C
  414 CONTINUE
      TERM=X-AINT(X)
      TERM=ABS(TERM)
      GOTO9000
C
  415 CONTINUE
      TERM=ABS(X)
      DO1515I=1,1000
      IF(TERM.GT.10.0)TERM=TERM/10.0
      IF(TERM.LT.1.0)TERM=TERM*10.0
      IF(1.0.LE.TERM.AND.TERM.LE.10.0)GOTO1615
 1515 CONTINUE
 1615 CONTINUE
      TERM=AINT(TERM)
      GOTO9000
C
  417 CONTINUE
CCCCC THE FOLLOWING ERROR CHECK SECTION WAS ADDED FEBRUARY 1993
      IF(-10.0.LE.SAVE1.AND.SAVE1.LE.10.0)GOTO2109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2101)
 2101 FORMAT('***** ERROR IN DPLIB1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2102)
 2102 FORMAT('      INVALID (OR NON-EXISTENT) SECOND ARGUMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2103)
 2103 FORMAT('      FOR THE    ROUND(..,..)    FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2104)
 2104 FORMAT('      EXAMPLE OF PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2105)
 2105 FORMAT('      LET Y2=ROUND(Y,3) TO ROUND TO 3 DEC. PLACES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2106)
 2106 FORMAT('      LET Y2=ROUND(Y,0) TO ROUND TO 0 DEC. PLACES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2109 CONTINUE
CCCCC IF(X.GE.0.0)TERM=AINT(X+0.5)
CCCCC IF(X.LT.0.0)TERM=AINT(X-0.5)
      ABSX=ABS(X)
      IPOWER=0
      IF(SAVE1.GT.0.0)IPOWER=AINT(SAVE1+0.5)
      AMULT=10.0**IPOWER
      TEMP2=ABSX*AMULT
      TEMP3=AINT(TEMP2+0.5)
      TEMP4=TEMP3/AMULT
      TERM=TEMP4
      IF(X.LT.0.0)TERM=(-TEMP4)
      GOTO9000
C
  418 CONTINUE
      TERM=0.0
      IF(ABS(SAVE1).EQ.0.0)EPS=0.000001
      IF(ABS(SAVE1).NE.0.0)EPS=ABS(SAVE1*0.000001)
      ALOWER=SAVE1-EPS
      AUPPER=SAVE1+EPS
      IF(ALOWER.LE.X.AND.X.LE.AUPPER)TERM=1.0
      GOTO9000
C
  421 CONTINUE
      IBASE1=8
      IBASE2=10
      GOTO424
  422 CONTINUE
      IBASE1=10
      IBASE2=8
      GOTO424
  424 CONTINUE
      ARG=X
      IX=ARG+0.5
      ISIGN='+'
      IF(IX.LT.0)ISIGN='-'
      ISUM=0
      DO425IBIT=1,NUMBPW
      INEWX=IX/IBASE2
      IDIG=IX-IBASE2*INEWX
      ISUM=ISUM+IDIG*IBASE1**(IBIT-1)
      IF(INEWX.LE.0)GOTO426
      IX=INEWX
  425 CONTINUE
  426 CONTINUE
      IF(ISIGN.EQ.'-')ISUM=-ISUM
      TERM=ISUM
      GOTO9000
C
  441 CONTINUE
      ARG1=X*SQRT(2.0)
      CALL NORCDF(ARG1,RESULT)
      TERM=2.0*RESULT-1.0
      GOTO9000
C
  442 CONTINUE
      ARG1=X*SQRT(2.0)
      CALL NORCDF(ARG1,RESULT)
      TERM=2.0*RESULT-1.0
      TERM=1.0-TERM
      GOTO9000
C
  443 CONTINUE
      TERM=X
      IF(SAVE1.LT.X)TERM=SAVE1
      GOTO9000
C
  444 CONTINUE
      TERM=X
      IF(SAVE1.GT.X)TERM=SAVE1
      GOTO9000
C
  445 CONTINUE
      ARG=X
      CALL GAMMAF(ARG,TERM)
      GOTO9000
C
  446 CONTINUE
      ARG=X
      CALL LOGGAM(ARG,TERM)
      GOTO9000
C
  447 CONTINUE
      TERM=0.0
      IF(SAVE1.LT.X)TERM=X-SAVE1
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (JULIA) WAS ADDED MARCH 1989
  510 CONTINUE
      XCALC=X
      YCALC=SAVE1
      X0=SAVE2
      Y0=SAVE3
      IMAX=100
      ICOUNT=0
      CUT=10.0**6
      DO511I=1,IMAX
      ICOUNT=ICOUNT+1
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1993 (ALAN)
      XTEMP=XCALC
      XCALC=XCALC**2-YCALC**2+X0
CCCCC THE FOLLOWING LINE WAS FIXED JULY 1993 (ALAN)
CCCCC YCALC=2.0*XCALC*YCALC+Y0
      YCALC=2.0*XTEMP*YCALC+Y0
      IF(ABS(XCALC).GT.CUT)GOTO515
      IF(ABS(YCALC).GT.CUT)GOTO515
  511 CONTINUE
  515 CONTINUE
      TERM=ICOUNT
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (BINPAT(X,K)) WAS ADDED JANUARY 1990
CCCCC BINPAT WILL OUTPUT A -1 OR +1
  610 CONTINUE
      IX=X+0.1
      ISAVE=SAVE1+0.1
      IMOD=2**ISAVE
      IMOD2=IMOD/2
      IX2=MOD(IX,IMOD)
      IF(IX2.EQ.0)IX2=IMOD
      IX3=1
      IF(IX2.LE.IMOD2)IX3=(-1)
      TERM=IX3
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (BETA(A,B)) WAS ADDED SEPTEMBER 1994
  620 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DRESLT=DBETA(DARG1,DARG2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (BETAI(A,B)) WAS ADDED SEPTEMBER 1994
  630 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DRESLT=DBETAI(DARG1,DARG2,DARG3)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (LNBETA(A,B)) WAS ADDED SEPTEMBER 1994
  640 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DRESLT=DLBETA(DARG1,DARG2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (GAMMAI(X,P)) WAS ADDED SEPTEMBER 1994
  650 CONTINUE
      DARG2=DBLE(X)
      DARG1=DBLE(SAVE1)
      DRESLT=DGAMI(DARG1,DARG2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (GAMMAIP(X,P)) WAS ADDED SEPTEMBER 1994
  652 CONTINUE
      DARG2=DBLE(X)
      DARG1=DBLE(SAVE1)
      DRESLT=DGAMIP(DARG1,DARG2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (GAMMAIC(X,P)) WAS ADDED SEPTEMBER 1994
  655 CONTINUE
      DARG2=DBLE(X)
      DARG1=DBLE(SAVE1)
      DRESLT=DGAMIC(DARG1,DARG2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (GAMMAR(X)) WAS ADDED SEPTEMBER 1994
  660 CONTINUE
      DARG1=DBLE(X)
      DRESLT=DGAMR(DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (DIGAMMA(X)) WAS ADDED SEPTEMBER 1994
  670 CONTINUE
      DARG1=DBLE(X)
      DRESLT=DPSI(DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (PSIFN(X,N)) WAS ADDED OCTOBER 1997
 1670 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LE.0.0D0)THEN
        WRITE(ICOUT,1676)
        CALL DPWRST('XXX','BUG')
        GOTO9000
      ENDIF
 1676 FORMAT('***** ERROR FROM PSIFN--FIRST ARGUMENT NOT POSITIVE')
      IARG1=INT(SAVE1+0.5)
      IF(IARG1.LT.0.0.OR.IARG1.GT.100)THEN
        WRITE(ICOUT,1677)
        CALL DPWRST('XXX','BUG')
        GOTO9000
      ENDIF
 1677 FORMAT('***** ERROR FROM PSIFN--SECOND ARGUMENT NOT ',
     1'IN THE RANGE (0,100)')
      IARG2=1
      IARG3=1
      IARG4=0
      IERR=0
      CALL DPSIFN(DARG1,IARG1,IARG2,IARG3,DRESLT,IARG4,IERR)
      IF(IERR.LE.0)THEN
        TERM=SNGL(DRESLT)
      ELSEIF(IERR.EQ.1)THEN
        WRITE(ICOUT,1671)
        CALL DPWRST('XXX','BUG')
      ELSEIF(IERR.EQ.2)THEN
        WRITE(ICOUT,1672)
        CALL DPWRST('XXX','BUG')
      ELSEIF(IERR.EQ.3)THEN
        WRITE(ICOUT,1673)
        CALL DPWRST('XXX','BUG')
      ELSE
        TERM=SNGL(DRESLT)
      ENDIF
 1671 FORMAT('**** ERROR FROM PSIFN--INPUT ERROR')
 1672 FORMAT('**** ERROR FROM PSIFN--OVERFLOW, EITHER X IS TOO ',
     1'SMALL OR ORDER IS TOO LARGE')
 1673 FORMAT('**** ERROR FROM PSIFN--ORDER IS TOO LARGE')
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (TRICOMI(X,A)) WAS ADDED SEPTEMBER 1994
  680 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DRESLT=DGAMIT(DARG2,DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (POCH(X,A)) WAS ADDED SEPTEMBER 1994
  690 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DRESLT=DPOCH(DARG2,DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (POCH1(X,A)) WAS ADDED SEPTEMBER 1994
  700 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DRESLT=DPOCH1(DARG2,DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CHU(X)) WAS ADDED SEPTEMBER 1994
  710 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DRESLT=DCHU(DARG2,DARG3,DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (HEAVE(X,A,B)) WAS ADDED MARCH 1995
CCCCC HEAVSIDE FUNCTION IS 1 IF X>= 0, 0 IF X < 0. TEST FOR A SHIFT
CCCCC PARAMETER, THE FUNCTION IS 1 IF A <= X <= B, 0 OTHERWISE
  810 CONTINUE
      IF(SAVE1.NE.-99.9)THEN
        ARG2=SAVE1
      ELSE
        ARG2=0.0
      ENDIF
      IF(SAVE2.NE.-99.9)THEN
        ARG3=SAVE2
      ELSE
        ARG3=CPUMAX
      ENDIF
      TERM=0.0
      IF(ARG2.LE.ARG3)THEN
        IF(X.GE.ARG2.AND.X.LE.ARG3)TERM=1.0
      ELSE
        IF(X.GE.ARG3.AND.X.LE.ARG2)TERM=1.0
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (STEP(X)) WAS ADDED MARCH 1995
  820 CONTINUE
      ARG1=X
      IF(ARG1.GE.0.0)THEN
        IARG2=INT(ARG1)
        TERM=REAL(IARG2)
      ELSE
        IARG2=INT(ARG1)
        ARG3=REAL(IARG2)
        ARG4=ARG1-ARG3
        TERM=ARG3
        IF(ARG4.NE.0.0)TERM=TERM-1.0
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CEIL(X)) WAS ADDED MARCH 1995
CCCCC CEILING FUNCTION ROUNDS TO INTEGER TOWARDS POSITIVE INFINITY
  830 CONTINUE
      ARG1=X
      IF(ARG1.GE.0.0)THEN
        IARG2=INT(ARG1)
        ARG3=REAL(IARG2)
        ARG4=ARG1-ARG3
        TERM=ARG3
        IF(ARG4.NE.0.0)TERM=TERM+1.0
      ELSE
        IARG2=INT(ARG1)
        TERM=REAL(IARG2)
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (FLOOR(X)) WAS ADDED MARCH 1995
CCCCC FLOOR FUNCTION ROUNDS TO INTEGER TOWARDS NEGATIVE INFINITY
  840 CONTINUE
      ARG1=X
      IF(ARG1.LE.0.0)THEN
        IARG2=INT(ARG1)
        ARG3=REAL(IARG2)
        ARG4=ARG1-ARG3
        TERM=ARG3
        IF(ARG4.NE.0.0)TERM=TERM-1.0
      ELSE
        IARG2=INT(ARG1)
        TERM=REAL(IARG2)
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (GCD(IX1,IX2)) WAS ADDED MARCH 1995
CCCCC FINDS GREATEST COMMON DIVISOR OF 2 NUMBERS.
  850 CONTINUE
      IARG1=INT(X+0.5)
      ITERM1=IABS(IARG1)
      IARG2=INT(SAVE1+0.5)
      ITERM2=IABS(IARG2)
      IF(ITERM1.EQ.0)THEN
        TERM=REAL(ITERM2)
      ELSE
 851    CONTINUE
        IARG3=MOD(ITERM2,ITERM1)
        IF(IARG3.EQ.0)THEN
          TERM=REAL(ITERM1)
          GOTO9000
        ENDIF
        ITERM2=ITERM1
        ITERM1=IARG3
        GOTO851
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (LAMBDA(X,A)) WAS ADDED MARCH 1997
CCCCC CALL DIFFERENT ROUTINE BASED ON INTEGER OR REAL ORDER.
  860 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ITEMP=INT(DARG2)
      DARG3=DABS(DARG2-DBLE(ITEMP))
      IERROR='NO'
      IF(DARG3.LT.0.0D-20)THEN
        CALL LAMN(INT(DARG2),DARG1,NJUNK,DRESLT,DARG3,IERROR)
      ELSE
        CALL LAMV(DARG2,DARG1,DARG4,DRESLT,DARG3,IERROR)
      ENDIF
      IF(IERROR.EQ.'YES')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,861)
  861   FORMAT('***** ERROR.  ORDER OF LAMBDA FUNCTION MUST BE ',
     1         'LESS THAN 500.')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ELSE
        TERM=SNGL(DRESLT)
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (LAMBDAP(X,A)) WAS ADDED MARCH 1997
CCCCC CALL DIFFERENT ROUTINE BASED ON INTEGER OR REAL ORDER.
  870 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ITEMP=INT(DARG2)
      DARG3=DABS(DARG2-DBLE(ITEMP))
      IERROR='NO'
      IF(DARG3.LT.0.0D-20)THEN
        CALL LAMN(INT(DARG2),DARG1,NJUNK,DARG3,DRESLT,IERROR)
      ELSE
        CALL LAMV(DARG2,DARG1,DARG4,DARG3,DRESLT,IERROR)
      ENDIF
      IF(IERROR.EQ.'YES')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,871)
  871   FORMAT('***** ERROR.  ORDER OF LAMBDA FUNCTION MUST BE ',
     1         'LESS THAN 500.')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ELSE
        TERM=SNGL(DRESLT)
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (H0(X)) WAS ADDED MARCH 1997
  880 CONTINUE
      IF(X.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,881)
  881   FORMAT('***** ERROR.  FIRST ARGUMENT TO H0 MUST BE ',
     1         'NON-NEGATIVE.')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      DARG1=DBLE(X)
      CALL STVH0(DARG1,DRESLT)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (H1(X)) WAS ADDED MARCH 1997
  890 CONTINUE
      IF(X.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,891)
  891   FORMAT('***** ERROR.  FIRST ARGUMENT TO H1 MUST BE ',
     1         'NON-NEGATIVE.')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      DARG1=DBLE(X)
      CALL STVH1(DARG1,DRESLT)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (HV(X,V)) WAS ADDED MARCH 1997
  900 CONTINUE
      DARG1=DBLE(X)
      IF(X.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,901)
  901   FORMAT('***** ERROR.  FIRST ARGUMENT TO HV MUST BE ',
     1         'NON-NEGATIVE.')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      IF(SAVE1.LT.-8.5 .OR. SAVE1.GT.12.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,906)
  906   FORMAT('***** ERROR.  SECOND ARGUMENT TO HV MUST BE IN THE ',
     1         'RANGE (-8.5, 12.5).')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      DARG2=DBLE(SAVE1)
      CALL STVHV(DARG2,DARG1,DRESLT)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (L0(X)) WAS ADDED MARCH 1997
  910 CONTINUE
      IF(X.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,911)
  911   FORMAT('***** ERROR.  FIRST ARGUMENT TO L0 MUST BE ',
     1         'NON-NEGATIVE.')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      DARG1=DBLE(X)
      CALL STVL0(DARG1,DRESLT)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (L1(X)) WAS ADDED MARCH 1997
  920 CONTINUE
      IF(X.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,921)
  921   FORMAT('***** ERROR.  FIRST ARGUMENT TO L1 MUST BE ',
     1         'NON-NEGATIVE.')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      DARG1=DBLE(X)
      CALL STVL1(DARG1,DRESLT)
      TERM=SNGL(DRESLT)
      GOTO9000
CCCCC THE FOLLOWING SECTION (LV(X,V)) WAS ADDED MARCH 1997
  930 CONTINUE
      DARG1=DBLE(X)
      IF(X.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,931)
  931   FORMAT('***** ERROR.  FIRST ARGUMENT TO HV MUST BE ',
     1         'NON-NEGATIVE.')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      IF(SAVE1.LT.-20.0 .OR. SAVE1.GT.20.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,936)
  936   FORMAT('***** ERROR.  SECOND ARGUMENT TO HV MUST BE IN THE ',
     1         'RANGE (-20.0, 20.0).')
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      DARG2=DBLE(SAVE1)
      CALL STVLV(DARG2,DARG1,DRESLT)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CHM(X)) WAS ADDED JULY 1997
  940 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      CALL CHM(DARG2,DARG3,DARG1,DRESLT,IERR2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CGAMMA(XR,XC)) WAS ADDED AUGUST 1997
  950 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ICODE=1
      CALL CGAMA(DARG1,DARG2,ICODE,DRESLT,DRSLT2)
      TERM=REAL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CLNGAM(XR,XC)) WAS ADDED AUGUST 1997
  955 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ICODE=0
      CALL CGAMA(DARG1,DARG2,ICODE,DRESLT,DRSLT2)
      TERM=REAL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CGAMMAI(XR,XC)) WAS ADDED AUGUST 1997
  960 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ICODE=1
      CALL CGAMA(DARG1,DARG2,ICODE,DRESLT,DRSLT2)
      TERM=REAL(DRSLT2)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CLNGAMI(XR,XC)) WAS ADDED AUGUST 1997
  965 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ICODE=0
      CALL CGAMA(DARG1,DARG2,ICODE,DRESLT,DRSLT2)
      TERM=REAL(DRSLT2)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CPSI(XR,XC)) WAS ADDED AUGUST 1997
  970 CONTINUE
      ARG1=DBLE(X)
      ARG2=DBLE(SAVE1)
      ZARG=CMPLX(ARG1,ARG2)
      ZRESLT=CPSI(ZARG)
      TERM=REAL(ZRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CPSII(XR,XC)) WAS ADDED AUGUST 1997
  980 CONTINUE
      ARG1=DBLE(X)
      ARG2=DBLE(SAVE1)
      ZARG=CMPLX(ARG1,ARG2)
      ZRESLT=CPSI(ZARG)
      TERM=AIMAG(ZRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (HYPERGEO(X,A,B,C)) WAS ADDED AUGUST 1997
  990 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      IF(DABS(DARG1).GE.1.0D0)THEN
        WRITE(ICOUT,992)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
  992 FORMAT('***** ERROR: HYPERGEO FUNCTION IS CURRENTLY ONLY ',
     1'SUPPORTED FOR ARGUMENTS WITH ABSOLUTE VALUE LESS THAN 1')
      CALL HYGFX(DARG2,DARG3,DARG4,DARG1,DRESLT,IERR2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (PBDV(X,A)) WAS ADDED AUGUST 1997
 1000 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      CALL PBDV(DARG2,DARG1,DTEMP1,DTEMP2,DRESLT,DRSLT2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (PBDV1(X,A)) WAS ADDED AUGUST 1997
 1010 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      CALL PBDV(DARG2,DARG1,DTEMP1,DTEMP2,DRESLT,DRSLT2)
      TERM=SNGL(DRSLT2)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (PBVV(X,A)) WAS ADDED AUGUST 1997
 1020 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      CALL PBVV(DARG2,DARG1,DTEMP1,DTEMP2,DRESLT,DRSLT2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (PBVV1(X,A)) WAS ADDED AUGUST 1997
 1030 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      CALL PBVV(DARG2,DARG1,DTEMP1,DTEMP2,DRESLT,DRSLT2)
      TERM=SNGL(DRSLT2)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (PBWA(X,A)) WAS ADDED AUGUST 1997
CCCCC PUT CHECK FOR ABSOLUTE VALUE OF ARGUMENTS <= 5.  SPETEMBER 1997.
 1040 CONTINUE
      DARG1=DBLE(ABS(X))
      DARG2=DBLE(SAVE1)
      IF(DABS(DARG1).GT.5.0D0)THEN
        WRITE(ICOUT,1042)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1042 FORMAT('***** ERROR: ABSOLUTE VALUE OF FIRST ARGUMENT TO ',
     1'PBWA MUST BE LESS THAN OR EQUAL TO 5.')
      IF(DABS(DARG2).GT.5.0D0)THEN
        WRITE(ICOUT,1044)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1044 FORMAT('***** ERROR: ABSOLUTE VALUE OF SECOND ARGUMENT TO ',
     1'PBWA MUST BE LESS THAN OR EQUAL TO 5.')
      CALL PBWA(DARG2,DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4)
      IF(X.GE.0.0)THEN
        TERM=SNGL(DRESLT)
      ELSE
        TERM=SNGL(DRSLT3)
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (PBWA1(X,A)) WAS ADDED AUGUST 1997
 1050 CONTINUE
      DARG1=DBLE(ABS(X))
      DARG2=DBLE(SAVE1)
      CALL PBWA(DARG2,DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4)
      IF(X.GE.0.0)THEN
        TERM=SNGL(DRSLT2)
      ELSE
        TERM=SNGL(DRSLT4)
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CLNBETA(XR,XC)) WAS ADDED AUGUST 1997
 1060 CONTINUE
      TERM=0.0
      DARG1=DBLE(X)
      IF(DARG1.LE.0.D0)THEN
        WRITE(ICOUT,1061)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
 1061 FORMAT('****** ERROR FROM CLNBETA: FIRST ARGUMENT MUST BE ',
     1'POSITIVE.')
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      IF(DARG3.LE.0.D0)THEN
        WRITE(ICOUT,1062)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
 1062 FORMAT('****** ERROR FROM CLNBETA: THIRD ARGUMENT MUST BE ',
     1'POSITIVE.')
      DARG4=DBLE(SAVE2)
      ICODE=0
      CALL CGAMA(DARG1,DARG2,ICODE,DRESLT,DRSLT2)
      CALL CGAMA(DARG3,DARG4,ICODE,DRSLT3,DRSLT4)
      CALL CGAMA(DARG1+DARG3,DARG2+DARG4,ICODE,DRSLT5,DRSLT6)
      TERM=REAL(DRESLT + DRSLT3 - DRSLT5)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CLNBETAI(XR,XC)) WAS ADDED AUGUST 1997
 1070 CONTINUE
      TERM=0.0
      DARG1=DBLE(X)
      IF(DARG1.LE.0.D0)THEN
        WRITE(ICOUT,1071)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
 1071 FORMAT('****** ERROR FROM CLNBETAI: FIRST ARGUMENT MUST BE ',
     1'POSITIVE.')
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      IF(DARG3.LE.0.D0)THEN
        WRITE(ICOUT,1072)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
 1072 FORMAT('****** ERROR FROM CLNBETAI: THIRD ARGUMENT MUST BE ',
     1'POSITIVE.')
      DARG4=DBLE(SAVE2)
      ICODE=0
      CALL CGAMA(DARG1,DARG2,ICODE,DRESLT,DRSLT2)
      CALL CGAMA(DARG3,DARG4,ICODE,DRSLT3,DRSLT4)
      CALL CGAMA(DARG1+DARG3,DARG2+DARG4,ICODE,DRSLT5,DRSLT6)
      TERM=REAL(DRSLT2 + DRSLT4 - DRSLT6)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CBETA(XR,XC)) WAS ADDED SEPTEMBER 1997
 1080 CONTINUE
      TERM=0.0
      DARG1=DBLE(X)
      IF(DARG1.LE.0.D0)THEN
        WRITE(ICOUT,1081)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
 1081 FORMAT('****** ERROR FROM CBETA: FIRST ARGUMENT MUST BE ',
     1'POSITIVE.')
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      IF(DARG3.LE.0.D0)THEN
        WRITE(ICOUT,1082)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
 1082 FORMAT('****** ERROR FROM CBETA: THIRD ARGUMENT MUST BE ',
     1'POSITIVE.')
      DARG4=DBLE(SAVE2)
      ICODE=0
      CALL CGAMA(DARG1,DARG2,ICODE,DRESLT,DRSLT2)
      CALL CGAMA(DARG3,DARG4,ICODE,DRSLT3,DRSLT4)
      CALL CGAMA(DARG1+DARG3,DARG2+DARG4,ICODE,DRSLT5,DRSLT6)
      TERM=SNGL(DEXP(DRESLT + DRSLT3 - DRSLT5))
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CBETAI(XR,XC)) WAS ADDED SEPTEMBER 1997
 1090 CONTINUE
      TERM=0.0
      DARG1=DBLE(X)
      IF(DARG1.LE.0.D0)THEN
        WRITE(ICOUT,1091)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
 1091 FORMAT('****** ERROR FROM CBETAI: FIRST ARGUMENT MUST BE ',
     1'POSITIVE.')
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      IF(DARG3.LE.0.D0)THEN
        WRITE(ICOUT,1092)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
 1092 FORMAT('****** ERROR FROM CBETAI: THIRD ARGUMENT MUST BE ',
     1'POSITIVE.')
      DARG4=DBLE(SAVE2)
      ICODE=0
      CALL CGAMA(DARG1,DARG2,ICODE,DRESLT,DRSLT2)
      CALL CGAMA(DARG3,DARG4,ICODE,DRSLT3,DRSLT4)
      CALL CGAMA(DARG1+DARG3,DARG2+DARG4,ICODE,DRSLT5,DRSLT6)
      TERM=SNGL(DEXP(DRSLT2 + DRSLT4 - DRSLT6))
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (ZETA(X)) WAS ADDED SEPTEMBER 1997
 1100 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LE.1.0D0)THEN
        WRITE(ICOUT,1101)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
 1101 FORMAT('***** ERROR: ARGUMENT FOR ZETA FUNCTION MUST ',
     1'BE > 1')
      ENDIF
      CALL ZETA(DARG1,DRESLT)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (BER(X)) WAS ADDED SEPTEMBER 1997
 1110 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LT.0.D0)THEN
        WRITE(ICOUT,1112)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1112 FORMAT('***** ERROR FROM BER: ARGUMENT MUST BE GREATER ',
     1'THAN OR EQUAL TO ZERO.')
      CALL KLVNA(DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4,DRSLT5,
     1DRSLT6,DRSLT7,DRSLT8)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (BERI(X)) WAS ADDED SEPTEMBER 1997
 1120 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LT.0.D0)THEN
        WRITE(ICOUT,1122)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1122 FORMAT('***** ERROR FROM BERI: ARGUMENT MUST BE GREATER ',
     1'THAN OR EQUAL TO ZERO.')
      CALL KLVNA(DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4,DRSLT5,
     1DRSLT6,DRSLT7,DRSLT8)
      TERM=SNGL(DRSLT2)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (BER1(X)) WAS ADDED SEPTEMBER 1997
 1130 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LT.0.D0)THEN
        WRITE(ICOUT,1132)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1132 FORMAT('***** ERROR FROM BER1: ARGUMENT MUST BE GREATER ',
     1'THAN OR EQUAL TO ZERO.')
      CALL KLVNA(DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4,DRSLT5,
     1DRSLT6,DRSLT7,DRSLT8)
      TERM=SNGL(DRSLT5)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (BERI1(X)) WAS ADDED SEPTEMBER 1997
 1140 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LT.0.D0)THEN
        WRITE(ICOUT,1142)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1142 FORMAT('***** ERROR FROM BERI1: ARGUMENT MUST BE GREATER ',
     1'THAN OR EQUAL TO ZERO.')
      CALL KLVNA(DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4,DRSLT5,
     1DRSLT6,DRSLT7,DRSLT8)
      TERM=SNGL(DRSLT6)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (KER(X)) WAS ADDED SEPTEMBER 1997
 1150 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LE.0.D0)THEN
        WRITE(ICOUT,1152)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1152 FORMAT('***** ERROR FROM KER: ARGUMENT MUST BE POSITIVE ')
      CALL KLVNA(DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4,DRSLT5,
     1DRSLT6,DRSLT7,DRSLT8)
      TERM=SNGL(DRSLT3)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (KERI(X)) WAS ADDED SEPTEMBER 1997
 1160 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LT.0.D0)THEN
        WRITE(ICOUT,1162)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1162 FORMAT('***** ERROR FROM KERI: ARGUMENT MUST BE GREATER ',
     1'THAN OR EQUAL TO ZERO.')
      CALL KLVNA(DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4,DRSLT5,
     1DRSLT6,DRSLT7,DRSLT8)
      TERM=SNGL(DRSLT4)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (KER1(X)) WAS ADDED SEPTEMBER 1997
 1170 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LE.0.D0)THEN
        WRITE(ICOUT,1172)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1172 FORMAT('***** ERROR FROM KER1: ARGUMENT MUST BE POSITIVE ')
      CALL KLVNA(DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4,DRSLT5,
     1DRSLT6,DRSLT7,DRSLT8)
      TERM=SNGL(DRSLT7)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (KERI1(X)) WAS ADDED SEPTEMBER 1997
 1180 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LT.0.D0)THEN
        WRITE(ICOUT,1182)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
 1182 FORMAT('***** ERROR FROM KERI1: ARGUMENT MUST BE GREATER ',
     1'THAN OR EQUAL TO ZERO.')
      CALL KLVNA(DARG1,DRESLT,DRSLT2,DRSLT3,DRSLT4,DRSLT5,
     1DRSLT6,DRSLT7,DRSLT8)
      TERM=SNGL(DRSLT8)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (ETA(X)) WAS ADDED SEPTEMBER 1997
 1190 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LT.1.0D0)THEN
        WRITE(ICOUT,1191)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
 1191 FORMAT('***** ERROR: ARGUMENT FOR ETA FUNCTION MUST ',
     1'BE > 1')
      ELSEIF(DARG1.EQ.1.0D0)THEN
        TERM=-0.30685281944
        GOTO9000
      ENDIF
      CALL ZETA(DARG1,DRESLT)
      DARG2=2.0D0**(1.0D0-DARG1)
      DRSLT2=(1.0D0-DARG2)*DRESLT - DARG2
      TERM=SNGL(DRSLT2)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (CATLAN(X)) WAS ADDED SEPTEMBER 1997
 1200 CONTINUE
      DARG1=DBLE(X)
      IF(DARG1.LT.1.0D0)THEN
        WRITE(ICOUT,1201)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
 1201 FORMAT('***** ERROR: ARGUMENT FOR CATLAN FUNCTION MUST ',
     1'BE >= 1')
      ENDIF
      CALL CATLAN(DARG1,DRESLT)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (FERMDIRA(X,ORD)) WAS ADDED MAY 2002
 1210 CONTINUE
      DARG1=DBLE(X)
      ARG2=SAVE1
      IF(ABS(ARG2 - (-0.5)).LE.0.01)THEN
        DRESLT=FDM0P5(DARG1)
      ELSEIF(ABS(ARG2 - 0.5).LE.0.01)THEN
        DRESLT=FDP0P5(DARG1)
      ELSEIF(ABS(ARG2 - 1.5).LE.0.01)THEN
        DRESLT=FDP1P5(DARG1)
      ELSEIF(ABS(ARG2 - 2.5).LE.0.01)THEN
        DRESLT=FDP2P5(DARG1)
      ELSE
        WRITE(ICOUT,1211)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1213)ARG2
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
 1211 FORMAT('***** ERROR: ORDER FOR FERMDIRA FUNCTION MUST BE ',
     1       '-0.5, 0.5, 1.5, OR 2.5.')
 1213 FORMAT('      REQUESTED ORDER IS ',E15.7)
      ENDIF
      IF(DRESLT.GE.DBLE(CPUMAX))THEN
        WRITE(ICOUT,1216)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1218)REAL(DARG1)
        CALL DPWRST('XXX','BUG')
        TERM=CPUMAX
        GOTO9000
 1216 FORMAT('***** ERROR: RESULT FOR FERMDIRA FUNCTION OVERFLOWS ',
     1      'MAXIMUM ALLOWED.')
 1218 FORMAT('      X = ',E15.7)
      ELSE
        TERM=REAL(DRESLT)
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGEV.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPLIB1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IH,IH2,X
 9012 FORMAT('IH,IH2,X = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)SAVE1,SAVE2,SAVE3,I,IANGLU
 9013 FORMAT('SAVE1,SAVE2,SAVE3,I,IANGLU = ',3E15.7,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)RESULT,TERM,IBUGEV
 9014 FORMAT('RESULT,TERM,IBUGEV = ',2E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFOUND,IERROR
 9015 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLIB2(IH,IH2,X,SAVE1,SAVE2,I,IANGLU,
     1TERM,IBUGEV,IFOUND,IERROR)
C
C     PURPOSE--PERFORM A LIBRARY FUNCTION EVALUATION.
C     NOTE--THIS IS PART 2
C          (EVALUATE TRIGONOMETRIC FUNCTIONS)
C
C     NOTE--DOMAIN OF TRIG ARGUMENT (JULY 1988)
C
C     SIN(X)       -INF < X < INF
C     COS(X)       -INF < X < INF
C     TAN(X)       NOT +-PI/2  +-3PI/2  +-5PI/2  ... (WHENEVER COS IS 0)
C     COT(X)       NOT 0  +-PI  +-2PI  +-3PI  ...    (WHENEVER SIN IS 0)
C     SEC(X)       NOT +-PI/2  +-3PI/2  +-5PI/2  ... (WHENEVER COS IS 0)
C     CSC(X)       NOT 0  +-PI  +-2PI  +-3PI  ...    (WHENEVER SIN IS 0)
C
C     ARCSIN(X)    -1 <= X <= 1      YIELDING -PI/2 <= Y <= PI/2 (PRIN. BR.)
C     ARCCOS(X)    -1 <= X <= 1      YIELDING 0 <= Y <= PI (PRIN. BR.)
C     ARCTAN(X)    -INF < X < INF    YIELDING -PI/2 < Y < PI/2 (PRIN BR.)
C     ARCCOT(X)    -INF < X < INF    YIELDING 0 < X < PI/2 (PRIN. BR.)
C     ARCSEC(X)    X>= 1   X <= -1   YIELDING 0 <= Y < PI/2   -PI <= X < -PI/2 (
C                                    COMPUTED YIELDS 0 <= Y < PI/2   PI/2 < Y <=
C     ARCCSC(X)    X>= 1   X <= -1   YIELDING 0 < Y <= PI/2    -PI < Y <= -PI/2
C                                    COMPUTED YIELDS 0 <= Y < PI/2   -PI/2 <= Y
C
C     SINH(X)      -INF < X < INF
C     COSH(X)      0 <= X < INF
C     TANH(X)      0 <= X < INF
C     COTH(X)      0 < X < INF
C     SECH(X)      0 <= X < INF
C     CSCH(X)      X NOT= 0 ?
C
C     ARCSINH(X)   -INF < X < INF
C     ARCCOSH(X)   X >= 1
C     ARCTANH(X)   -1 < X < 1
C     ARCCOTH(X)   X > 1   X < -1
C     ARCSECH(X)   0 < X <= 1
C     ARCCSCH(X)   X NOT= 0
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JANUARY  1979.
C     UPDATED         --NOVEMBER  1979.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JULY      1988.  (HEAVY RENUMBERING + 0-DIVIDE CHECKS
C                                        + PROPER DOMAIN CHECKS)
C     UPDATED         --JANUARY   1989.  ASYMPTOTIC TRAPS FOR HYP TRIG FUNC
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGEV
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
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-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.1415926536/
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPLI'
      ISUBN2='B1  '
C
      RESULT=0.0
C
      IF(IBUGEV.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IH,IH2,X
   52 FORMAT('IH,IH2,X = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)SAVE1,SAVE2,I,IANGLU
   53 FORMAT('SAVE1,SAVE2,I,IANGLU = ',E15.7,E15.7,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)TERM,IBUGEV,NUMBPW
   54 FORMAT('TERM,IBUGEV,NUMBPW = ',E15.7,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IFOUND,IERROR
   55 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
C
      IF(IH.EQ.'SIN '.AND.IH2.EQ.'    ')GOTO1100
      IF(IH.EQ.'COS '.AND.IH2.EQ.'    ')GOTO1200
      IF(IH.EQ.'TAN '.AND.IH2.EQ.'    ')GOTO1300
      IF(IH.EQ.'COT '.AND.IH2.EQ.'    ')GOTO1400
      IF(IH.EQ.'SEC '.AND.IH2.EQ.'    ')GOTO1500
      IF(IH.EQ.'CSC '.AND.IH2.EQ.'    ')GOTO1600
C
      IF(IH.EQ.'ARCS'.AND.IH2.EQ.'IN  ')GOTO2100
      IF(IH.EQ.'ARCC'.AND.IH2.EQ.'OS  ')GOTO2200
      IF(IH.EQ.'ARCT'.AND.IH2.EQ.'AN  ')GOTO2300
      IF(IH.EQ.'ARCC'.AND.IH2.EQ.'OT  ')GOTO2400
      IF(IH.EQ.'ARCS'.AND.IH2.EQ.'EC  ')GOTO2500
      IF(IH.EQ.'ARCC'.AND.IH2.EQ.'SC  ')GOTO2600
C
      IF(IH.EQ.'SINH'.AND.IH2.EQ.'    ')GOTO3100
      IF(IH.EQ.'COSH'.AND.IH2.EQ.'    ')GOTO3200
      IF(IH.EQ.'TANH'.AND.IH2.EQ.'    ')GOTO3300
      IF(IH.EQ.'COTH'.AND.IH2.EQ.'    ')GOTO3400
      IF(IH.EQ.'SECH'.AND.IH2.EQ.'    ')GOTO3500
      IF(IH.EQ.'CSCH'.AND.IH2.EQ.'    ')GOTO3600
C
      IF(IH.EQ.'ARCS'.AND.IH2.EQ.'INH ')GOTO4100
      IF(IH.EQ.'ARCC'.AND.IH2.EQ.'OSH ')GOTO4200
      IF(IH.EQ.'ARCT'.AND.IH2.EQ.'ANH ')GOTO4300
      IF(IH.EQ.'ARCC'.AND.IH2.EQ.'OTH ')GOTO4400
      IF(IH.EQ.'ARCS'.AND.IH2.EQ.'ECH ')GOTO4500
      IF(IH.EQ.'ARCC'.AND.IH2.EQ.'SCH ')GOTO4600
C
      IFOUND='NO'
      GOTO9000
C
C     STEP 10--
C     EVALUATE THE CIRCULAR TRIG FUNCTIONS
C
 1100 CONTINUE
      ARG=X
      IF(IANGLU.EQ.'DEGR')ARG=(PI/180.0)*ARG
      IF(IANGLU.EQ.'GRAD')ARG=(PI/200.0)*ARG
      TERM=SIN(ARG)
      GOTO9000
C
 1200 CONTINUE
      ARG=X
      IF(IANGLU.EQ.'DEGR')ARG=(PI/180.0)*ARG
      IF(IANGLU.EQ.'GRAD')ARG=(PI/200.0)*ARG
      TERM=COS(ARG)
      GOTO9000
C
 1300 CONTINUE
      ARG=X
      IF(IANGLU.EQ.'DEGR')ARG=(PI/180.0)*ARG
      IF(IANGLU.EQ.'GRAD')ARG=(PI/200.0)*ARG
      TEMP=COS(ARG)
      IF(TEMP.NE.0.0)GOTO1330
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      ATTEMPT TO TAKE THE TANGENT OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      WHICH IS AN ODD MULTIPLE OF PI/2.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1314)
 1314 FORMAT('      THIS IS ILLEGAL BECAUSE THE TANGENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('      IS INFINITE AT SUCH POINTS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)X
 1316 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1330 CONTINUE
      TERM=SIN(ARG)/TEMP
      GOTO9000
C
 1400 CONTINUE
      ARG=X
      IF(IANGLU.EQ.'DEGR')ARG=(PI/180.0)*ARG
      IF(IANGLU.EQ.'GRAD')ARG=(PI/200.0)*ARG
      TEMP=SIN(ARG)
      IF(TEMP.NE.0.0)GOTO1430
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      ATTEMPT TO TAKE THE COTANGENT OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      WHICH IS 0 OR A MULTIPLE OF PI.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
 1414 FORMAT('      THIS IS ILLEGAL BECAUSE THE COTANGENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      IS INFINITE AT SUCH POINTS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)X
 1416 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1430 CONTINUE
      TERM=COS(ARG)/TEMP
      GOTO9000
C
 1500 CONTINUE
      ARG=X
      IF(IANGLU.EQ.'DEGR')ARG=(PI/180.0)*ARG
      IF(IANGLU.EQ.'GRAD')ARG=(PI/200.0)*ARG
      TEMP=COS(ARG)
      IF(TEMP.NE.0.0)GOTO1530
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1511)
 1511 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1512)
 1512 FORMAT('      ATTEMPT TO TAKE THE SECANT OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1513)
 1513 FORMAT('      WHICH IS AN ODD MULTIPLE OF PI/2.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1514)
 1514 FORMAT('      THIS IS ILLEGAL BECAUSE THE SECANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('      IS INFINITE AT SUCH POINTS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1516)X
 1516 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1530 CONTINUE
      TERM=1.0/TEMP
      GOTO9000
C
 1600 CONTINUE
      ARG=X
      IF(IANGLU.EQ.'DEGR')ARG=(PI/180.0)*ARG
      IF(IANGLU.EQ.'GRAD')ARG=(PI/200.0)*ARG
      TEMP=SIN(ARG)
      IF(TEMP.NE.0.0)GOTO1630
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1611)
 1611 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1612)
 1612 FORMAT('      ATTEMPT TO TAKE THE COSECANT OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1613)
 1613 FORMAT('      WHICH IS 0 OR A MULTIPLE OF PI.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1614)
 1614 FORMAT('      THIS IS ILLEGAL BECAUSE THE COSECANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('      IS INFINITE AT SUCH POINTS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1616)X
 1616 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1630 CONTINUE
      TERM=1.0/TEMP
      GOTO9000
C
C     STEP 20--
C     EVALUATE THE INVERSE CIRCULAR TRIG FUNCTIONS
C
 2100 CONTINUE
      IF(-1.0.LE.X.AND.X.LE.1.0)GOTO2130
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)
 2112 FORMAT('      ATTEMPT TO TAKE ARCSIN OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      SMALLER THAN -1 OR LARGER THAN +1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      THIS IS ILLEGAL BECAUSE THE ARCSIN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      IS NOT DEFINED IN SUCH DOMAIN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)X
 2117 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2130 CONTINUE
      ARG=X
      IF(ARG.EQ.-1.0)RESULT=-PI/2.0
      IF(ARG.EQ.-1.0)GOTO2190
      IF(ARG.EQ.1.0)RESULT=PI/2.0
      IF(ARG.EQ.1.0)GOTO2190
      ARG2=ARG/SQRT(1.0-ARG*ARG)
      RESULT=ATAN(ARG2)
 2190 CONTINUE
      IF(IANGLU.EQ.'DEGR')RESULT=(180.0/PI)*RESULT
      IF(IANGLU.EQ.'GRAD')RESULT=(200.0/PI)*RESULT
      TERM=RESULT
      GOTO9000
C
 2200 CONTINUE
      IF(-1.0.LE.X.AND.X.LE.1.0)GOTO2230
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      ATTEMPT TO TAKE ARCCOS OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      SMALLER THAN -1 OR LARGER THAN +1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      THIS IS ILLEGAL BECAUSE THE ARCCOS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      IS NOT DEFINED IN SUCH DOMAIN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)X
 2217 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2230 CONTINUE
      ARG=X
      IF(ARG.EQ.-1.0)RESULT=PI
      IF(ARG.EQ.-1.0)GOTO2290
      IF(ARG.EQ.0.0)RESULT=PI/2.0
      IF(ARG.EQ.0.0)GOTO2290
      IF(ARG.EQ.1.0)RESULT=0.0
      IF(ARG.EQ.1.0)GOTO2290
      ARG2=(SQRT(1.0-ARG*ARG))/ARG
      RESULT=ATAN(ARG2)
      IF(RESULT.LT.0.0)RESULT=RESULT+PI
 2290 CONTINUE
      IF(IANGLU.EQ.'DEGR')RESULT=(180.0/PI)*RESULT
      IF(IANGLU.EQ.'GRAD')RESULT=(200.0/PI)*RESULT
      TERM=RESULT
      GOTO9000
C
 2300 CONTINUE
      ARG=X
      RESULT=ATAN(ARG)
      IF(IANGLU.EQ.'DEGR')RESULT=(180.0/PI)*RESULT
      IF(IANGLU.EQ.'GRAD')RESULT=(200.0/PI)*RESULT
      TERM=RESULT
      GOTO9000
C
 2400 CONTINUE
      IF(X.EQ.0.0)RESULT=PI/2.0
      IF(X.EQ.0.0)GOTO2490
      ARG=1.0/X
      RESULT=ATAN(ARG)
 2490 CONTINUE
      IF(IANGLU.EQ.'DEGR')RESULT=(180.0/PI)*RESULT
      IF(IANGLU.EQ.'GRAD')RESULT=(200.0/PI)*RESULT
      TERM=RESULT
      GOTO9000
C
 2500 CONTINUE
      IF(X.LE.-1.0.OR.X.GE.1.0)GOTO2530
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2511)
 2511 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2512)
 2512 FORMAT('      ATTEMPT TO TAKE ARCSEC OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2513)
 2513 FORMAT('      IN THE DOMAIN -1 TO +1 (EXCLUSIVE).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2514)
 2514 FORMAT('      THIS IS ILLEGAL BECAUSE THE ARCSEC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2515)
 2515 FORMAT('      IS NOT DEFINED IN SUCH DOMAIN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2517)X
 2517 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2530 CONTINUE
      ARG=1.0/X
      IF(ARG.EQ.-1.0)RESULT=PI
      IF(ARG.EQ.-1.0)GOTO2590
      IF(ARG.EQ.0.0)RESULT=PI/2.0
      IF(ARG.EQ.0.0)GOTO2590
      IF(ARG.EQ.1.0)RESULT=0.0
      IF(ARG.EQ.1.0)GOTO2590
      ARG2=(SQRT(1.0-ARG*ARG))/ARG
      RESULT=ATAN(ARG2)
      IF(RESULT.LT.0.0)RESULT=RESULT+PI
 2590 CONTINUE
      IF(IANGLU.EQ.'DEGR')RESULT=(180.0/PI)*RESULT
      IF(IANGLU.EQ.'GRAD')RESULT=(200.0/PI)*RESULT
      TERM=RESULT
      GOTO9000
C
 2600 CONTINUE
      IF(X.LE.-1.0.OR.X.GE.1.0)GOTO2630
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2611)
 2611 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2612)
 2612 FORMAT('      ATTEMPT TO TAKE ARCCSC OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2613)
 2613 FORMAT('      IN THE DOMAIN -1 TO +1 (EXCLUSIVE).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2614)
 2614 FORMAT('      THIS IS ILLEGAL BECAUSE THE ARCCSC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2615)
 2615 FORMAT('      IS NOT DEFINED IN SUCH DOMAIN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2617)X
 2617 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2630 CONTINUE
      ARG=1.0/X
      IF(ARG.EQ.-1.0)RESULT=-PI/2.0
      IF(ARG.EQ.-1.0)GOTO2690
      IF(ARG.EQ.1.0)RESULT=PI/2.0
      IF(ARG.EQ.1.0)GOTO2690
      ARG2=ARG/SQRT(1.0-ARG*ARG)
      RESULT=ATAN(ARG2)
 2690 CONTINUE
      IF(IANGLU.EQ.'DEGR')RESULT=(180.0/PI)*RESULT
      IF(IANGLU.EQ.'GRAD')RESULT=(200.0/PI)*RESULT
      TERM=RESULT
      GOTO9000
C
C     STEP 30--
C     EVALUATE THE HYPERBOLIC TRIG FUNCTIONS
C
 3100 CONTINUE
CCCCC THE ASYMPTOTIC TRAP WAS INSERTED JANUARY 1989
      ARG=X
      IF(ARG.GT.80.0)TERM=CPUMAX
      IF(ARG.LT.-80.0)TERM=(-CPUMAX)
      IF(-80.0.LE.ARG.AND.ARG.LE.80.0)TERM=(EXP(ARG)-EXP(-ARG))/2.0
      GOTO9000
C
 3200 CONTINUE
CCCCC THE ASYMPTOTIC TRAP WAS INSERTED JANUARY 1989
      ARG=X
      IF(ARG.GT.80.0)TERM=CPUMAX
      IF(ARG.LT.-80.0)TERM=CPUMAX
      IF(-80.0.LE.ARG.AND.ARG.LE.80.0)TERM=(EXP(ARG)+EXP(-ARG))/2.0
      GOTO9000
C
 3300 CONTINUE
CCCCC THE ASYMPTOTIC TRAP WAS INSERTED JANUARY 1989
      ARG=X
      IF(ARG.GT.40.0)TERM=1.0
      IF(ARG.LT.-40.0)TERM=(-1.0)
      IF(-40.0.LE.ARG.AND.ARG.LE.40.0)GOTO3310
      GOTO3319
 3310 CONTINUE
      TERM=(EXP(ARG)-EXP(-ARG))/(EXP(ARG)+EXP(-ARG))
      GOTO3319
 3319 CONTINUE
      GOTO9000
C
 3400 CONTINUE
CCCCC THE ASYMPTOTIC TRAP WAS INSERTED JANUARY 1989
      ARG=X
      IF(ARG.GT.40.0)TERM=1.0
      IF(ARG.LT.-40.0)TERM=(-1.0)
      IF(-40.0.LE.ARG.AND.ARG.LE.40.0)GOTO3410
      GOTO3419
 3410 CONTINUE
      TERM=(EXP(ARG)+EXP(-ARG))/(EXP(ARG)-EXP(-ARG))
      GOTO3419
 3419 CONTINUE
      GOTO9000
C
 3500 CONTINUE
CCCCC THE ASYMPTOTIC TRAP WAS INSERTED JANUARY 1989
      ARG=X
      IF(ARG.GT.80.0)TERM=0.0
      IF(ARG.LT.-80.0)TERM=0.0
      IF(-80.0.LE.ARG.AND.ARG.LE.80.0)TERM=2.0/(EXP(ARG)+EXP(-ARG))
      GOTO9000
C
 3600 CONTINUE
CCCCC THE ASYMPTOTIC TRAP WAS INSERTED JANUARY 1989
      ARG=X
      IF(ARG.GT.80.0)TERM=0.0
      IF(ARG.LT.-80.0)TERM=(-0.0)
      IF(-80.0.LE.ARG.AND.ARG.LE.80.0)TERM=2.0/(EXP(ARG)-EXP(-ARG))
      GOTO9000
C
C     STEP 40--
C     EVALUATE THE INVERSE HYPERBOLIC TRIG FUNCTIONS
C
 4100 CONTINUE
      ARG=X
      ARG2=ARG+SQRT(ARG*ARG+1.0)
      RESULT=ALOG(ARG2)
      TERM=RESULT
      GOTO9000
C
 4200 CONTINUE
      IF(X.GE.1.0)GOTO4230
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4211)
 4211 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4212)
 4212 FORMAT('      ATTEMPT TO TAKE ARCCOSH OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4213)
 4213 FORMAT('      SMALLER THAN -1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4214)
 4214 FORMAT('      THIS IS ILLEGAL BECAUSE THE ARCCOSH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4215)
 4215 FORMAT('      IS NOT DEFINED IN SUCH DOMAIN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4217)X
 4217 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4230 CONTINUE
      ARG=X
      IF(ARG.EQ.1.0)RESULT=0.0
      IF(ARG.EQ.1.0)GOTO4290
      ARG2=ARG+SQRT(ARG*ARG-1.0)
      RESULT=ALOG(ARG2)
 4290 CONTINUE
      TERM=RESULT
      GOTO9000
C
 4300 CONTINUE
      IF(-1.0.LT.X.AND.X.LT.1.0)GOTO4330
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4311)
 4311 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4312)
 4312 FORMAT('      ATTEMPT TO TAKE ARCTANH OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4313)
 4313 FORMAT('      <= -1 OR >= +1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4314)
 4314 FORMAT('      THIS IS ILLEGAL BECAUSE THE ARCTANH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4315)
 4315 FORMAT('      IS NOT DEFINED IN SUCH DOMAIN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4317)X
 4317 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4330 CONTINUE
      ARG=X
      ARG2=(1.0+ARG)/(1.0-ARG)
      RESULT=0.5*ALOG(ARG2)
      TERM=RESULT
      GOTO9000
C
 4400 CONTINUE
      IF(X.LT.-1.0.OR.1.0.LT.X)GOTO4430
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4411)
 4411 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4412)
 4412 FORMAT('      ATTEMPT TO TAKE ARCCOTH OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4413)
 4413 FORMAT('      IN THE DOMAIN -1 TO 1 (INCLUSIVE).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4414)
 4414 FORMAT('      THIS IS ILLEGAL BECAUSE THE ARCCOTH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4415)
 4415 FORMAT('      IS NOT DEFINED IN SUCH DOMAIN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4417)X
 4417 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4430 CONTINUE
      ARG=X
      ARG2=(ARG+1.0)/(ARG-1.0)
      RESULT=0.5*ALOG(ARG2)
      TERM=RESULT
      GOTO9000
C
 4500 CONTINUE
      IF(0.0.LT.X.AND.X.LE.1.0)GOTO4530
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4511)
 4511 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4512)
 4512 FORMAT('      ATTEMPT TO TAKE ARCSECH OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4513)
 4513 FORMAT('      <= 0 OR > +1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4514)
 4514 FORMAT('      THIS IS ILLEGAL BECAUSE THE ARCSECH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4515)
 4515 FORMAT('      IS NOT DEFINED IN SUCH DOMAIN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4517)X
 4517 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4530 CONTINUE
      ARG=1.0/X
      IF(ARG.EQ.1.0)RESULT=0.0
      IF(ARG.EQ.1.0)GOTO4590
      ARG2=ARG+SQRT(ARG*ARG-1.0)
      RESULT=ALOG(ARG2)
 4590 CONTINUE
      TERM=RESULT
      GOTO9000
C
 4600 CONTINUE
      IF(X.NE.0.0)GOTO4630
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4611)
 4611 FORMAT('***** ERROR IN DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4612)
 4612 FORMAT('      ATTEMPT TO TAKE ARCCSCH OF A NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4613)
 4613 FORMAT('      IDENTICALLY 0.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4614)
 4614 FORMAT('      THIS IS ILLEGAL BECAUSE THE ARCCSCH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4615)
 4615 FORMAT('      IS NOT DEFINED FOR 0.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4617)X
 4617 FORMAT('      THE NUMBER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4630 CONTINUE
      ARG=1.0/X
      ARG2=ARG+SQRT(ARG*ARG+1.0)
      RESULT=ALOG(ARG2)
      TERM=RESULT
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGEV.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IH,IH2,X
 9012 FORMAT('IH,IH2,X = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)SAVE1,SAVE2,I,IANGLU
 9013 FORMAT('SAVE1,SAVE2,I,IANGLU = ',E15.7,E15.7,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)RESULT,TERM,IBUGEV
 9014 FORMAT('RESULT,TERM,IBUGEV = ',2E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFOUND,IERROR
 9015 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
CCCCC SUBROUTINE DPLIB3(IH,IH2,X,SAVE1,SAVE2,I,IANGLU,
CCCCC SEPTEMBER 1994.  ADD SAVE3 ARGUMENT.
CCCCC MAY       1998.  ADD SAVE5 ARGUMENT.
      SUBROUTINE DPLIB3(IH,IH2,X,SAVE1,SAVE2,SAVE3,SAVE4,SAVE5,
     1SAVE6,SAVE7,SAVE8,
     1I,IANGLU,
     1TERM,IBUGEV,IFOUND,IERROR)
C
C     PURPOSE--PERFORM A LIBRARY FUNCTION EVALUATION.
C     NOTE--THIS IS PART 3
C           (EVALUATE VARIOUS PROBABILITY FUNCTIONS AND
C           VARIOUS SPECIAL MATHEMATICAL FUNCTIONS)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JANUARY  1979.
C     UPDATED         --NOVEMBER  1979.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1987.      WEICDF, WEIPDF, WEIPPF
C     UPDATED         --MAY       1989.      CP, CPK, PERDEF, EXPLOS
C     UPDATED         --MAY       1990.      INV. GAUS. PDF, CDF, PPF
C     UPDATED         --MAY       1990.      WALD PDF, CDF, PPF
C     UPDATED         --MAY       1990.      REV INV GAUS PDF, CDF, PPF
C     UPDATED         --MAY       1990.      FAT. LIFE PDF, CDF, PPF
C     UPDATED         --APRIL     1993.      ADD TYPE ARG. TO WEIBULL
C     UPDATED         --DECEMBER  1993.      GEPCDF, GEPPDF, GEPPPF
C                                            GENERALIZED PARETO
C     UPDATED         --JANUARY   1994.      MINMAX FOR WEI...
C     UPDATED         --JANUARY   1994.  WEIB MINMAX TO DPCOS2.INC
C     UPDATED         --APRIL     1994.  BINCDF, BIBPDF, BINPPF
C     UPDATED         --APRIL     1994.  POICDF, POIPDF, POIPPF
C     UPDATED         --APRIL     1994.  SEMCDF, SEMPDF, SEMPPF
C     UPDATED         --APRIL     1994.  NBCDF,  NBPDF,  NBPPF
C     UPDATED         --APRIL     1994.  CAUCDF, CAUPDF, CAUPPF, CAUSF
C     UPDATED         --APRIL     1994.  DEXCDF, DEXPDF, DEXPPF, DEXSF
C     UPDATED         --APRIL     1994.  EV1CDF, EV1PDF, EV1PPF
C     UPDATED         --APRIL     1994.  EV2CDF, EV2PDF, EV2PPF
C     UPDATED         --APRIL     1994.  EXPCDF, EXPPDF, EXPPPF, EXPSF
C     UPDATED         --APRIL     1994.  GAMCDF, GAMPPF
C     UPDATED         --APRIL     1994.  GEOCDF, GEOPDF, GEOPPF
C     UPDATED         --APRIL     1994.  HFNCDF, HFNPDF, HFNPPF
C     UPDATED         --APRIL     1994.  LAMCDF, LAMPDF, LAMPPF, LAMPPF
C     UPDATED         --APRIL     1994.  LGNCDF, LGNPDF, LGNPPF
C     UPDATED         --APRIL     1994.  LOGCDF, LOGPDF, LOGPPF, LOGPPF
C     UPDATED         --APRIL     1994.  UNICDF, UNIPDF, UNIPPF, UNISF
C     UPDATED         --SEPTEMBER 1994.  BETCDF, BETPDF, BETPPF
C     UPDATED         --SEPTEMBER 1994.  DISCDF, DISPDF, DISPPF
C     UPDATED         --SEPTEMBER 1994.  TRICDF, TRIPDF, TRIPPF
C     UPDATED         --SEPTEMBER 1994.  NCBCDF, NCBPPF
C     UPDATED         --SEPTEMBER 1994.  NCCCDF, NCCPPF, NCCNCP
C     UPDATED         --SEPTEMBER 1994.  NCFCDF, NCFPPF
C     UPDATED         --SEPTEMBER 1994.  DNFCDF, DNFPPF
C     UPDATED         --SEPTEMBER 1994.  NCTCDF, NCTPPF
C     UPDATED         --SEPTEMBER 1994.  DNTCDF, DNTPPF
C     UPDATED         --SEPTEMBER 1994.  GAMPDF
C     UPDATED         --SEPTEMBER 1994.  SAVE3 FOR NON-CENTRAL DISTR.
C     UPDATED         --SEPTEMBER 1994.  ADDITIONAL BESSEL FUNCTIONS
C     UPDATED         --SEPTEMBER 1994.  ELLIPTCAL INTEGRALS (BOTH 
C                                        CARLSON AND LEGENDRE)
C     UPDATED         --SEPTEMBER 1994.  3 EXPONENTIAL INTEGRALS
C     UPDATED         --SEPTEMBER 1994.  LOGARITHMIC INTEGRAL
C     UPDATED         --SEPTEMBER 1994.  SINE, COSINE, HYPERBOLIC SINE,
C                                        HYPERBOLIC COSINE INTEGRALS
C     UPDATED         --SEPTEMBER 1994.  DAWSON INTEGRALS
C     UPDATED         --SEPTEMBER 1994.  SPENCE DILOGARITHM
C     UPDATED         --SEPTEMBER 1994.  HYPCDF, HYPPDF, HYPPPF
C     UPDATED         --OCTOBER   1994.  VONCDF, VONPDF, VONPPF
C     UPDATED         --OCTOBER   1994.  USE DOUBLE PRECISION FOR I0,
C                                        I1, IN BESSEL FUNCTIONS.
C     UPDATED         --OCTOBER   1994.  CBESSJR, CBESSJI
C     UPDATED         --OCTOBER   1994.  CBESSYR, CBESSYI
C     UPDATED         --OCTOBER   1994.  CBESSIR, CBESSII
C     UPDATED         --OCTOBER   1994.  CBESSKR, CBESSKI
C     UPDATED         --OCTOBER   1994.  BVNCDF
C     UPDATED         --OCTOBER   1994.  CABS, CCOS, CEXP, CLOG,
C                                        CSIN, CSQRT
C     UPDATED         --NOVEMBER  1994.  FRESNC, FRESNS, FRESNF,
C                                        FRESNG, PEQ, PEQ1, PLEM, PLEM1
C                                        PEQI, PEQ1I, PLEMI, PLEM1I
C     UPDATED         --NOVEMBER  1994.  CN, DN, SN
C     UPDATED         --APRIL     1995.  EXPONENTIAL INTEGRAL FIX
C     UPDATED         --APRIL     1995.  SINE INTEGRAL AND
C                                        HYPERBOLIC SINE INTEGRAL
C                                        FOR X < 0
C     UPDATED         --APRIL     1995.  COSCDF, COSPDF, COSPPF
C     UPDATED         --APRIL     1995.  ALPCDF, ALPPDF, ALPPPF
C     UPDATED         --APRIL     1995.  PNRCDF, PNRPDF, PNRPPF
C     UPDATED         --APRIL     1995.  PLNCDF, PLNPDF, PLNPPF
C     UPDATED         --APRIL     1995.  FNRCDF, FNRPDF, FNRPPF
C     UPDATED         --APRIL     1995.  TNRCDF, TNRPDF, TNRPPF
C     UPDATED         --APRIL     1995.  POWCDF, POWPDF, POWPPF
C     UPDATED         --APRIL     1995.  CHCDF,  CHPDF,  CHPPF
C     UPDATED         --APRIL     1995.  DLGCDF, DLGPDF, DLGPPF
C     UPDATED         --APRIL     1995.  WARCDF, WARPDF, WARPPF
C     UPDATED         --APRIL     1995.  LLGCDF, LLGPDF, LLGPPF
C     UPDATED         --APRIL     1995.  GGDCDF, GGDPDF, GGDPPF
C     UPDATED         --MAY       1995.  NCTPDF
C     UPDATED         --JUNE      1995.  ADD ARGUMENT TO WARCDF
C     UPDATED         --JULY      1995.  ADD HERMITE, LEGENDRE,  
C                                        LAGUERRE, CHEBYCHEV T AND U,
C                                        NORMALIZED LAGUERRE, JACOBI,
C                                        ULTRASPHERICAL, ASSOCIATED
C                                        LEGENDRE
C                                        POLYNOMIALS
C     UPDATED         --SEPTEMBER 1995.  ANGCDF, ANGPDF, ANGPPF
C     UPDATED         --SEPTEMBER 1995.  ARSCDF, ARSPDF, ARSPPF
C     UPDATED         --SEPTEMBER 1995.  ACTIVATE BVNPDF
C     UPDATED         --SEPTEMBER 1995.  ACTIVATE TNRCDF, TNRPPF
C     UPDATED         --SEPTEMBER 1995.  ACTIVATE FNRCDF, FNRPPF
C     UPDATED         --OCTOBER   1995.  DWECDF, DWEPDF, DWEPPF
C     UPDATED         --OCTOBER   1995.  LGACDF, LGAPDF, LGAPPF
C     UPDATED         --OCTOBER   1995.  HSECDF, HSEPDF, HSEPPF
C     UPDATED         --OCTOBER   1995.  HFCCDF, HFCPDF, HFCPPF
C     UPDATED         --OCTOBER   1995.  HFLCDF, HFLPDF, HFLPPF
C     UPDATED         --OCTOBER   1995.  GEVCDF, GEVPDF, GEVPPF
C     UPDATED         --OCTOBER   1995.  GOMCDF, GOMPDF, GOMPPF
C     UPDATED         --OCTOBER   1995.  PA2CDF, PA2PDF, PA2PPF
C     UPDATED         --OCTOBER   1995.  WCACDF, WCAPDF, WCAPPF
C     UPDATED         --OCTOBER   1995.  EWECDF, EWEPDF, EWEPPF
C     UPDATED         --OCTOBER   1995.  TNECDF, TNEPDF, TNEPPF
C     UPDATED         --DECEMBER  1995.  GLOCDF, GLOPDF, GLOPPF
C     UPDATED         --DECEMBER  1995.  PEXCDF, PEXPDF, PEXPPF
C     UPDATED         --JANUARY   1996.  DGACDF, DGAPDF, DGAPPF
C     UPDATED         --JANUARY   1996.  KAPCDF, KAPPDF, KAPPPF
C     UPDATED         --JANUARY   1996.  FCACDF, FCAPDF, FCAPPF
C     UPDATED         --JANUARY   1996.  NCCPDF
C     UPDATED         --FEBRUARY  1996.  BBNCDF, BBNPDF, BBNPPF
C     UPDATED         --FEBRUARY  1996.  BRACDF, BRAPDF, BRAPPF
C     UPDATED         --FEBRUARY  1996.  GEXCDF, GEXPDF, GEXPPF
C     UPDATED         --MAY       1996.  RECCDF, RECPDF, RECPPF
C     UPDATED         --SEPTEMBER 1997.  BN, EN, BINOM
C     UPDATED         --APRIL     1998.  LOCATION AND SCALE PARAMETERS
C                                        FOR MANY DISTRIBUTIONS
C     UPDATED         --APRIL     1998.  HAZARD AND CUMULATIVE HAZARD
C                                        FOR MANY DISTRIBUTIONS
C
C     UPDATED         --MAY       1998.  NORMXCDF, NORMXPDF, NORMXPPF
C     UPDATED         --MARCH     1999.  SRACDF, SRAPPF
C     UPDATED         --MARCH     1999.  ABRAM, CLAUSN, DEBYE
C                                        EXP3, GOODST, LOBACH,
C                                        STROM, SYNCH1, SYNCH2, TRAN
C     UPDATED         --AUGUST    2001.  GLDCDF, GLDPDF, GLDPPF,
C                                        GLDCHK, GLDLLM, GLDULM
C     UPDATED         --SEPTEMBER 2001.  LDECDF, LDEPDF, LDEPPF
C     UPDATED         --SEPTEMBER 2001.  IWECDF, IWEPDF, IWEPPF
C     UPDATED         --SEPTEMBER 2001.  JSBCDF, JSBPDF, JSBPPF
C     UPDATED         --SEPTEMBER 2001.  JSUCDF, JSUPDF, JSUPPF
C     UPDATED         --NOVEMBER  2001.  GEECDF, GEEPDF, GEEPPF,
C                                        GEEHAZ, GEECHAZ
C     UPDATED         --MAY       2002.  TSPCDF, TSPPDF, TSPPPF,
C     UPDATED         --MAY       2002.  BWECDF, BWEPDF, BWEPPF,
C                                        BWEHAZ, BWECHAZ
C     UPDATED         --JANUARY   2003.  GHPDF
C     UPDATED         --APRIL     2003.  LANCDF, LANPDF, LANPPF
C     UPDATED         --APRIL     2003.  LANXM1, LANXM2, LANDIF
C     UPDATED         --MAY       2003.  IBPDF,  SLAPDF
C     UPDATED         --MAY       2003.  ERRCDF, ERRPDF, ERRPPF
C     UPDATED         --JUNE      2003.  TRACDF, TRAPDF, TRAPPF
C     UPDATED         --NOVEMBER  2003.  FTCDF,  FTPDF,  FTPPF
C     UPDATED         --NOVEMBER  2003.  SNCDF,  SNPDF,  SNPPF
C     UPDATED         --NOVEMBER  2003.  TNCDF,  TNPDF,  TNPPF
C     UPDATED         --NOVEMBER  2003.  ZIPCDF, ZIPPDF, ZIPPPF
C     UPDATED         --DECEMBER  2003.  SLACDF, SLAPPF
C     UPDATED         --DECEMBER  2003.  IBCDF,  IBPPF
C     UPDATED         --DECEMBER  2003.  MAKCDF, MAKPDF, MAKPPF
C     UPDATED         --MARCH     2004.  LSNCDF, LSNPDF, LSNPPF
C     UPDATED         --MARCH     2004.  LSTCDF, LSTPDF, LSTPPF
C     UPDATED         --MARCH     2004.  POLCDF, POLPDF, POLPPF
C     UPDATED         --APRIL     2004.  HERCDF, HERPDF, HERPPF
C     UPDATED         --APRIL     2004.  BU1CDF, BU1PDF, BU1PPF
C     UPDATED         --APRIL     2004.          ...
C     UPDATED         --APRIL     2004.  B12CDF, B12PDF, B12PPF
C     UPDATED         --APRIL     2004.  YULCDF, YULPDF, YULPPF
C     UPDATED         --APRIL     2004.  GWACDF, GWAPDF, GWAPPF
C     UPDATED         --MAY       2004.  DNTPDF, DNFPDF, NCFPDF
C     UPDATED         --JUNE      2004.  SDECDF, SDEPDF, SDEPPF
C     UPDATED         --JUNE      2004.  ADECDF, ADEPDF, ADEPPF
C     UPDATED         --JUNE      2004.  MAXCDF, MAXPDF, MAXPPF
C     UPDATED         --JUNE      2004.  FERCDF, FERPDF, FERPPF
C     UPDATED         --JUNE      2004.  RAYCDF, RAYPDF, RAYPPF
C     UPDATED         --JULY      2004.  GALCDF, GALPDF, GALPPF
C     UPDATED         --AUGUST    2004.  GIGCDF, GALPDF, GALPPF
C     UPDATED         --AUGUST    2004.  BEICDF, BEIPDF, BEIPPF
C     UPDATED         --AUGUST    2004.  BEKCDF, BEKPDF, BEKPPF
C     UPDATED         --AUGUST    2004.  MCLCDF, MCLPDF, MCLPPF
C     UPDATED         --SEPTEMBER 2004.  GMCCDF, GMCPDF, GMCPPF
C     UPDATED         --SEPTEMBER 2004.  HBOCDF, HBOPDF, HBOPPF
C     UPDATED         --DECEMBER  2004.  RESOLVE AMBIGUITY IN CALLS
C                                        TO PARETO (PAR) AND PARETO
C                                        SECOND KIND (PA2) SUBROUTINES
C     UPDATED         --MARCH     2005.  EXPAFR, LGNAFR, WEIAFR
C     UPDATED         --JULY      2005.  CALL LIST TO LGAxxx AND SNxxx
C     UPDATED         --AUGUST    2005.  ADJUSTMENT TO
C                                        TRICDF, TRIPDF, TRIPPF
C                                        TO HAVE GENERAL CASE HANDLED
C                                        WITHIN THE ROUTINE SINCE SHAPE
C                                        PARAMETER BOUNDED BY LOWER AND
C                                        UPPER LIMIT PARAMETERS.
C     UPDATED         --NOVEMBER  2005.  AIRINT
C     UPDATED         --NOVEMBER  2005.  AIRYGI
C     UPDATED         --NOVEMBER  2005.  AIRYHI
C     UPDATED         --NOVEMBER  2005.  ATNINT
C     UPDATED         --NOVEMBER  2005.  BIRINT
C     UPDATED         --NOVEMBER  2005.  I0INT
C     UPDATED         --NOVEMBER  2005.  I0ML0
C     UPDATED         --NOVEMBER  2005.  I1ML1
C     UPDATED         --NOVEMBER  2005.  J0INT
C     UPDATED         --NOVEMBER  2005.  K0INT
C     UPDATED         --NOVEMBER  2005.  Y0INT
C     UPDATED         --FEBRUARY  2006.  GL5CDF, GL5PDF, GL5PPF
C     UPDATED         --FEBRUARY  2006.  WAKCDF, WAKPDF, WAKPPF
C     UPDATED         --MARCH     2006.  BNOCDF, BNOPDF, BNOPPF
C     UPDATED         --MARCH     2006.  GL2CDF, GL2PDF, GL2PPF
C     UPDATED         --MARCH     2006.  GL3CDF, GL3PDF, GL3PPF
C     UPDATED         --MARCH     2006.  GL4CDF, GL4PDF, GL4PPF
C     UPDATED         --MARCH     2006.  ALDCDF, ALDPDF, ALDPPF
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGEV
      CHARACTER*4 IWRITE
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IFLAG2
C
C---------------------------------------------------------------------
C
CCCCC THE FOLLOWING LINE WAS ADDED                 JANUARY 1994
CCCCC SO AS TO ALLOW THE EXTRACTION OF   MINMAX    JANUARY 1994
CCCCC FOR WEIBULL, (EV1, AND EV2) DISTRIBUTIONS    JANUARY 1994
      INCLUDE 'DPCOS2.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOST.INC'
C
CCCCC SEPTEMBER 1994.  FOLLOWING ROUTINE NEEDED BY SOME NEW
CCCCC BESSEL FUNCTION ROUTINES.
C
      DIMENSION TEMP1(1000)
      DOUBLE PRECISION DTEMP1(1000)
      COMPLEX CTEMP1(102)
      COMPLEX Z1
      COMPLEX Z2
      COMPLEX PEQ
      COMPLEX PEQ1
      COMPLEX PLEM
      COMPLEX PLEM1
      DOUBLE PRECISION DARG1
      DOUBLE PRECISION DARG2
      DOUBLE PRECISION DARG3
      DOUBLE PRECISION DARG4
      DOUBLE PRECISION DARG5
      DOUBLE PRECISION DARG6
      DOUBLE PRECISION DARG7
      DOUBLE PRECISION DARG8
      DOUBLE PRECISION DARG9
      DOUBLE PRECISION DSPENC
      DOUBLE PRECISION DBESI0
      DOUBLE PRECISION DBESI1
      DOUBLE PRECISION DBSI0E
      DOUBLE PRECISION DBSI1E
      DOUBLE PRECISION DRESLT
CCCCC JULY 1995.  ADD FOLLOWING LINES
      DOUBLE PRECISION DRSLT2
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
      DOUBLE PRECISION DTERM4
      DOUBLE PRECISION DTERM5
      DOUBLE PRECISION DGAMMA
      DOUBLE PRECISION DGAMR
      DOUBLE PRECISION DPI
      DOUBLE PRECISION DPN(10)
      DOUBLE PRECISION DABRAM(0:100)
      INTEGER IPN(10)
C
      DOUBLE PRECISION DFRENC
C
      DOUBLE PRECISION ABRAM0
      DOUBLE PRECISION ABRAM1
      DOUBLE PRECISION ABRAM2
      DOUBLE PRECISION CLAUSN
      DOUBLE PRECISION DEBYE1
      DOUBLE PRECISION DEBYE2
      DOUBLE PRECISION DEBYE3
      DOUBLE PRECISION DEBYE4
      DOUBLE PRECISION EXP3
      DOUBLE PRECISION GOODST
      DOUBLE PRECISION LANCDF
      DOUBLE PRECISION LANPDF
      DOUBLE PRECISION LANPPF
      DOUBLE PRECISION LANXM1
      DOUBLE PRECISION LANXM2
      DOUBLE PRECISION LANDIF
      DOUBLE PRECISION LOBACH
      DOUBLE PRECISION STROM
      DOUBLE PRECISION SYNCH1
      DOUBLE PRECISION SYNCH2
      DOUBLE PRECISION TRAN02
      DOUBLE PRECISION TRAN03
      DOUBLE PRECISION TRAN04
      DOUBLE PRECISION TRAN05
      DOUBLE PRECISION TRAN06
      DOUBLE PRECISION TRAN07
      DOUBLE PRECISION TRAN08
      DOUBLE PRECISION TRAN09
      DOUBLE PRECISION AIRINT
      DOUBLE PRECISION AIRYGI
      DOUBLE PRECISION AIRYHI
      DOUBLE PRECISION ATNINT
      DOUBLE PRECISION BIRINT
      DOUBLE PRECISION I0INT
      DOUBLE PRECISION I0ML0
      DOUBLE PRECISION I1ML1
      DOUBLE PRECISION J0INT
      DOUBLE PRECISION K0INT
      DOUBLE PRECISION Y0INT
      DOUBLE PRECISION CDFGLO
      DOUBLE PRECISION QUAGLO
      DOUBLE PRECISION CDFWAK
      DOUBLE PRECISION QUAWAK
      DOUBLE PRECISION XPAR(5)
C
      LOGICAL HYPPNT
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-----DATA STATEMENTS-----------------------------------------------------
C
      DATA C00/1.0/
      DATA C11/1.0/
      DATA C22,C20/2.0,-1.0/
      DATA C33,C31/4.0,-3.0/
      DATA C44,C42,C40/8.0,-8.0,1.0/
      DATA C55,C53,C51/16.0,-20.0,5.0/
      DATA C66,C64,C62,C60/32.0,-48.0,18.0,-1.0/
      DATA C77,C75,C73,C71/64.0,-112.0,56.0,-7.0/
      DATA C88,C86,C84,C82,C80/128.0,-256.0,160.0,-32.0,1.0/
      DATA C99,C97,C95,C93,C91/256.0,-576.0,432.0,-120.0,9.0/
      DATA C1010,C108,C106,C104,C102,C100/512.0,-1280.0,1120.0,-400.0,
     1                                    50.0,-1.0/
C
      DATA D00,D02,D04,D06,D08,D010,D012
     1     /1.0,-2.2499997,1.2656208,-0.3163866,0.0444479,
     1     -0.0039444,0.0002100/
      DATA F00,F01,F02,F03,F04,F05,F06
     1     /0.79788456,-0.00000077,-0.00552740,-0.00009512,
     1     0.00137237,-0.00072805,0.00014476/
      DATA G00,G01,G02,G03,G04,G05,G06
     1     /-0.78539816,-0.04166397,-0.00003954,0.00262573,
     1     -0.00054125,-0.00029333,0.00013558/
      DATA D10,D12,D14,D16,D18,D110,D112
     1     /0.5,-0.56249985,0.21093573,-0.03954289,
     1     0.00443319,-0.00031761,0.00001109/
      DATA F10,F11,F12,F13,F14,F15,F16
     1     /0.79788456,0.00000156,0.01659667,0.00017105,
     1     -0.00249511,0.00113653,-0.00020033/
      DATA G10,G11,G12,G13,G14,G15,G16
     1     /-2.35619449,0.12499612,0.00005650,-0.00637879,
     1     0.00074348,0.00079824,-0.00029166/
      DATA REALPI /3.141593/
      DATA DPI / 3.1415926535 8979323846 2643383279 503 D0 /
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPLI'
      ISUBN2='B2  '
C
      IF(IBUGEV.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPLIB3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IH,IH2,X
   52 FORMAT('IH,IH2,X = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)SAVE1,SAVE2,I,IANGLU
   53 FORMAT('SAVE1,SAVE2,I,IANGLU = ',E15.7,E15.7,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)TERM,IBUGEV,IFOUND,IERROR,NUMBPW
   54 FORMAT('TERM,IBUGEV,IFOUND,IERROR,NUMBPW = ',
     1E15.7,2X,A4,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IFOUND,IERROR
   55 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
C
      IF(IH.EQ.'NORC'.AND.IH2.EQ.'DF  ')GOTO551
      IF(IH.EQ.'NORP'.AND.IH2.EQ.'DF  ')GOTO552
      IF(IH.EQ.'NORP'.AND.IH2.EQ.'PF  ')GOTO553
      IF(IH.EQ.'NORS'.AND.IH2.EQ.'F   ')GOTO554
      IF(IH.EQ.'NORH'.AND.IH2.EQ.'AZ  ')GOTO555
      IF(IH.EQ.'NORC'.AND.IH2.EQ.'HAZ ')GOTO556
      IF(IH.EQ.'NORM'.AND.IH2.EQ.'XCDF')GOTO8557
      IF(IH.EQ.'NORM'.AND.IH2.EQ.'XPDF')GOTO8558
      IF(IH.EQ.'NORM'.AND.IH2.EQ.'XPPF')GOTO8559
C
      IF(IH.EQ.'TCDF'.AND.IH2.EQ.'    ')GOTO561
      IF(IH.EQ.'TPDF'.AND.IH2.EQ.'    ')GOTO562
      IF(IH.EQ.'TPPF'.AND.IH2.EQ.'    ')GOTO563
C
      IF(IH.EQ.'CHSC'.AND.IH2.EQ.'DF  ')GOTO571
      IF(IH.EQ.'CHSP'.AND.IH2.EQ.'DF  ')GOTO572
      IF(IH.EQ.'CHSP'.AND.IH2.EQ.'PF  ')GOTO573
C
      IF(IH.EQ.'FCDF'.AND.IH2.EQ.'    ')GOTO581
      IF(IH.EQ.'FPDF'.AND.IH2.EQ.'    ')GOTO582
      IF(IH.EQ.'FPPF'.AND.IH2.EQ.'    ')GOTO583
C
      IF(IH.EQ.'WEIC'.AND.IH2.EQ.'DF  ')GOTO591
      IF(IH.EQ.'WEIP'.AND.IH2.EQ.'DF  ')GOTO592
      IF(IH.EQ.'WEIP'.AND.IH2.EQ.'PF  ')GOTO593
      IF(IH.EQ.'WEIH'.AND.IH2.EQ.'AZ  ')GOTO594
      IF(IH.EQ.'WEIC'.AND.IH2.EQ.'HAZ ')GOTO595
      IF(IH.EQ.'WEIA'.AND.IH2.EQ.'FR  ')GOTO596
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED MAY 1990
      IF(IH.EQ.'IGCD'.AND.IH2.EQ.'F   ')GOTO601
      IF(IH.EQ.'IGPD'.AND.IH2.EQ.'F   ')GOTO602
      IF(IH.EQ.'IGPP'.AND.IH2.EQ.'F   ')GOTO603
      IF(IH.EQ.'IGHA'.AND.IH2.EQ.'Z   ')GOTO604
      IF(IH.EQ.'IGCH'.AND.IH2.EQ.'AZ  ')GOTO605
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED MAY 1990
      IF(IH.EQ.'WALC'.AND.IH2.EQ.'DF  ')GOTO611
      IF(IH.EQ.'WALP'.AND.IH2.EQ.'DF  ')GOTO612
      IF(IH.EQ.'WALP'.AND.IH2.EQ.'PF  ')GOTO613
      IF(IH.EQ.'WALH'.AND.IH2.EQ.'AZ  ')GOTO614
      IF(IH.EQ.'WALC'.AND.IH2.EQ.'HAZ ')GOTO615
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED MAY 1990
      IF(IH.EQ.'RIGC'.AND.IH2.EQ.'DF  ')GOTO621
      IF(IH.EQ.'RIGP'.AND.IH2.EQ.'DF  ')GOTO622
      IF(IH.EQ.'RIGP'.AND.IH2.EQ.'PF  ')GOTO623
      IF(IH.EQ.'RIGH'.AND.IH2.EQ.'AZ  ')GOTO624
      IF(IH.EQ.'RIGC'.AND.IH2.EQ.'HAZ ')GOTO625
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED MAY 1990
      IF(IH.EQ.'FLCD'.AND.IH2.EQ.'F   ')GOTO631
      IF(IH.EQ.'FLPD'.AND.IH2.EQ.'F   ')GOTO632
      IF(IH.EQ.'FLPP'.AND.IH2.EQ.'F   ')GOTO633
      IF(IH.EQ.'FLHA'.AND.IH2.EQ.'Z   ')GOTO634
      IF(IH.EQ.'FLCH'.AND.IH2.EQ.'AZ  ')GOTO635
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    DECEMBER 1993
      IF(IH.EQ.'GEPC'.AND.IH2.EQ.'DF  ')GOTO641
      IF(IH.EQ.'GEPP'.AND.IH2.EQ.'DF  ')GOTO642
      IF(IH.EQ.'GEPP'.AND.IH2.EQ.'PF  ')GOTO643
      IF(IH.EQ.'GEPH'.AND.IH2.EQ.'AZ  ')GOTO644
      IF(IH.EQ.'GEPC'.AND.IH2.EQ.'HAZ ')GOTO645
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'BINC'.AND.IH2.EQ.'DF  ')GOTO651
      IF(IH.EQ.'BINP'.AND.IH2.EQ.'DF  ')GOTO652
      IF(IH.EQ.'BINP'.AND.IH2.EQ.'PF  ')GOTO653
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'POIC'.AND.IH2.EQ.'DF  ')GOTO661
      IF(IH.EQ.'POIP'.AND.IH2.EQ.'DF  ')GOTO662
      IF(IH.EQ.'POIP'.AND.IH2.EQ.'PF  ')GOTO663
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'SEMC'.AND.IH2.EQ.'DF  ')GOTO671
      IF(IH.EQ.'SEMP'.AND.IH2.EQ.'DF  ')GOTO672
      IF(IH.EQ.'SEMP'.AND.IH2.EQ.'PF  ')GOTO673
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'NBCD'.AND.IH2.EQ.'F   ')GOTO681
      IF(IH.EQ.'NBPD'.AND.IH2.EQ.'F   ')GOTO682
      IF(IH.EQ.'NBPP'.AND.IH2.EQ.'F   ')GOTO683
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'CAUC'.AND.IH2.EQ.'DF  ')GOTO691
      IF(IH.EQ.'CAUP'.AND.IH2.EQ.'DF  ')GOTO692
      IF(IH.EQ.'CAUP'.AND.IH2.EQ.'PF  ')GOTO693
      IF(IH.EQ.'CAUS'.AND.IH2.EQ.'F   ')GOTO694
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'DEXC'.AND.IH2.EQ.'DF  ')GOTO701
      IF(IH.EQ.'DEXP'.AND.IH2.EQ.'DF  ')GOTO702
      IF(IH.EQ.'DEXP'.AND.IH2.EQ.'PF  ')GOTO703
      IF(IH.EQ.'DEXS'.AND.IH2.EQ.'F   ')GOTO704
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'EV1C'.AND.IH2.EQ.'DF  ')GOTO711
      IF(IH.EQ.'EV1P'.AND.IH2.EQ.'DF  ')GOTO712
      IF(IH.EQ.'EV1P'.AND.IH2.EQ.'PF  ')GOTO713
      IF(IH.EQ.'EV1H'.AND.IH2.EQ.'AZ  ')GOTO714
      IF(IH.EQ.'EV1C'.AND.IH2.EQ.'HAZ ')GOTO715
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'EV2C'.AND.IH2.EQ.'DF  ')GOTO721
      IF(IH.EQ.'EV2P'.AND.IH2.EQ.'DF  ')GOTO722
      IF(IH.EQ.'EV2P'.AND.IH2.EQ.'PF  ')GOTO723
      IF(IH.EQ.'EV2H'.AND.IH2.EQ.'AZ  ')GOTO724
      IF(IH.EQ.'EV2C'.AND.IH2.EQ.'HAZ ')GOTO725
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'EXPC'.AND.IH2.EQ.'DF  ')GOTO731
      IF(IH.EQ.'EXPP'.AND.IH2.EQ.'DF  ')GOTO732
      IF(IH.EQ.'EXPP'.AND.IH2.EQ.'PF  ')GOTO733
      IF(IH.EQ.'EXPS'.AND.IH2.EQ.'F   ')GOTO734
      IF(IH.EQ.'EXPH'.AND.IH2.EQ.'AZ  ')GOTO735
      IF(IH.EQ.'EXPC'.AND.IH2.EQ.'HAZ ')GOTO736
      IF(IH.EQ.'EXPA'.AND.IH2.EQ.'FR  ')GOTO737
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'GAMC'.AND.IH2.EQ.'DF  ')GOTO741
      IF(IH.EQ.'GAMP'.AND.IH2.EQ.'DF  ')GOTO742
      IF(IH.EQ.'GAMP'.AND.IH2.EQ.'PF  ')GOTO743
      IF(IH.EQ.'GAMH'.AND.IH2.EQ.'AZ  ')GOTO744
      IF(IH.EQ.'GAMC'.AND.IH2.EQ.'HAZ ')GOTO745
C
CCCCC MARCH 2004.  MAKE DISTINCTION BETWEEN TWO COMMON DEFINITIONS
CCCCC OF GEOMETRIC DISTRIBUTION.  THE JOHNSON, KOTZ, AND KEMP
CCCCC DEFINITION (THE DEFAULT) IS THE NUMBER OF TRIALS UP TO AND
CCCCC INCLUDING THE FIRST SUCCESS (OR FAILURE). THE DEFINITION
CCCCC USED IN THE DIGITAL LIBRARY OF MATHEMATICAL FUNCTIONS
CCCCC IS THE NUMBER OF TRIALS UNTIL, BUT NOT INCLUDING, THE
CCCCC FIRST SUCCESS.
C
      IF(IGEODF.EQ.'DLMF')THEN
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MARCH 2004
        IF(IH.EQ.'GEOC'.AND.IH2.EQ.'DF  ')GOTO756
        IF(IH.EQ.'GEOP'.AND.IH2.EQ.'DF  ')GOTO757
        IF(IH.EQ.'GEOP'.AND.IH2.EQ.'PF  ')GOTO758
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      ELSE
        IF(IH.EQ.'GEOC'.AND.IH2.EQ.'DF  ')GOTO751
        IF(IH.EQ.'GEOP'.AND.IH2.EQ.'DF  ')GOTO752
        IF(IH.EQ.'GEOP'.AND.IH2.EQ.'PF  ')GOTO753
      ENDIF
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'HFNC'.AND.IH2.EQ.'DF  ')GOTO761
      IF(IH.EQ.'HFNP'.AND.IH2.EQ.'DF  ')GOTO762
      IF(IH.EQ.'HFNP'.AND.IH2.EQ.'PF  ')GOTO763
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'LAMC'.AND.IH2.EQ.'DF  ')GOTO771
      IF(IH.EQ.'LAMP'.AND.IH2.EQ.'DF  ')GOTO772
      IF(IH.EQ.'LAMP'.AND.IH2.EQ.'PF  ')GOTO773
      IF(IH.EQ.'LAMS'.AND.IH2.EQ.'F   ')GOTO774
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'LGNC'.AND.IH2.EQ.'DF  ')GOTO781
      IF(IH.EQ.'LGNP'.AND.IH2.EQ.'DF  ')GOTO782
      IF(IH.EQ.'LGNP'.AND.IH2.EQ.'PF  ')GOTO783
      IF(IH.EQ.'LGNH'.AND.IH2.EQ.'AZ  ')GOTO784
      IF(IH.EQ.'LGNC'.AND.IH2.EQ.'HAZ ')GOTO785
      IF(IH.EQ.'LGNA'.AND.IH2.EQ.'FR  ')GOTO786
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'LOGC'.AND.IH2.EQ.'DF  ')GOTO791
      IF(IH.EQ.'LOGP'.AND.IH2.EQ.'DF  ')GOTO792
      IF(IH.EQ.'LOGP'.AND.IH2.EQ.'PF  ')GOTO793
      IF(IH.EQ.'LOGS'.AND.IH2.EQ.'F   ')GOTO794
      IF(IH.EQ.'LOGH'.AND.IH2.EQ.'AZ  ')GOTO795
      IF(IH.EQ.'LOGC'.AND.IH2.EQ.'HAZ ')GOTO796
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'PARC'.AND.IH2.EQ.'DF  ')GOTO801
      IF(IH.EQ.'PARP'.AND.IH2.EQ.'DF  ')GOTO802
      IF(IH.EQ.'PARP'.AND.IH2.EQ.'PF  ')GOTO803
      IF(IH.EQ.'PARH'.AND.IH2.EQ.'AZ  ')GOTO804
      IF(IH.EQ.'PARC'.AND.IH2.EQ.'HAZ ')GOTO805
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL 1994
      IF(IH.EQ.'UNIC'.AND.IH2.EQ.'DF  ')GOTO811
      IF(IH.EQ.'UNIP'.AND.IH2.EQ.'DF  ')GOTO812
      IF(IH.EQ.'UNIP'.AND.IH2.EQ.'PF  ')GOTO813
      IF(IH.EQ.'UNIS'.AND.IH2.EQ.'F   ')GOTO814
      IF(IH.EQ.'UNIH'.AND.IH2.EQ.'AZ  ')GOTO815
      IF(IH.EQ.'UNIC'.AND.IH2.EQ.'HAZ ')GOTO816
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'BETC'.AND.IH2.EQ.'DF  ')GOTO821
      IF(IH.EQ.'BETP'.AND.IH2.EQ.'DF  ')GOTO822
      IF(IH.EQ.'BETP'.AND.IH2.EQ.'PF  ')GOTO823
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'NCBC'.AND.IH2.EQ.'DF  ')GOTO831
      IF(IH.EQ.'NCBP'.AND.IH2.EQ.'DF  ')GOTO832
      IF(IH.EQ.'NCBP'.AND.IH2.EQ.'PF  ')GOTO833
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'NCCC'.AND.IH2.EQ.'DF  ')GOTO841
      IF(IH.EQ.'NCCP'.AND.IH2.EQ.'DF  ')GOTO842
      IF(IH.EQ.'NCCP'.AND.IH2.EQ.'PF  ')GOTO843
      IF(IH.EQ.'NCCN'.AND.IH2.EQ.'CP  ')GOTO844
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'NCFC'.AND.IH2.EQ.'DF  ')GOTO851
      IF(IH.EQ.'NCFP'.AND.IH2.EQ.'DF  ')GOTO852
      IF(IH.EQ.'NCFP'.AND.IH2.EQ.'PF  ')GOTO853
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'NCTC'.AND.IH2.EQ.'DF  ')GOTO861
      IF(IH.EQ.'NCTP'.AND.IH2.EQ.'DF  ')GOTO862
      IF(IH.EQ.'NCTP'.AND.IH2.EQ.'PF  ')GOTO863
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'DISC'.AND.IH2.EQ.'DF  ')GOTO871
      IF(IH.EQ.'DISP'.AND.IH2.EQ.'DF  ')GOTO872
      IF(IH.EQ.'DISP'.AND.IH2.EQ.'PF  ')GOTO873
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'TRIC'.AND.IH2.EQ.'DF  ')GOTO881
      IF(IH.EQ.'TRIP'.AND.IH2.EQ.'DF  ')GOTO882
      IF(IH.EQ.'TRIP'.AND.IH2.EQ.'PF  ')GOTO883
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'DNTC'.AND.IH2.EQ.'DF  ')GOTO891
      IF(IH.EQ.'DNTP'.AND.IH2.EQ.'DF  ')GOTO892
      IF(IH.EQ.'DNTP'.AND.IH2.EQ.'PF  ')GOTO893
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'DNFC'.AND.IH2.EQ.'DF  ')GOTO901
      IF(IH.EQ.'DNFP'.AND.IH2.EQ.'DF  ')GOTO902
      IF(IH.EQ.'DNFP'.AND.IH2.EQ.'PF  ')GOTO903
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    SEPTEMBER 1994
      IF(IH.EQ.'HYPC'.AND.IH2.EQ.'DF  ')GOTO911
      IF(IH.EQ.'HYPP'.AND.IH2.EQ.'DF  ')GOTO912
      IF(IH.EQ.'HYPP'.AND.IH2.EQ.'PF  ')GOTO913
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER   1994
      IF(IH.EQ.'VONC'.AND.IH2.EQ.'DF  ')GOTO921
      IF(IH.EQ.'VONP'.AND.IH2.EQ.'DF  ')GOTO922
      IF(IH.EQ.'VONP'.AND.IH2.EQ.'PF  ')GOTO923
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER   1994
      IF(IH.EQ.'BVNC'.AND.IH2.EQ.'DF  ')GOTO931
      IF(IH.EQ.'BVNP'.AND.IH2.EQ.'DF  ')GOTO932
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'COSC'.AND.IH2.EQ.'DF  ')GOTO941
      IF(IH.EQ.'COSP'.AND.IH2.EQ.'DF  ')GOTO942
      IF(IH.EQ.'COSP'.AND.IH2.EQ.'PF  ')GOTO943
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'ALPC'.AND.IH2.EQ.'DF  ')GOTO951
      IF(IH.EQ.'ALPP'.AND.IH2.EQ.'DF  ')GOTO952
      IF(IH.EQ.'ALPP'.AND.IH2.EQ.'PF  ')GOTO953
      IF(IH.EQ.'ALPH'.AND.IH2.EQ.'AZ  ')GOTO954
      IF(IH.EQ.'ALPC'.AND.IH2.EQ.'HAZ ')GOTO955
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'PNRC'.AND.IH2.EQ.'DF  ')GOTO961
      IF(IH.EQ.'PNRP'.AND.IH2.EQ.'DF  ')GOTO962
      IF(IH.EQ.'PNRP'.AND.IH2.EQ.'PF  ')GOTO963
      IF(IH.EQ.'PNRH'.AND.IH2.EQ.'AZ  ')GOTO964
      IF(IH.EQ.'PNRC'.AND.IH2.EQ.'HAZ ')GOTO965
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'PLNC'.AND.IH2.EQ.'DF  ')GOTO971
      IF(IH.EQ.'PLNP'.AND.IH2.EQ.'DF  ')GOTO972
      IF(IH.EQ.'PLNP'.AND.IH2.EQ.'PF  ')GOTO973
      IF(IH.EQ.'PLNH'.AND.IH2.EQ.'AZ  ')GOTO974
      IF(IH.EQ.'PLNC'.AND.IH2.EQ.'HAZ ')GOTO975
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'FNRC'.AND.IH2.EQ.'DF  ')GOTO981
      IF(IH.EQ.'FNRP'.AND.IH2.EQ.'DF  ')GOTO982
      IF(IH.EQ.'FNRP'.AND.IH2.EQ.'PF  ')GOTO983
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'POWC'.AND.IH2.EQ.'DF  ')GOTO991
      IF(IH.EQ.'POWP'.AND.IH2.EQ.'DF  ')GOTO992
      IF(IH.EQ.'POWP'.AND.IH2.EQ.'PF  ')GOTO993
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'TNRC'.AND.IH2.EQ.'DF  ')GOTO1011
      IF(IH.EQ.'TNRP'.AND.IH2.EQ.'DF  ')GOTO1012
      IF(IH.EQ.'TNRP'.AND.IH2.EQ.'PF  ')GOTO1013
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'CHCD'.AND.IH2.EQ.'F   ')GOTO1021
      IF(IH.EQ.'CHPD'.AND.IH2.EQ.'F   ')GOTO1022
      IF(IH.EQ.'CHPP'.AND.IH2.EQ.'F   ')GOTO1023
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'DLGC'.AND.IH2.EQ.'DF  ')GOTO1031
      IF(IH.EQ.'DLGP'.AND.IH2.EQ.'DF  ')GOTO1032
      IF(IH.EQ.'DLGP'.AND.IH2.EQ.'PF  ')GOTO1033
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'WARC'.AND.IH2.EQ.'DF  ')GOTO1041
      IF(IH.EQ.'WARP'.AND.IH2.EQ.'DF  ')GOTO1042
      IF(IH.EQ.'WARP'.AND.IH2.EQ.'PF  ')GOTO1043
      IF(IH.EQ.'YULC'.AND.IH2.EQ.'DF  ')GOTO1046
      IF(IH.EQ.'YULP'.AND.IH2.EQ.'DF  ')GOTO1047
      IF(IH.EQ.'YULP'.AND.IH2.EQ.'PF  ')GOTO1048
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'LLGC'.AND.IH2.EQ.'DF  ')GOTO1051
      IF(IH.EQ.'LLGP'.AND.IH2.EQ.'DF  ')GOTO1052
      IF(IH.EQ.'LLGP'.AND.IH2.EQ.'PF  ')GOTO1053
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1995
      IF(IH.EQ.'GGDC'.AND.IH2.EQ.'DF  ')GOTO1061
      IF(IH.EQ.'GGDP'.AND.IH2.EQ.'DF  ')GOTO1062
      IF(IH.EQ.'GGDP'.AND.IH2.EQ.'PF  ')GOTO1063
      IF(IH.EQ.'GGDH'.AND.IH2.EQ.'AZ  ')GOTO1064
      IF(IH.EQ.'GGDC'.AND.IH2.EQ.'HAZ ')GOTO1065
CCCCC THE FOLLOWING 3 LINES WERE ADDED    APRIL     1998
      IF(IH.EQ.'IGAC'.AND.IH2.EQ.'DF  ')GOTO1066
      IF(IH.EQ.'IGAP'.AND.IH2.EQ.'DF  ')GOTO1067
      IF(IH.EQ.'IGAP'.AND.IH2.EQ.'PF  ')GOTO1068
      IF(IH.EQ.'IGAH'.AND.IH2.EQ.'AZ  ')GOTO1069
      IF(IH.EQ.'IGAC'.AND.IH2.EQ.'HAZ ')GOTO9065
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    SEPTEMBER 1995
      IF(IH.EQ.'ANGC'.AND.IH2.EQ.'DF  ')GOTO1071
      IF(IH.EQ.'ANGP'.AND.IH2.EQ.'DF  ')GOTO1072
      IF(IH.EQ.'ANGP'.AND.IH2.EQ.'PF  ')GOTO1073
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    SEPTEMBER 1995
      IF(IH.EQ.'ARSC'.AND.IH2.EQ.'DF  ')GOTO1081
      IF(IH.EQ.'ARSP'.AND.IH2.EQ.'DF  ')GOTO1082
      IF(IH.EQ.'ARSP'.AND.IH2.EQ.'PF  ')GOTO1083
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'DWEC'.AND.IH2.EQ.'DF  ')GOTO1091
      IF(IH.EQ.'DWEP'.AND.IH2.EQ.'DF  ')GOTO1092
      IF(IH.EQ.'DWEP'.AND.IH2.EQ.'PF  ')GOTO1093
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'LGAC'.AND.IH2.EQ.'DF  ')GOTO1101
      IF(IH.EQ.'LGAP'.AND.IH2.EQ.'DF  ')GOTO1102
      IF(IH.EQ.'LGAP'.AND.IH2.EQ.'PF  ')GOTO1103
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'HSEC'.AND.IH2.EQ.'DF  ')GOTO1111
      IF(IH.EQ.'HSEP'.AND.IH2.EQ.'DF  ')GOTO1112
      IF(IH.EQ.'HSEP'.AND.IH2.EQ.'PF  ')GOTO1113
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'HFCC'.AND.IH2.EQ.'DF  ')GOTO1121
      IF(IH.EQ.'HFCP'.AND.IH2.EQ.'DF  ')GOTO1122
      IF(IH.EQ.'HFCP'.AND.IH2.EQ.'PF  ')GOTO1123
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'HFLC'.AND.IH2.EQ.'DF  ')GOTO1131
      IF(IH.EQ.'HFLP'.AND.IH2.EQ.'DF  ')GOTO1132
      IF(IH.EQ.'HFLP'.AND.IH2.EQ.'PF  ')GOTO1133
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'GEVC'.AND.IH2.EQ.'DF  ')GOTO1141
      IF(IH.EQ.'GEVP'.AND.IH2.EQ.'DF  ')GOTO1142
      IF(IH.EQ.'GEVP'.AND.IH2.EQ.'PF  ')GOTO1143
      IF(IH.EQ.'GEVH'.AND.IH2.EQ.'AZ  ')GOTO1144
      IF(IH.EQ.'GEVC'.AND.IH2.EQ.'HAZ ')GOTO1145
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'GOMC'.AND.IH2.EQ.'DF  ')GOTO1151
      IF(IH.EQ.'GOMP'.AND.IH2.EQ.'DF  ')GOTO1152
      IF(IH.EQ.'GOMP'.AND.IH2.EQ.'PF  ')GOTO1153
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'PA2C'.AND.IH2.EQ.'DF  ')GOTO1161
      IF(IH.EQ.'PA2P'.AND.IH2.EQ.'DF  ')GOTO1162
      IF(IH.EQ.'PA2P'.AND.IH2.EQ.'PF  ')GOTO1163
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'WCAC'.AND.IH2.EQ.'DF  ')GOTO1171
      IF(IH.EQ.'WCAP'.AND.IH2.EQ.'DF  ')GOTO1172
      IF(IH.EQ.'WCAP'.AND.IH2.EQ.'PF  ')GOTO1173
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'EWEC'.AND.IH2.EQ.'DF  ')GOTO1181
      IF(IH.EQ.'EWEP'.AND.IH2.EQ.'DF  ')GOTO1182
      IF(IH.EQ.'EWEP'.AND.IH2.EQ.'PF  ')GOTO1183
      IF(IH.EQ.'EWEH'.AND.IH2.EQ.'AZ  ')GOTO1184
      IF(IH.EQ.'EWEC'.AND.IH2.EQ.'HAZ ')GOTO1185
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    OCTOBER 1995
      IF(IH.EQ.'TNEC'.AND.IH2.EQ.'DF  ')GOTO1191
      IF(IH.EQ.'TNEP'.AND.IH2.EQ.'DF  ')GOTO1192
      IF(IH.EQ.'TNEP'.AND.IH2.EQ.'PF  ')GOTO1193
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    DECEMBER 1995
      IF(IH.EQ.'GLOC'.AND.IH2.EQ.'DF  ')GOTO1201
      IF(IH.EQ.'GLOP'.AND.IH2.EQ.'DF  ')GOTO1202
      IF(IH.EQ.'GLOP'.AND.IH2.EQ.'PF  ')GOTO1203
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    DECEMBER 1995
      IF(IH.EQ.'PEXC'.AND.IH2.EQ.'DF  ')GOTO1211
      IF(IH.EQ.'PEXP'.AND.IH2.EQ.'DF  ')GOTO1212
      IF(IH.EQ.'PEXP'.AND.IH2.EQ.'PF  ')GOTO1213
      IF(IH.EQ.'PEXH'.AND.IH2.EQ.'AZ  ')GOTO1214
      IF(IH.EQ.'PEXC'.AND.IH2.EQ.'HAZ ')GOTO1215
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    DECEMBER 1995
      IF(IH.EQ.'DGAC'.AND.IH2.EQ.'DF  ')GOTO1221
      IF(IH.EQ.'DGAP'.AND.IH2.EQ.'DF  ')GOTO1222
      IF(IH.EQ.'DGAP'.AND.IH2.EQ.'PF  ')GOTO1223
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    DECEMBER 1995
      IF(IH.EQ.'KAPC'.AND.IH2.EQ.'DF  ')GOTO1231
      IF(IH.EQ.'KAPP'.AND.IH2.EQ.'DF  ')GOTO1232
      IF(IH.EQ.'KAPP'.AND.IH2.EQ.'PF  ')GOTO1233
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    DECEMBER 1995
      IF(IH.EQ.'FCAC'.AND.IH2.EQ.'DF  ')GOTO1241
      IF(IH.EQ.'FCAP'.AND.IH2.EQ.'DF  ')GOTO1242
      IF(IH.EQ.'FCAP'.AND.IH2.EQ.'PF  ')GOTO1243
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    FEBRUARY 1996
      IF(IH.EQ.'BBNC'.AND.IH2.EQ.'DF  ')GOTO1251
      IF(IH.EQ.'BBNP'.AND.IH2.EQ.'DF  ')GOTO1252
      IF(IH.EQ.'BBNP'.AND.IH2.EQ.'PF  ')GOTO1253
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    MARCH 2004
      IF(IH.EQ.'POLC'.AND.IH2.EQ.'DF  ')GOTO1256
      IF(IH.EQ.'POLP'.AND.IH2.EQ.'DF  ')GOTO1257
      IF(IH.EQ.'POLP'.AND.IH2.EQ.'PF  ')GOTO1258
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    FEBRUARY 1996
      IF(IH.EQ.'BRAC'.AND.IH2.EQ.'DF  ')GOTO1261
      IF(IH.EQ.'BRAP'.AND.IH2.EQ.'DF  ')GOTO1262
      IF(IH.EQ.'BRAP'.AND.IH2.EQ.'PF  ')GOTO1263
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    FEBRUARY 1996
      IF(IH.EQ.'GEXC'.AND.IH2.EQ.'DF  ')GOTO1271
      IF(IH.EQ.'GEXP'.AND.IH2.EQ.'DF  ')GOTO1272
      IF(IH.EQ.'GEXP'.AND.IH2.EQ.'PF  ')GOTO1273
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    MAY 1996
      IF(IH.EQ.'RECC'.AND.IH2.EQ.'DF  ')GOTO1281
      IF(IH.EQ.'RECP'.AND.IH2.EQ.'DF  ')GOTO1282
      IF(IH.EQ.'RECP'.AND.IH2.EQ.'PF  ')GOTO1283
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED    MAY 1996
      IF(IH.EQ.'SRAC'.AND.IH2.EQ.'DF  ')GOTO1291
CCCCC IF(IH.EQ.'SRAP'.AND.IH2.EQ.'DF  ')GOTO1292
      IF(IH.EQ.'SRAP'.AND.IH2.EQ.'PF  ')GOTO1293
C
CCCCC THE FOLLOWING 7 LINES WERE ADDED    SEPTEMBER 2001
      IF(IH.EQ.'GLDC'.AND.IH2.EQ.'DF  ')GOTO1301
      IF(IH.EQ.'GLDP'.AND.IH2.EQ.'DF  ')GOTO1302
      IF(IH.EQ.'GLDP'.AND.IH2.EQ.'PF  ')GOTO1303
CCCCC IF(IH.EQ.'GLDC'.AND.IH2.EQ.'HK  ')GOTO1304
      IF(IH.EQ.'GLDL'.AND.IH2.EQ.'LM  ')GOTO1305
      IF(IH.EQ.'GLDU'.AND.IH2.EQ.'LM  ')GOTO1306
CCCCC IF(IH.EQ.'GLDS'.AND.IH2.EQ.'GN  ')GOTO1307
C
CCCCC THE FOLLOWING SECTION WAS ADDED    SEPTEMBER 2001
      IF(IH.EQ.'LDEC'.AND.IH2.EQ.'DF  ')GOTO1321
      IF(IH.EQ.'LDEP'.AND.IH2.EQ.'DF  ')GOTO1322
      IF(IH.EQ.'LDEP'.AND.IH2.EQ.'PF  ')GOTO1323
      IF(IH.EQ.'IWEC'.AND.IH2.EQ.'DF  ')GOTO1331
      IF(IH.EQ.'IWEP'.AND.IH2.EQ.'DF  ')GOTO1332
      IF(IH.EQ.'IWEP'.AND.IH2.EQ.'PF  ')GOTO1333
      IF(IH.EQ.'IWEH'.AND.IH2.EQ.'AZ  ')GOTO1334
      IF(IH.EQ.'IWEC'.AND.IH2.EQ.'HAZ ')GOTO1335
      IF(IH.EQ.'JSBC'.AND.IH2.EQ.'DF  ')GOTO1341
      IF(IH.EQ.'JSBP'.AND.IH2.EQ.'DF  ')GOTO1342
      IF(IH.EQ.'JSBP'.AND.IH2.EQ.'PF  ')GOTO1343
      IF(IH.EQ.'JSUC'.AND.IH2.EQ.'DF  ')GOTO1351
      IF(IH.EQ.'JSUP'.AND.IH2.EQ.'DF  ')GOTO1352
      IF(IH.EQ.'JSUP'.AND.IH2.EQ.'PF  ')GOTO1353
      IF(IH.EQ.'GEEC'.AND.IH2.EQ.'DF  ')GOTO1361
      IF(IH.EQ.'GEEP'.AND.IH2.EQ.'DF  ')GOTO1362
      IF(IH.EQ.'GEEP'.AND.IH2.EQ.'PF  ')GOTO1363
      IF(IH.EQ.'GEEH'.AND.IH2.EQ.'AZ  ')GOTO1364
      IF(IH.EQ.'GEEC'.AND.IH2.EQ.'HAZ ')GOTO1365
      IF(IH.EQ.'TSPC'.AND.IH2.EQ.'DF  ')GOTO1371
      IF(IH.EQ.'TSPP'.AND.IH2.EQ.'DF  ')GOTO1372
      IF(IH.EQ.'TSPP'.AND.IH2.EQ.'PF  ')GOTO1373
      IF(IH.EQ.'BWEC'.AND.IH2.EQ.'DF  ')GOTO1381
      IF(IH.EQ.'BWEP'.AND.IH2.EQ.'DF  ')GOTO1382
      IF(IH.EQ.'BWEP'.AND.IH2.EQ.'PF  ')GOTO1383
      IF(IH.EQ.'BWEH'.AND.IH2.EQ.'AZ  ')GOTO1384
      IF(IH.EQ.'BWEC'.AND.IH2.EQ.'HAZ ')GOTO1385
      IF(IH.EQ.'GHCD'.AND.IH2.EQ.'F   ')GOTO1391
      IF(IH.EQ.'GHPD'.AND.IH2.EQ.'F   ')GOTO1392
      IF(IH.EQ.'GHPP'.AND.IH2.EQ.'F   ')GOTO1393
      IF(IH.EQ.'SLAC'.AND.IH2.EQ.'DF  ')GOTO1401
      IF(IH.EQ.'SLAP'.AND.IH2.EQ.'DF  ')GOTO1402
      IF(IH.EQ.'SLAP'.AND.IH2.EQ.'PF  ')GOTO1403
      IF(IH.EQ.'LANC'.AND.IH2.EQ.'DF  ')GOTO1411
      IF(IH.EQ.'LANP'.AND.IH2.EQ.'DF  ')GOTO1412
      IF(IH.EQ.'LANP'.AND.IH2.EQ.'PF  ')GOTO1413
      IF(IH.EQ.'LANX'.AND.IH2.EQ.'M1  ')GOTO1414
      IF(IH.EQ.'LANX'.AND.IH2.EQ.'M2  ')GOTO1415
      IF(IH.EQ.'LAND'.AND.IH2.EQ.'IF  ')GOTO1416
      IF(IH.EQ.'IBCD'.AND.IH2.EQ.'F   ')GOTO1421
      IF(IH.EQ.'IBPD'.AND.IH2.EQ.'F   ')GOTO1422
      IF(IH.EQ.'IBPP'.AND.IH2.EQ.'F   ')GOTO1423
      IF(IH.EQ.'ERRC'.AND.IH2.EQ.'DF  ')GOTO1431
      IF(IH.EQ.'ERRP'.AND.IH2.EQ.'DF  ')GOTO1432
      IF(IH.EQ.'ERRP'.AND.IH2.EQ.'PF  ')GOTO1433
      IF(IH.EQ.'TRAC'.AND.IH2.EQ.'DF  ')GOTO1441
      IF(IH.EQ.'TRAP'.AND.IH2.EQ.'DF  ')GOTO1442
      IF(IH.EQ.'TRAP'.AND.IH2.EQ.'PF  ')GOTO1443
      IF(IH.EQ.'GTRC'.AND.IH2.EQ.'DF  ')GOTO1451
      IF(IH.EQ.'GTRP'.AND.IH2.EQ.'DF  ')GOTO1452
      IF(IH.EQ.'GTRP'.AND.IH2.EQ.'PF  ')GOTO1453
      IF(IH.EQ.'FTCD'.AND.IH2.EQ.'F   ')GOTO1461
      IF(IH.EQ.'FTPD'.AND.IH2.EQ.'F   ')GOTO1462
      IF(IH.EQ.'FTPP'.AND.IH2.EQ.'F   ')GOTO1463
      IF(IH.EQ.'SNCD'.AND.IH2.EQ.'F   ')GOTO1471
      IF(IH.EQ.'SNPD'.AND.IH2.EQ.'F   ')GOTO1472
      IF(IH.EQ.'SNPP'.AND.IH2.EQ.'F   ')GOTO1473
      IF(IH.EQ.'STCD'.AND.IH2.EQ.'F   ')GOTO1481
      IF(IH.EQ.'STPD'.AND.IH2.EQ.'F   ')GOTO1482
      IF(IH.EQ.'STPP'.AND.IH2.EQ.'F   ')GOTO1483
      IF(IH.EQ.'ZIPC'.AND.IH2.EQ.'DF  ')GOTO1491
      IF(IH.EQ.'ZIPP'.AND.IH2.EQ.'DF  ')GOTO1492
      IF(IH.EQ.'ZIPP'.AND.IH2.EQ.'DF  ')GOTO1493
      IF(IMAKDF.EQ.'DLMF' .OR. IMAKDF.EQ.'MEEK')THEN
         IF(IH.EQ.'MAKC'.AND.IH2.EQ.'DF  ')GOTO1501
         IF(IH.EQ.'MAKP'.AND.IH2.EQ.'DF  ')GOTO1502
         IF(IH.EQ.'MAKP'.AND.IH2.EQ.'PF  ')GOTO1503
         IF(IH.EQ.'MAKH'.AND.IH2.EQ.'AZ  ')GOTO1504
         IF(IH.EQ.'MAKC'.AND.IH2.EQ.'HAZ ')GOTO1505
      ELSEIF(IMAKDF.EQ.'REPA')THEN
         IF(IH.EQ.'MAKC'.AND.IH2.EQ.'DF  ')GOTO1506
         IF(IH.EQ.'MAKP'.AND.IH2.EQ.'DF  ')GOTO1507
         IF(IH.EQ.'MAKP'.AND.IH2.EQ.'PF  ')GOTO1508
         IF(IH.EQ.'MAKH'.AND.IH2.EQ.'AZ  ')GOTO1509
         IF(IH.EQ.'MAKC'.AND.IH2.EQ.'HAZ ')GOTO1510
      ENDIF
      IF(IH.EQ.'LSNC'.AND.IH2.EQ.'DF  ')GOTO1511
      IF(IH.EQ.'LSNP'.AND.IH2.EQ.'DF  ')GOTO1512
      IF(IH.EQ.'LSNP'.AND.IH2.EQ.'PF  ')GOTO1513
      IF(IH.EQ.'LSTC'.AND.IH2.EQ.'DF  ')GOTO1521
      IF(IH.EQ.'LSTP'.AND.IH2.EQ.'DF  ')GOTO1522
      IF(IH.EQ.'LSTP'.AND.IH2.EQ.'PF  ')GOTO1523
      IF(IH.EQ.'HERC'.AND.IH2.EQ.'DF  ')GOTO1531
      IF(IH.EQ.'HERP'.AND.IH2.EQ.'DF  ')GOTO1532
      IF(IH.EQ.'HERP'.AND.IH2.EQ.'PF  ')GOTO1533
      IF(IH.EQ.'GWAC'.AND.IH2.EQ.'DF  ')GOTO1541
      IF(IH.EQ.'GWAP'.AND.IH2.EQ.'DF  ')GOTO1542
      IF(IH.EQ.'GWAP'.AND.IH2.EQ.'PF  ')GOTO1543
      IF(IH.EQ.'SDEC'.AND.IH2.EQ.'DF  ')GOTO1551
      IF(IH.EQ.'SDEP'.AND.IH2.EQ.'DF  ')GOTO1552
      IF(IH.EQ.'SDEP'.AND.IH2.EQ.'PF  ')GOTO1553
      IF(IH.EQ.'ADEC'.AND.IH2.EQ.'DF  ')GOTO1561
      IF(IH.EQ.'ADEP'.AND.IH2.EQ.'DF  ')GOTO1562
      IF(IH.EQ.'ADEP'.AND.IH2.EQ.'PF  ')GOTO1563
      IF(IH.EQ.'GALC'.AND.IH2.EQ.'DF  ')GOTO1571
      IF(IH.EQ.'GALP'.AND.IH2.EQ.'DF  ')GOTO1572
      IF(IH.EQ.'GALP'.AND.IH2.EQ.'PF  ')GOTO1573
      IF(IH.EQ.'MAXC'.AND.IH2.EQ.'DF  ')GOTO1581
      IF(IH.EQ.'MAXP'.AND.IH2.EQ.'DF  ')GOTO1582
      IF(IH.EQ.'MAXP'.AND.IH2.EQ.'PF  ')GOTO1583
      IF(IH.EQ.'FERC'.AND.IH2.EQ.'DF  ')GOTO1591
      IF(IH.EQ.'FERP'.AND.IH2.EQ.'DF  ')GOTO1592
      IF(IH.EQ.'FERP'.AND.IH2.EQ.'PF  ')GOTO1593
      IF(IH.EQ.'RAYC'.AND.IH2.EQ.'DF  ')GOTO1601
      IF(IH.EQ.'RAYP'.AND.IH2.EQ.'DF  ')GOTO1602
      IF(IH.EQ.'RAYP'.AND.IH2.EQ.'PF  ')GOTO1603
      IF(IH.EQ.'GIGC'.AND.IH2.EQ.'DF  ')GOTO1611
      IF(IH.EQ.'GIGP'.AND.IH2.EQ.'DF  ')GOTO1612
      IF(IH.EQ.'GIGP'.AND.IH2.EQ.'PF  ')GOTO1613
      IF(IH.EQ.'BEIC'.AND.IH2.EQ.'DF  ')GOTO1621
      IF(IH.EQ.'BEIP'.AND.IH2.EQ.'DF  ')GOTO1622
      IF(IH.EQ.'BEIP'.AND.IH2.EQ.'PF  ')GOTO1623
      IF(IH.EQ.'BEKC'.AND.IH2.EQ.'DF  ')GOTO1631
      IF(IH.EQ.'BEKP'.AND.IH2.EQ.'DF  ')GOTO1632
      IF(IH.EQ.'BEKP'.AND.IH2.EQ.'PF  ')GOTO1633
      IF(IH.EQ.'MCLC'.AND.IH2.EQ.'DF  ')GOTO1641
      IF(IH.EQ.'MCLP'.AND.IH2.EQ.'DF  ')GOTO1642
      IF(IH.EQ.'MCLP'.AND.IH2.EQ.'PF  ')GOTO1643
      IF(IH.EQ.'GMCC'.AND.IH2.EQ.'DF  ')GOTO1651
      IF(IH.EQ.'GMCP'.AND.IH2.EQ.'DF  ')GOTO1652
      IF(IH.EQ.'GMCP'.AND.IH2.EQ.'PF  ')GOTO1653
      IF(IH.EQ.'HBOC'.AND.IH2.EQ.'DF  ')GOTO1661
      IF(IH.EQ.'HBOP'.AND.IH2.EQ.'DF  ')GOTO1662
      IF(IH.EQ.'HBOP'.AND.IH2.EQ.'PF  ')GOTO1663
      IF(IH.EQ.'GL5C'.AND.IH2.EQ.'DF  ')GOTO1671
      IF(IH.EQ.'GL5P'.AND.IH2.EQ.'DF  ')GOTO1672
      IF(IH.EQ.'GL5P'.AND.IH2.EQ.'PF  ')GOTO1673
      IF(IH.EQ.'WAKC'.AND.IH2.EQ.'DF  ')GOTO1681
      IF(IH.EQ.'WAKP'.AND.IH2.EQ.'DF  ')GOTO1682
      IF(IH.EQ.'WAKP'.AND.IH2.EQ.'PF  ')GOTO1683
      IF(IH.EQ.'BNOC'.AND.IH2.EQ.'DF  ')GOTO1691
      IF(IH.EQ.'BNOP'.AND.IH2.EQ.'DF  ')GOTO1692
      IF(IH.EQ.'BNOP'.AND.IH2.EQ.'PF  ')GOTO1693
      IF(IH.EQ.'GL2C'.AND.IH2.EQ.'DF  ')GOTO1701
      IF(IH.EQ.'GL2P'.AND.IH2.EQ.'DF  ')GOTO1702
      IF(IH.EQ.'GL2P'.AND.IH2.EQ.'PF  ')GOTO1703
      IF(IH.EQ.'GL3C'.AND.IH2.EQ.'DF  ')GOTO1711
      IF(IH.EQ.'GL3P'.AND.IH2.EQ.'DF  ')GOTO1712
      IF(IH.EQ.'GL3P'.AND.IH2.EQ.'PF  ')GOTO1713
      IF(IH.EQ.'GL4C'.AND.IH2.EQ.'DF  ')GOTO1721
      IF(IH.EQ.'GL4P'.AND.IH2.EQ.'DF  ')GOTO1722
      IF(IH.EQ.'GL4P'.AND.IH2.EQ.'PF  ')GOTO1723
      IF(IH.EQ.'ALDC'.AND.IH2.EQ.'DF  ')GOTO1731
      IF(IH.EQ.'ALDP'.AND.IH2.EQ.'DF  ')GOTO1732
      IF(IH.EQ.'ALDP'.AND.IH2.EQ.'PF  ')GOTO1733
C
CCCCC THE FOLLOWING LINES WERE ADDED    NOVEMBER   1994
      IF(IH.EQ.'FRES'.AND.IH2.EQ.'NC  ')GOTO2000
      IF(IH.EQ.'FRES'.AND.IH2.EQ.'NS  ')GOTO2010
      IF(IH.EQ.'FRES'.AND.IH2.EQ.'NF  ')GOTO2020
      IF(IH.EQ.'FRES'.AND.IH2.EQ.'NG  ')GOTO2030
      IF(IH.EQ.'PEQ '.AND.IH2.EQ.'    ')GOTO2100
      IF(IH.EQ.'PEQI'.AND.IH2.EQ.'    ')GOTO2105
      IF(IH.EQ.'PEQ1'.AND.IH2.EQ.'    ')GOTO2110
      IF(IH.EQ.'PEQ1'.AND.IH2.EQ.'I   ')GOTO2115
      IF(IH.EQ.'PLEM'.AND.IH2.EQ.'    ')GOTO2120
      IF(IH.EQ.'PLEM'.AND.IH2.EQ.'I   ')GOTO2125
      IF(IH.EQ.'PLEM'.AND.IH2.EQ.'1   ')GOTO2130
      IF(IH.EQ.'PLEM'.AND.IH2.EQ.'1I  ')GOTO2135
      IF(IH.EQ.'SN  '.AND.IH2.EQ.'    ')GOTO2200
      IF(IH.EQ.'CN  '.AND.IH2.EQ.'    ')GOTO2210
      IF(IH.EQ.'DN  '.AND.IH2.EQ.'    ')GOTO2220
C
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'0   ')GOTO5000
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'1   ')GOTO5010
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'2   ')GOTO5020
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'3   ')GOTO5030
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'4   ')GOTO5040
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'5   ')GOTO5050
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'6   ')GOTO5060
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'7   ')GOTO5070
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'8   ')GOTO5080
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'9   ')GOTO5090
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'10  ')GOTO5100
CCCCC THE FOLLOWING SECTION ADDED JULY 1995
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'T   ')GOTO5110
      IF(IH.EQ.'CHEB'.AND.IH2.EQ.'U   ')GOTO5120
      IF(IH.EQ.'NRML'.AND.IH2.EQ.'AG  ')GOTO5130
      IF(IH.EQ.'JACO'.AND.IH2.EQ.'BIP ')GOTO5140
      IF(IH.EQ.'ULTR'.AND.IH2.EQ.'ASPH')GOTO5150
      IF(IH.EQ.'LAGU'.AND.IH2.EQ.'ERRL')GOTO5160
CCCCC IF(IH.EQ.'NRML'.AND.IH2.EQ.'AGL ')GOTO5170
      IF(IH.EQ.'NRML'.AND.IH2.EQ.'EG  ')THEN
        IF(SAVE2.LT.0.)GOTO5180
        IF(SAVE2.GE.0.)GOTO5200
      ENDIF
      IF(IH.EQ.'LEGP'.AND.IH2.EQ.'    ')THEN
        IF(SAVE2.NE.-99.9)GOTO5220
        IF(SAVE2.EQ.-99.9)GOTO5220
      ENDIF
      IF(IH.EQ.'LEGQ'.AND.IH2.EQ.'    ')THEN
        IF(SAVE2.NE.-99.9)GOTO5240
        IF(SAVE2.EQ.-99.9)GOTO5240
      ENDIF
      IF(IH.EQ.'SPHR'.AND.IH2.EQ.'HRMR')THEN
        ISJUNK=0
        GOTO5300
      ENDIF
      IF(IH.EQ.'SPHR'.AND.IH2.EQ.'HRMC')THEN
        ISJUNK=1
        GOTO5300
      ENDIF
C
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'0   ')GOTO6000
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'1   ')GOTO6010
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'J0  ')GOTO6000
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'J1  ')GOTO6010
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'Y0  ')GOTO6100
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'Y1  ')GOTO6150
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'I0  ')GOTO6200
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'I0E ')GOTO6230
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'I1  ')GOTO6250
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'I1E ')GOTO6280
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'K0  ')GOTO6300
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'K0E ')GOTO6330
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'K1  ')GOTO6350
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'K1E ')GOTO6380
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'JN  ')GOTO6400
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'YN  ')GOTO6500
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'IN  ')GOTO6600
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'INE ')GOTO6650
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'KN  ')GOTO6700
      IF(IH.EQ.'BESS'.AND.IH2.EQ.'KNE ')GOTO6750
      IF(IH.EQ.'AIRY'.AND.IH2.EQ.'    ')GOTO6800
      IF(IH.EQ.'BAIR'.AND.IH2.EQ.'Y   ')GOTO6900
CCCCC FOLLOWING SECTION ADDED OCTOBER, 1994.
      IF(IH.EQ.'CBES'.AND.IH2.EQ.'SJR ')GOTO7000
      IF(IH.EQ.'CBES'.AND.IH2.EQ.'SJI ')GOTO7010
      IF(IH.EQ.'CBES'.AND.IH2.EQ.'SYR ')GOTO7020
      IF(IH.EQ.'CBES'.AND.IH2.EQ.'SYI ')GOTO7030
      IF(IH.EQ.'CBES'.AND.IH2.EQ.'SIR ')GOTO7040
      IF(IH.EQ.'CBES'.AND.IH2.EQ.'SII ')GOTO7050
      IF(IH.EQ.'CBES'.AND.IH2.EQ.'SKR ')GOTO7060
      IF(IH.EQ.'CBES'.AND.IH2.EQ.'SKI ')GOTO7070
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED MAY 1989
      IF(IH.EQ.'CP  '.AND.IH2.EQ.'    ')GOTO7100
      IF(IH.EQ.'CPK '.AND.IH2.EQ.'    ')GOTO7200
      IF(IH.EQ.'PERD'.AND.IH2.EQ.'EF  ')GOTO7300
      IF(IH.EQ.'EXPL'.AND.IH2.EQ.'OS  ')GOTO7400
C
CCCCC THE FOLLOWING SECTION ADDED SEPTEMBER 1994
      IF(IH.EQ.'DAWS'.AND.IH2.EQ.'ON  ')GOTO7500
      IF(IH.EQ.'EXPI'.AND.IH2.EQ.'NT1 ')GOTO7600
      IF(IH.EQ.'EXPI'.AND.IH2.EQ.'NTE ')GOTO7650
      IF(IH.EQ.'EXPI'.AND.IH2.EQ.'NTN ')GOTO7700
      IF(IH.EQ.'RC  '.AND.IH2.EQ.'    ')GOTO7800
      IF(IH.EQ.'RD  '.AND.IH2.EQ.'    ')GOTO7810
      IF(IH.EQ.'ELLI'.AND.IH2.EQ.'PC2 ')GOTO7815
      IF(IH.EQ.'ELLI'.AND.IH2.EQ.'P2  ')GOTO7818
      IF(IH.EQ.'RF  '.AND.IH2.EQ.'    ')GOTO7820
      IF(IH.EQ.'ELLI'.AND.IH2.EQ.'PC1 ')GOTO7825
      IF(IH.EQ.'ELLI'.AND.IH2.EQ.'P1  ')GOTO7828
      IF(IH.EQ.'RJ  '.AND.IH2.EQ.'    ')GOTO7830
      IF(IH.EQ.'ELLI'.AND.IH2.EQ.'P3  ')GOTO7838
      IF(IH.EQ.'SPEN'.AND.IH2.EQ.'CE  ')GOTO7900
      IF(IH.EQ.'LOGI'.AND.IH2.EQ.'NT  ')GOTO8000
      IF(IH.EQ.'SINI'.AND.IH2.EQ.'NT  ')GOTO8100
      IF(IH.EQ.'SINH'.AND.IH2.EQ.'INT ')GOTO8200
      IF(IH.EQ.'COSI'.AND.IH2.EQ.'NT  ')GOTO8300
      IF(IH.EQ.'COSH'.AND.IH2.EQ.'INT ')GOTO8400
      IF(IH.EQ.'CABS'.AND.IH2.EQ.'    ')GOTO8500
      IF(IH.EQ.'CCOS'.AND.IH2.EQ.'    ')GOTO8600
      IF(IH.EQ.'CCOS'.AND.IH2.EQ.'I   ')GOTO8610
      IF(IH.EQ.'CEXP'.AND.IH2.EQ.'    ')GOTO8700
      IF(IH.EQ.'CEXP'.AND.IH2.EQ.'I   ')GOTO8710
      IF(IH.EQ.'CLOG'.AND.IH2.EQ.'    ')GOTO8800
      IF(IH.EQ.'CLOG'.AND.IH2.EQ.'I   ')GOTO8810
      IF(IH.EQ.'CSIN'.AND.IH2.EQ.'    ')GOTO8900
      IF(IH.EQ.'CSIN'.AND.IH2.EQ.'I   ')GOTO8910
      IF(IH.EQ.'CSQR'.AND.IH2.EQ.'T   ')GOTO8950
      IF(IH.EQ.'CSQR'.AND.IH2.EQ.'TI  ')GOTO8960
CCCCC FOLLOWING 5 LINES ADDED JULY 1995.
      IF(IH.EQ.'HERM'.AND.IH2.EQ.'ITE ')GOTO8970
      IF(IH.EQ.'LNHE'.AND.IH2.EQ.'RMIT')GOTO8975
      IF(IH.EQ.'HERM'.AND.IH2.EQ.'SGN ')GOTO8978
      IF(IH.EQ.'LAGU'.AND.IH2.EQ.'ERRE')GOTO8980
      IF(IH.EQ.'LEGE'.AND.IH2.EQ.'NDRE')THEN
        IF(SAVE2.LT.0.)GOTO8990
        IF(SAVE2.GE.0.)GOTO5280
      ENDIF
      IF(IH.EQ.'BN  '.AND.IH2.EQ.'    ')GOTO8010
      IF(IH.EQ.'EN  '.AND.IH2.EQ.'    ')GOTO8020
      IF(IH.EQ.'BINO'.AND.IH2.EQ.'M   ')GOTO8030
      IF(IH.EQ.'BINO'.AND.IH2.EQ.'MIAL')GOTO8030
C
      IF(IH.EQ.'ABRA'.AND.IH2.EQ.'M   ')GOTO8040
      IF(IH.EQ.'CLAU'.AND.IH2.EQ.'SN  ')GOTO8045
      IF(IH.EQ.'DEBY'.AND.IH2.EQ.'E   ')GOTO8050
      IF(IH.EQ.'EXP3'.AND.IH2.EQ.'    ')GOTO8055
      IF(IH.EQ.'GOOD'.AND.IH2.EQ.'ST  ')GOTO8060
      IF(IH.EQ.'LOBA'.AND.IH2.EQ.'CH  ')GOTO8065
      IF(IH.EQ.'STRO'.AND.IH2.EQ.'M   ')GOTO8070
      IF(IH.EQ.'SYNC'.AND.IH2.EQ.'H1  ')GOTO8075
      IF(IH.EQ.'SYNC'.AND.IH2.EQ.'H2  ')GOTO8080
      IF(IH.EQ.'TRAN'.AND.IH2.EQ.'    ')GOTO8085
C
      IF(IH.EQ.'AIRI'.AND.IH2.EQ.'NT  ')GOTO18090
      IF(IH.EQ.'AIRY'.AND.IH2.EQ.'GI  ')GOTO18095
      IF(IH.EQ.'AIRY'.AND.IH2.EQ.'HI  ')GOTO18100
      IF(IH.EQ.'ATNI'.AND.IH2.EQ.'NT  ')GOTO18105
      IF(IH.EQ.'BIRI'.AND.IH2.EQ.'NT  ')GOTO18110
      IF(IH.EQ.'I0IN'.AND.IH2.EQ.'T   ')GOTO18115
      IF(IH.EQ.'I0ML'.AND.IH2.EQ.'0   ')GOTO18120
      IF(IH.EQ.'I1ML'.AND.IH2.EQ.'1   ')GOTO18125
      IF(IH.EQ.'J0IN'.AND.IH2.EQ.'T   ')GOTO18130
      IF(IH.EQ.'K0IN'.AND.IH2.EQ.'T   ')GOTO18135
      IF(IH.EQ.'Y0IN'.AND.IH2.EQ.'T   ')GOTO18140
C
      IFOUND='NO'
      GOTO9000
C
  551 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  559 FORMAT('**** ERROR: NEGATIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
CCCCC CALL NORCDF(ARG1,RESULT)
      CALL NODCDF(DBLE(ARG1),DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
  552 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
CCCCC CALL NORPDF(ARG1,RESULT)
      CALL NODPDF(DBLE(ARG1),DRESLT)
      TERM=REAL(DRESLT)/ZSCALE
      GOTO9000
C
  553 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
CCCCC CALL NORPPF(ARG1,RESULT)
      CALL NODPPF(DBLE(ARG1),DRESLT)
      TERM=ZLOC + ZSCALE*REAL(DRESLT)
      GOTO9000
C
  554 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL NORSF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  555 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=DBLE((ARG1-ZLOC)/ZSCALE)
      CALL NODPDF(DARG1,DTERM2)
      CALL NODCDF(-DARG1,DTERM1)
      IF(DTERM1.NE.0.0D0)THEN
        TERM=REAL(DTERM2/DTERM1)/ZSCALE
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,557)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
  557 FORMAT('*****WARNING: FOR ARGUMENT = ',F15.7,' CDF TERM ',
     1'ESSENTIALLY 1, VALUE SET TO 0')
      GOTO9000
C
  556 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=-DBLE((ARG1-ZLOC)/ZSCALE)
      CALL NODCDF(DARG1,DTERM1)
      IF(DTERM1.GT.0.0D0)THEN
        TERM=REAL(-DLOG(DTERM1))
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,557)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
      GOTO9000
C
 8557 CONTINUE
      ARG1=X
C
      ZLOC1=0.0
      IF(SAVE1.NE.-99.9)ZLOC1=SAVE1
      ZSCAL1=1.0
      IF(SAVE2.NE.-99.9)ZSCAL1=SAVE2
      ZLOC2=0.0
      IF(SAVE3.NE.-99.9)ZLOC2=SAVE3
      ZSCAL2=1.0
      IF(SAVE4.NE.-99.9)ZSCAL2=SAVE4
      P=0.5
      IF(SAVE5.GE.0.0 .AND. SAVE5.LE.1.0)P=SAVE5
      CALL NMXCDF(ARG1,ZLOC1,ZSCAL1,ZLOC2,ZSCAL2,P,RESULT)
      TERM=RESULT
      GOTO9000
C
 8558 CONTINUE
      ARG1=X
C
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL NORPDF(ARG1,RESLT1)
      RESLT1=RESLT1/ZSCALE
C
      ARG1=X
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL NORPDF(ARG1,RESLT2)
      RESLT2=RESLT2/ZSCALE
C
      P=0.5
      IF(SAVE5.GE.0.0 .AND. SAVE5.LE.1.0)P=SAVE5
      TERM=P*RESLT1 + (1.0-P)*RESLT2
      GOTO9000
C
 8559 CONTINUE
      ARG1=X
      ZLOC1=0.0
      IF(SAVE1.NE.-99.9)ZLOC1=SAVE1
      ZSCAL1=1.0
      IF(SAVE2.NE.-99.9)ZSCAL1=SAVE2
      ZLOC2=0.0
      IF(SAVE3.NE.-99.9)ZLOC2=SAVE3
      ZSCAL2=1.0
      IF(SAVE4.NE.-99.9)ZSCAL2=SAVE4
      P=0.5
      IF(SAVE5.GE.0.0 .AND. SAVE5.LE.1.0)P=SAVE5
C
      IF(ZSCAL1.LE.0.0.OR.ZSCAL2.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL NMXPPF(ARG1,ZLOC1,ZSCAL1,ZLOC2,ZSCAL2,P,RESULT)
      TERM=RESULT
      GOTO9000
C
  561 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL TCDF(ARG1,IARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  562 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL TPDF(ARG1,IARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  563 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL TPPF(ARG1,IARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  571 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL CHSCDF(ARG1,IARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  572 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL CHSPDF(ARG1,IARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  573 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL CHSPPF(ARG1,IARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  581 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      IARG3=SAVE2+0.5
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL FCDF(ARG1,IARG2,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  582 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      IARG3=SAVE2+0.5
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL FPDF(ARG1,IARG2,IARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  583 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      IARG3=SAVE2+0.5
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL FPPF(ARG1,IARG2,IARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  591 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  599 FORMAT('**** ERROR: NEGATIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1993
CCCCC IARG3=SAVE2+0.5  (BUT INCORRECT)
CCCCC THE FOLLOWING LINE FIXED THE ABOVE LINE    JANUARY 1994
      IARG3=MINMAX
CCCCC THE FOLLOWING LINE WAS CHANGED MAY 1993
CCCCC CALL WEICDF(ARG1,ARG2,RESULT)
      CALL WEICDF(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  592 CONTINUE
      ARG1=X
      ARG2=SAVE1
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1993
CCCCC IARG3=SAVE2+0.5  (BUT INCORRECT)
CCCCC THE FOLLOWING LINE FIXED THE ABOVE LINE    JANUARY 1994
      IARG3=MINMAX
CCCCC THE FOLLOWING LINE WAS CHANGED MAY 1993
CCCCC CALL WEIPDF(ARG1,ARG2,RESULT)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL WEIPDF(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  593 CONTINUE
      ARG1=X
      ARG2=SAVE1
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1993
CCCCC IARG3=SAVE2+0.5  (BUT INCORRECT)
CCCCC THE FOLLOWING LINE FIXED THE ABOVE LINE    JANUARY 1994
      IARG3=MINMAX
CCCCC THE FOLLOWING LINE WAS CHANGED MAY 1993
CCCCC CALL WEIPPF(ARG1,ARG2,RESULT)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL WEIPPF(ARG1,ARG2,IARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  594 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL WEIHAZ(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  595 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL WEICHA(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  596 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      CALL WEIAFR(ARG1,ARG2,ARG3,ZLOC,ZSCALE,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED MAY 1990
  601 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,609)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  609 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL IGCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  602 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,609)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL IGPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  603 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,609)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL IGPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  604 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,609)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL IGHAZ(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  605 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,609)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL IGCHA(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED MAY 1990
  611 CONTINUE
      ARG1=X
      ARG2=SAVE1
C
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL WALCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  612 CONTINUE
      ARG1=X
      ARG2=SAVE1
C
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL WALPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  613 CONTINUE
      ARG1=X
      ARG2=SAVE1
C
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL WALPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  614 CONTINUE
      ARG1=X
      ARG2=SAVE1
      AMU=1.0
C
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL IGHAZ(ARG1,ARG2,AMU,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  615 CONTINUE
      ARG1=X
      ARG2=SAVE1
      AMU=1.0
C
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL IGCHA(ARG1,ARG2,AMU,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED MAY 1990
  621 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,629)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  629 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL RIGCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  622 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,629)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL RIGPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  623 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,629)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL RIGPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  624 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,629)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL RIGHAZ(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  625 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,629)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL RIGCHA(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED MAY 1990
  631 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,639)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  639 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL FLCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  632 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,639)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL FLPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  633 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,639)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL FLPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + RESULT
      GOTO9000
C
  634 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,639)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL FLHAZ(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  635 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,639)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL FLCHA(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED      DECEMBER 1993
  641 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,649)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  649 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEPCDF(ARG1,ARG2,IARG3,IGEPDF,RESULT)
      TERM=RESULT
      GOTO9000
C
  642 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,649)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEPPDF(ARG1,ARG2,IARG3,IGEPDF,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  643 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,649)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GEPPPF(ARG1,ARG2,IARG3,IGEPDF,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  644 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,649)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEPHAZ(ARG1,ARG2,IARG3,IGEPDF,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  645 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,649)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEPCHA(ARG1,ARG2,IARG3,IGEPDF,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  651 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=SAVE2+0.5
      CALL BINCDF(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  652 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=SAVE2+0.5
      CALL BINCDF(ARG1,ARG2,IARG3,RESLT1)
      IF(ARG1.LE.0.1)THEN
        TERM=RESLT1
      ELSE
        ARG1=X-1.0
        CALL BINCDF(ARG1,ARG2,IARG3,RESLT2)
        TERM=RESLT1-RESLT2
      ENDIF
      GOTO9000
C
  653 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=SAVE2+0.5 
      CALL BINPPF(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  661 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL POICDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  662 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL POICDF(ARG1,ARG2,RESLT1)
      IF(ARG1.LE.0.1)THEN
        TERM=RESLT1
      ELSE
        ARG1=X-1.0
        CALL POICDF(ARG1,ARG2,RESLT2)
        TERM=RESLT1-RESLT2
      ENDIF
      GOTO9000
C
  663 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL POIPPF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  671 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL SEMCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
  672 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL SEMPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  673 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      CALL SEMPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  681 CONTINUE
      ARG1=X
      ARG2=SAVE1
CCCCC IARG3=SAVE2+0.5
      ARG3=SAVE2
      CALL NBCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  682 CONTINUE
      ARG1=X
      ARG2=SAVE1
CCCCC IARG3=SAVE2+0.5
      ARG3=SAVE2
      CALL NBPDF(ARG1,ARG2,ARG3,RESLT1)
      TERM=RESLT1
CCCCC IF(ARG1.LE.0.1)THEN
CCCCC   TERM=RESLT1
CCCCC ELSE
CCCCC   ARG1=X-1.0
CCCCC   CALL NBCDF(ARG1,ARG2,IARG3,RESLT2)
CCCCC   TERM=RESLT1-RESLT2
CCCCC ENDIF
      GOTO9000
C
  683 CONTINUE
      ARG1=X
      ARG2=SAVE1
CCCCC IARG3=SAVE2+0.5
      ARG3=SAVE2
      CALL NBPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  691 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,699)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  699 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL CAUCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
  692 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,699)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL CAUPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  693 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,699)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL CAUPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  694 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,699)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL CAUSF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  701 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,709)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  709 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DEXCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
  702 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,709)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DEXPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  703 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,709)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL DEXPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  704 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,709)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL DEXSF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  711 CONTINUE
      ARG1=X
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,719)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  719 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EV1CDF(ARG1,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  712 CONTINUE
      ARG1=X
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,719)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EV1PDF(ARG1,IARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  713 CONTINUE
      ARG1=X
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,719)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL EV1PPF(ARG1,IARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  714 CONTINUE
      ARG1=X
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,719)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EV1HAZ(ARG1,IARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  715 CONTINUE
      ARG1=X
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,719)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EV1CHA(ARG1,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  721 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,729)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  729 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EV2CDF(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  722 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,729)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EV2PDF(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  723 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,729)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL EV2PPF(ARG1,ARG2,IARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  724 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,729)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EV2HAZ(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  725 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,729)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EV2CHA(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  731 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,739)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  739 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      CALL EXPCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
  732 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,739)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EXPPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  733 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,739)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL EXPPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  734 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,739)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL EXPSF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  735 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,739)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EXPHAZ(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  736 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,739)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EXPCHA(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
  737 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZSCALE=SAVE2
      CALL EXPAFR(ARG1,ARG2,ZSCALE,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  741 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,749)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  749 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GAMCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  742 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,749)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GAMPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  743 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,749)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GAMPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  744 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,749)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ARG1.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11747)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
11747 FORMAT('**** ERROR FROM GAMHAZ: VALUE OF ',E15.7,' YIELDS ',
     1'A NEGATIVE ARGUMENT FOR GAMPDF AND GAMCDF.')
C
      IF(ARG2.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11748)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
11748 FORMAT('**** ERROR FROM GAMHAZ: NEGATIVE VALUES FOR SHAPE ',
     1'PARAMETER NOT ALLOWED.')
C
      IF(ARG2.EQ.1.0)THEN
        TERM=1.0/ZSCALE
        GOTO9000
      ENDIF
      CALL GAMPDF(ARG1,ARG2,PDF)
      CALL GAMCDF(ARG1,ARG2,CDF)
      TERM1=1.0-CDF
      IF(TERM1.NE.0.0)THEN
        TERM=(PDF/TERM1)/ZSCALE
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,747)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
  747 FORMAT('*****WARNING: FOR ARGUMENT = ',F15.7,' CDF TERM ',
     1'ESSENTIALLY 1, VALUE SET TO 0')
      GOTO9000
C
  745 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ARG1.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,12747)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
12747 FORMAT('**** ERROR FROM GAMCHAZ: VALUE OF ',E15.7,' YIELDS ',
     1'A NEGATIVE ARGUMENT FOR GAMCDF.')
C
      IF(ARG2.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,12748)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
12748 FORMAT('**** ERROR FROM GAMCHAZ: NEGATIVE VALUES FOR SHAPE ',
     1'PARAMETER NOT ALLOWED.')
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,12749)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
12749 FORMAT('**** ERROR FROM GAMCHAZ: NEGATIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      CALL GAMCDF(ARG1,ARG2,CDF)
      TERM1=1.0-CDF
      IF(TERM1.GT.0.0)THEN
        TERM=-LOG(TERM1)
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,747)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  751 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL GEOCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  752 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL GEOPDF(ARG1,ARG2,RESLT1)
      TERM=RESLT1
      GOTO9000
C
  753 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL GEOPPF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH, 2004.
  756 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL GE2CDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  757 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL GE2PDF(ARG1,ARG2,RESLT1)
      TERM=RESLT1
      GOTO9000
C
  758 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL GE2PPF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  761 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  769 FORMAT('**** ERROR: NEGATIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL HFNCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
  762 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL HFNPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  763 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL HFNPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  771 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LAMCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  772 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LAMPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  773 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LAMPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  774 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LAMSF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
CCCCC APRIL 1995.  SUPPORT STANDARD DEVIATION SHAPE PARAMETER.
  781 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.LE.0.0)ARG2=1.0
CCCCC CALL LGNCDF(ARG1,RESULT)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,789)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  789 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LGNCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC APRIL 1995.  SUPPORT STANDARD DEVIATION SHAPE PARAMETER.
  782 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.LE.0.0)ARG2=1.0
CCCCC CALL LGNPDF(ARG1,RESULT)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,789)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LGNPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
CCCCC APRIL 1995.  SUPPORT STANDARD DEVIATION SHAPE PARAMETER.
  783 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.LE.0.0)ARG2=1.0
CCCCC CALL LGNPPF(ARG1,RESULT)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,789)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LGNPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  784 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.LE.0.0)ARG2=1.0
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,789)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LGNHAZ(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  785 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.LE.0.0)ARG2=1.0
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,789)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LGNCHA(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  786 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      CALL LGNAFR(ARG1,ARG2,ARG3,ZLOC,ZSCALE,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  791 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  799 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LOGCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
  792 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LOGPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  793 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LOGPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  794 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LOGSF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  795 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LOGHAZ(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  796 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LOGCHA(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
CCCCC OCTOBER 2004: TREAT A "LOCATION" PARAMETER AS A
CCCCC A SHAPE PARAMETER (AND ADJUST TRUE LOCATION AND
CCCCC SCALE PARAMETERS ACCORDINGLY).  HOWEVER, DEFAULT IT
CCCCC TO 1 IF NOT SPECIFIED.
C
  801 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL PARCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  802 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL PARPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  803 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL PARPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  804 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL PARHAZ(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  805 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL PARCHA(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 1994.
  811 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL UNICDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
  812 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL UNIPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  813 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      CALL UNIPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  814 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      CALL UNISF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  815 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL UNIHAZ(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  816 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL UNICHA(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  821 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL BETCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  822 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL BETPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  823 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4-ZLOC
      CALL BETPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  831 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL NCBCDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
  832 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL NCBPDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  833 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5-ZLOC
      CALL NCBPPF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  841 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL NCCCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JANUARY, 1996.
  842 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL NCCPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  843 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL NCCPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  844 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      CALL NCCNCP(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  851 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL NCFCDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  852 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL NCFPDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  853 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL NCFPPF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  861 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL NCTCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MAY        1995.
  862 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL NCTPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  863 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      CALL NCTPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  871 CONTINUE
      IARG1=INT(X+0.5)
      IARG2=INT(SAVE1+0.5)
      CALL DISCDF(IARG1,IARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  872 CONTINUE
      IARG1=INT(X+0.5)
      IARG2=INT(SAVE1+0.5)
      CALL DISPDF(IARG1,IARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  873 CONTINUE
      ARG1=X
      IARG2=INT(SAVE1+0.5)
      CALL DISPPF(ARG1,IARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  881 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOWLM=-1.0
      IF(SAVE2.NE.-99.9)ZLOWLM=SAVE2
      ZUPPLM=1.0
      IF(SAVE3.NE.-99.9)ZUPPLM=SAVE3
C
      CALL TRICDF(ARG1,ARG2,ZLOWLM,ZUPPLM,RESULT)
      TERM=RESULT
      GOTO9000
C
  882 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOWLM=-1.0
      IF(SAVE2.NE.-99.9)ZLOWLM=SAVE2
      ZUPPLM=1.0
      IF(SAVE3.NE.-99.9)ZUPPLM=SAVE3
C
      CALL TRIPDF(ARG1,ARG2,ZLOWLM,ZUPPLM,RESULT)
      TERM=RESULT
      GOTO9000
C
  883 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOWLM=-1.0
      IF(SAVE2.NE.-99.9)ZLOWLM=SAVE2
      ZUPPLM=1.0
      IF(SAVE3.NE.-99.9)ZUPPLM=SAVE3
C
      CALL TRIPPF(ARG1,ARG2,ZLOWLM,ZUPPLM,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  891 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DNTCDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MAY, 2004.
  892 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DNTPDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  893 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL DNTPPF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  901 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ZLOC=0.0
      IF(SAVE5.NE.-99.9)ZLOC=SAVE5
      ZSCALE=1.0
      IF(SAVE6.NE.-99.9)ZSCALE=SAVE6
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DNFCDF(ARG1,ARG2,ARG3,ARG4,ARG5,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MAY 2004.
  902 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ZLOC=0.0
      IF(SAVE5.NE.-99.9)ZLOC=SAVE5
      ZSCALE=1.0
      IF(SAVE6.NE.-99.9)ZSCALE=SAVE6
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DNFPDF(ARG1,ARG2,ARG3,ARG4,ARG5,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  903 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ZLOC=0.0
      IF(SAVE5.NE.-99.9)ZLOC=SAVE5
      ZSCALE=1.0
      IF(SAVE6.NE.-99.9)ZSCALE=SAVE6
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL DNFPPF(ARG1,ARG2,ARG3,ARG4,ARG5,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 1994.
  911 CONTINUE
      IARG1=X+0.5
      IARG2=SAVE1+0.5
      IARG3=SAVE2+0.5
      IARG4=SAVE3+0.5
      HYPPNT=.FALSE.
      CALL HYPCDF(IARG1,IARG2,IARG3,IARG4,HYPPNT,RESULT)
      TERM=RESULT
      GOTO9000
C
  912 CONTINUE
      IARG1=X+0.5
      IARG2=SAVE1+0.5
      IARG3=SAVE2+0.5
      IARG4=SAVE3+0.5
      HYPPNT=.TRUE.
      CALL HYPCDF(IARG1,IARG2,IARG3,IARG4,HYPPNT,RESULT)
      TERM=RESULT
      GOTO9000
C
  913 CONTINUE
      ARG1=X
      IARG2=SAVE1+0.5
      IARG3=SAVE2+0.5
      IARG4=SAVE3+0.5
      CALL HYPPPF(ARG1,IARG2,IARG3,IARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER, 1994.
  921 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      IF(ZLOC.LT.0.0 .OR. ZLOC.GT.2*REALPI)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,926)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL VONCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  922 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      IF(ZLOC.LT.0.0 .OR. ZLOC.GT.2*REALPI)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,926)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
  926 FORMAT('***** ERROR: FOR VON MISES, LOCATION PARAMETER MUST ',
     1'BE IN THE INTERVAL (0,2*PI).')
C
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL VONPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  923 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      IF(ZLOC.LT.0.0 .OR. ZLOC.GT.2*REALPI)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,926)
        CALL DPWRST('XXX','BUG')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL VONPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER, 1994.
  931 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      CALL BVNCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MAY      1995.
  932 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
CCCCC SEPTEMBER 1995.  ACTIVATE FOLLOWING LINE.
      CALL BVNPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
  941 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL COSCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
  942 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL COSPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  943 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL COSPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
  951 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ALPCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  952 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL ALPPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  953 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL ALPPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  954 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      CALL ALPHAZ(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  955 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      CALL ALPCHA(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
  961 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
CCCCC CALL PNRCDF(ARG1,ARG2,ARG3,RESULT)
      CALL PNRCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  962 CONTINUE
      ARG1=X
      ARG2=SAVE1
CCCCC ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
CCCCC CALL PNRPDF(ARG1,ARG2,ARG3,RESULT)
      CALL PNRPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  963 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,749)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG3=1.0
      CALL PNRPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  964 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,749)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL PNRHAZ(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  965 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,749)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL PNRCHA(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
  971 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.0)ARG3=1.0
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,979)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  979 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL PLNCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  972 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.0)ARG3=1.0
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,979)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL PLNPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  973 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.0)ARG3=1.0
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,979)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL PLNPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
  974 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.0)ARG3=1.0
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,979)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL PLNHAZ(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  975 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.0)ARG3=1.0
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,979)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL PLNCHA(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
  981 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.0)ARG3=1.0
C
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL FNRCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
  982 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.0)ARG3=1.0
C
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL FNRPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  983 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.0)ARG3=1.0
C
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL FNRPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
  991 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,998)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
  998 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      CALL POWCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
  992 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,998)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL POWPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
  993 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,998)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL POWPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
 1011 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      IF(ARG4.EQ.-99.9)ARG4=0.0
      IF(ARG5.EQ.-99.9)ARG5=1.0
C
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL TNRCDF(ARG1,ARG2,ARG3,ARG4,ARG5,RESULT)
      TERM=RESULT
      GOTO9000
C
 1012 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      IF(ARG4.EQ.-99.9)ARG4=0.0
      IF(ARG5.EQ.-99.9)ARG5=1.0
C
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL TNRPDF(ARG1,ARG2,ARG3,ARG4,ARG5,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1013 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      IF(ARG4.EQ.-99.9)ARG4=0.0
      IF(ARG5.EQ.-99.9)ARG5=1.0
C
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL TNRPPF(ARG1,ARG2,ARG3,ARG4,ARG5,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
 1021 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL CHCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1022 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL CHPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1023 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL CHPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
 1031 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL DLGCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1032 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL DLGPDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1033 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL DLGPPF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
 1041 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.)ARG3=1.0
CCCCC JUNE 1995.  ADD 'TRUN' ARGUMENT
      CALL WARCDF(ARG1,ARG2,ARG3,RESULT,'NOTR')
      TERM=RESULT
      GOTO9000
C
 1042 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.)ARG3=1.0
      CALL WARPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1043 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG3.LE.0.)ARG3=1.0
      IFLAG2='OFF'
      CALL WARPPF(ARG1,ARG2,ARG3,RESULT,IFLAG2)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   2004.
 1046 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL YULCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1047 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL YULPDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1048 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL YULPPF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
 1051 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1059)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1059 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LLGCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1052 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1059)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LLGPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1053 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1059)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LLGPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1995.
 1061 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
11069 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GGDCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1062 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GGDPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1063 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GGDPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1998.
 1064 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GGDHAZ(ARG1,ARG2,ARG3,HAZ)
      TERM=HAZ/ZSCALE
      GOTO9000
C
 1065 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GGDCHA(ARG1,ARG2,ARG3,HAZ)
      TERM=HAZ
      GOTO9000
C
 1066 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL IGACDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1067 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL IGAPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1068 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL IGAPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL,   1998.
 1069 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=-1.0
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GGDHAZ(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 9065 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=-1.0
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11069)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GGDCHA(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER,   1995.
 1071 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ANGCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
 1072 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ANGPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1073 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ANGPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER,   1995.
 1081 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ARSCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
 1082 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ARSPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1083 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2-ZLOC
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ARSPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1091 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1099)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1099 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DWECDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1092 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1099)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DWEPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1093 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1099)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL DWEPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1101 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1169)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1169 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LGACDF(ARG1,ARG2,ILGADF,RESULT)
      TERM=RESULT
      GOTO9000
C
 1102 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1169)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LGAPDF(ARG1,ARG2,ILGADF,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1103 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1169)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LGAPPF(ARG1,ARG2,ILGADF,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1111 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL HSECDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
 1112 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL HSEPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1113 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL HSEPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1121 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1129)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1129 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL HFCCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
 1122 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1129)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL HFCPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1123 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1129)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL HFCPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1131 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL HFLCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1132 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL HFLPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1133 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL HFLPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1141 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1149)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1149 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEVCDF(ARG1,ARG2,MINMAX,RESULT)
      TERM=RESULT
      GOTO9000
C
 1142 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1149)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEVPDF(ARG1,ARG2,MINMAX,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1143 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1149)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GEVPPF(ARG1,ARG2,MINMAX,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1144 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEVHAZ(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1145 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG3=MINMAX
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GEVCHA(ARG1,ARG2,IARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1151 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GOMCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1152 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL GOMPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1153 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL GOMPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
CCCCC DECEMBER 2004.  ALTHOUGH THE A PARAMETER IS TYPICALLY CALLED
CCCCC A LOCATION PARAMETER, IT IS NOT IN THE TECHNICAL SENSE OF
CCCCC LOCATION/SCALE PARAMETERS: f(X,A,B) = (1/B)f((X-A)/B,0,1).
CCCCC THEREFORE, WE TREAT IT AS A SHAPE PARAMETER (DEFAULTS TO 1 IF
CCCCC NOT SPECIFIED).
C
 1161 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL PA2CDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1162 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL PA2PDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1163 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,799)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL PA2PPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1171 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1149)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL WCACDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1172 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1149)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL WCAPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1173 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1149)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL WCAPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1181 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG1=1
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1189)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1189 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EWECDF(ARG1,ARG2,ARG3,IARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
 1182 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG1=1
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1189)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EWEPDF(ARG1,ARG2,ARG3,IARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1183 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG1=1
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1189)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL EWEPPF(ARG1,ARG2,ARG3,IARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1184 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG1=1
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1189)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EWEHAZ(ARG1,ARG2,ARG3,IARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1185 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG1=1
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1189)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL EWECHA(ARG1,ARG2,ARG3,IARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1191 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      IF(ARG3.EQ.-99.9)ARG3=0.0
      IF(ARG4.EQ.-99.9)ARG4=1.0
C
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL TNECDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
 1192 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      IF(ARG3.EQ.-99.9)ARG3=0.0
      IF(ARG4.EQ.-99.9)ARG4=1.0
C
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL TNEPDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1193 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      IF(ARG3.EQ.-99.9)ARG3=0.0
      IF(ARG4.EQ.-99.9)ARG4=1.0
C
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL TNEPPF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1201 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1209 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GLOCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1202 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GLOPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1203 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GLOPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED OCTOBER,   1995.
 1211 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
C
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL PEXCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1212 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
C
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL PEXPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1213 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
C
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL PEXPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1214 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ARG1=ARG1-ZLOC
      CALL PEXHAZ(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1215 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ARG1=ARG1-ZLOC
      CALL PEXCHA(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JANUARY,   1996.
 1221 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1229)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1229 FORMAT('**** ERROR: NON-POSITIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DGACDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1222 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1229)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL DGAPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1223 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1229)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL DGAPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JANUARY,   1996.
 1231 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL KAPCDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
 1232 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL KAPPDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1233 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL KAPPPF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JANUARY,   1996.
 1241 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
C
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL FCACDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1242 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
C
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL FCAPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1243 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
C
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL FCAPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JANUARY,   1996.
 1251 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG4=INT(SAVE3+0.5)
      CALL BBNCDF(ARG1,ARG2,ARG3,IARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
 1252 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG4=INT(SAVE3+0.5)
      CALL BBNPDF(ARG1,ARG2,ARG3,IARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
 1253 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG4=INT(SAVE3+0.5)
      CALL BBNPPF(ARG1,ARG2,ARG3,IARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH      2004.
 1256 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG4=INT(SAVE3+0.5)
      CALL POLCDF(ARG1,ARG2,ARG3,IARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
 1257 CONTINUE
      ARG1=X
      ARG2=INT(SAVE1+0.5)
      ARG3=INT(SAVE2+0.5)
      ARG4=INT(SAVE3+0.5)
      IARG5=INT(SAVE4+0.5)
      CALL POLPDF(ARG1,ARG2,ARG3,ARG4,IARG5,RESULT)
      TERM=RESULT
      GOTO9000
C
 1258 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IARG4=INT(SAVE3+0.5)
      CALL POLPPF(ARG1,ARG2,ARG3,IARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JANUARY,   1996.
 1261 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL BRACDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1262 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL BRAPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1263 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL BRAPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JANUARY,   1996.
 1271 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
C
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL GEXCDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
 1272 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
C
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      CALL GEXPDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1273 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
C
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GEXPPF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JANUARY,   1996.
 1281 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL RECCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1282 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL RECPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1283 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      CALL RECPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH,   1999.
 1291 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ARG1.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11291)ARG1
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
11291 FORMAT(
     1'***** ERROR FROM SRACDF.  ARGUMENT 1 MUST BE POSITIVE.  IT ',
     1'WAS ',G15.7)
      IF(ARG2.LT.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,21291)ARG2
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
21291 FORMAT(
     1'***** ERROR FROM SRACDF.  ARGUMENT 2 MUST BE >= 1.  IT ',
     1'WAS ',G15.7)
      IF(ARG3.LT.2.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31291)ARG3
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
31291 FORMAT(
     1'***** ERROR FROM SRACDF.  ARGUMENT 3 MUST BE >= 2.  IT ',
     1'WAS ',G15.7)
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
CCCCC CALL SRACDF(ARG1,ARG2,ARG3,RESULT)
      DRESLT=PRTRNG(DBLE(ARG1),DBLE(ARG2),DBLE(ARG3),IFAULT)
      RESULT=REAL(DRESLT)
      TERM=RESULT
      GOTO9000
C
 1292 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
CCCCC CALL SRAPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1293 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      IF(ARG1.LT.0.90.OR.ARG1.GT.0.99)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11293)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11294)ARG1
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
11293 FORMAT(
     1'***** ERROR FROM SRAPPF.  ARGUMENT 1 MUST BE IN THE INTERVAL ',
     1'(0.90,0.99).')
11294 FORMAT(
     1'      IT WAS ',G15.7)
      IF(ARG2.LT.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,21293)ARG2
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
21293 FORMAT(
     1'***** ERROR FROM SRAPPF.  ARGUMENT 2 MUST BE >= 1.  IT ',
     1'WAS ',G15.7)
      IF(ARG3.LT.2.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31293)ARG3
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
31293 FORMAT(
     1'***** ERROR FROM SRAPPF.  ARGUMENT 3 MUST BE >= 2.  IT ',
     1'WAS ',G15.7)
C
      DRESLT=QTRNG(DBLE(ARG1),DBLE(ARG2),DBLE(ARG3),IFAULT)
      RESULT=REAL(DRESLT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED AUGUST,   2001.
 1301 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=0.0D0
      DARG5=1.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
      DARG1=(DARG1-DARG4)/DARG5
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IWRITE='ERRO'
      CALL GLDCDF(DARG1,DARG2,DARG3,DRESLT,IGLDDF,IWRITE)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1302 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=0.0D0
      DARG5=1.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
      DARG1=(DARG1-DARG4)/DARG5
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GLDPDF(DARG1,DARG2,DARG3,DRESLT,IGLDDF,IWRITE)
      TERM=REAL(DRESLT)/DARG5
      GOTO9000
C
 1303 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=0.0D0
      DARG5=1.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IWRITE='ERRO'
      CALL GLDPPF(DARG1,DARG2,DARG3,DRESLT,IGLDDF,IWRITE)
      TERM=DARG4 + DARG5*DRESLT
      GOTO9000
C
C1304 CONTINUE
CCCCC ARG1=X
CCCCC ARG2=SAVE1
CCCCC IWRITE='ON'
CCCCC CALL GLDCHK(ARG1,ARG2,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC TERM=0.0
CCCCC IF(IFLAG.EQ.1)TERM=1.0
CCCCC GOTO9000
C
 1305 CONTINUE
C
C  DETERMINE LOWER LIMIT FOR GENERALIZED TUKEY LAMBDA.
C  FIND GLDPPF OF 0.
C
      DARG1=0.0D0
      DARG2=DBLE(X)
      DARG3=DBLE(SAVE1)
      DARG4=0.0D0
      DARG5=1.0D0
      IF(SAVE2.NE.-99.9)DARG4=DBLE(SAVE2)
      IF(SAVE3.NE.-99.9)DARG5=DBLE(SAVE3)
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IWRITE='ERRO'
      CALL GLDPPF(DARG1,DARG2,DARG3,DRESLT,IGLDDF,IWRITE)
      TERM=DARG4 + DARG5*DRESLT
      GOTO9000
C
CCCCC ARG1=X
CCCCC ARG2=SAVE1
CCCCC ARG3=SAVE2
CCCCC ARG4=SAVE3
CCCCC ZLOC=0.0
CCCCC IF(SAVE2.NE.-99.9)ZLOC=SAVE2
CCCCC ZSCALE=1.0
CCCCC CALL GLDCHK(ARG2,ARG3,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC IF(ISIGN.LT.0)ZSCALE=-1.0
CCCCC IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
CCCCC IF(ISIGN.GT.0 .AND. ZSCALE.LE.0.0)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,559)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   TERM=0.0
CCCCC   GOTO9000
CCCCC ELSEIF(ISIGN.LT.0 .AND. ZSCALE.GE.0.0)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1309)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   TERM=0.0
CCCCC   GOTO9000
CCCCC ENDIF
C
CCCCC IWRITE='OFF'
CCCCC CALL GLDCHK(ARG1,ARG2,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC TERM=ZLOC + ABS(ZSCALE)*ALOWER
CCCCC GOTO9000
C
 1306 CONTINUE
C
C  DETERMINE UPPER LIMIT FOR GENERALIZED TUKEY LAMBDA.
C  FIND GLDPPF OF 1.
C
      DARG1=1.0D0
      DARG2=DBLE(X)
      DARG3=DBLE(SAVE1)
      DARG4=0.0D0
      DARG5=1.0D0
      IF(SAVE2.NE.-99.9)DARG4=DBLE(SAVE2)
      IF(SAVE3.NE.-99.9)DARG5=DBLE(SAVE3)
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IWRITE='ERRO'
      CALL GLDPPF(DARG1,DARG2,DARG3,DRESLT,IGLDDF,IWRITE)
      TERM=DARG4 + DARG5*DRESLT
      GOTO9000
C
CCCCC ARG1=X
CCCCC ARG2=SAVE1
CCCCC ARG3=SAVE2
CCCCC ARG4=SAVE3
CCCCC ZLOC=0.0
CCCCC IF(SAVE2.NE.-99.9)ZLOC=SAVE2
CCCCC ZSCALE=1.0
CCCCC CALL GLDCHK(ARG2,ARG3,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC IF(ISIGN.LT.0)ZSCALE=-1.0
CCCCC IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
CCCCC IF(ISIGN.GT.0 .AND. ZSCALE.LE.0.0)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,559)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   TERM=0.0
CCCCC   GOTO9000
CCCCC ELSEIF(ISIGN.LT.0 .AND. ZSCALE.GE.0.0)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1309)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   TERM=0.0
CCCCC   GOTO9000
CCCCC ENDIF
C
CCCCC IWRITE='OFF'
CCCCC CALL GLDCHK(ARG1,ARG2,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC TERM=ZLOC + ABS(ZSCALE)*AUPPER
CCCCC GOTO9000
C
C1307 CONTINUE
CCCCC ARG1=X
CCCCC ARG2=SAVE1
CCCCC IWRITE='OFF'
CCCCC CALL GLDCHK(ARG1,ARG2,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC TERM=REAL(ISIGN)
CCCCC GOTO9000
C
 1321 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LDECDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1322 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LDEPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1323 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LDEPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1331 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL IWECDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1332 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL IWEPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1333 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL IWEPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1334 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,749)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ARG1.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1337)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1337 FORMAT('**** ERROR FROM IWEHAZ: VALUE OF ',E15.7,' YIELDS ',
     1'A NEGATIVE ARGUMENT FOR IWEPDF AND IWECDF.')
C
      IF(ARG2.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1338)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 1338 FORMAT('**** ERROR FROM IWEHAZ: NEGATIVE VALUES FOR SHAPE ',
     1'PARAMETER NOT ALLOWED.')
C
      IF(ARG2.EQ.1.0)THEN
        TERM=1.0/ZSCALE
        GOTO9000
      ENDIF
      CALL IWEPDF(ARG1,ARG2,PDF)
      CALL IWECDF(ARG1,ARG2,CDF)
      TERM1=1.0-CDF
      IF(TERM1.NE.0.0)THEN
        TERM=(PDF/TERM1)/ZSCALE
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1349)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
 1349 FORMAT('*****WARNING: FOR ARGUMENT = ',F15.7,' CDF TERM ',
     1'ESSENTIALLY 1, VALUE SET TO 0')
      GOTO9000
C
 1335 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ARG1.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13337)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
13337 FORMAT('**** ERROR FROM IWECHAZ: VALUE OF ',E15.7,' YIELDS ',
     1'A NEGATIVE ARGUMENT FOR IWECDF.')
C
      IF(ARG2.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13338)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
13338 FORMAT('**** ERROR FROM IWECHAZ: NEGATIVE VALUES FOR SHAPE ',
     1'PARAMETER NOT ALLOWED.')
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13339)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
13339 FORMAT('**** ERROR FROM IWECHAZ: NEGATIVE VALUES FOR SCALE ',
     1'PARAMETER NOT ALLOWED.')
C
      CALL IWECDF(ARG1,ARG2,CDF)
      TERM1=1.0-CDF
      IF(TERM1.GT.0.0)THEN
        TERM=-LOG(TERM1)
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13337)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 2001.
 1341 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4-ZLOC
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL JSBCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1342 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4-ZLOC
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL JSBPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1343 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4-ZLOC
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL JSBPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER, 2001.
 1351 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL JSUCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1352 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4-ZLOC
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL JSUPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1353 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4-ZLOC
      CALL JSUPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1361 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEECDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1362 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEEPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1363 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GEEPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1364 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GEEHAZ(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1365 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GEECHA(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MAY 2002.
 1371 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL TSPCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1372 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL TSPPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1373 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL TSPPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MAY 2002.
CCCCC NOTE: FOR THIS DISTRIBUTION, LOCATION AND SCALE ARE
CCCCC       PART OF THE DEFINITION, SO NO SEPARATE LOCATION
CCCCC       AND SCALE.
 1381 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ARG6=SAVE5
      ZLOC=0.0
      ZSCALE=1.0
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL BWECDF(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,RESULT,DRSLT2)
      TERM=RESULT
      GOTO9000
C
 1382 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ARG6=SAVE5
      ZLOC=0.0
      ZSCALE=1.0
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL BWECDF(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,RESULT,DTERM1)
      CALL BWEHAZ(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,RESULT,DTERM2)
      DRSLT2=DTERM2*(1.0D0-DTERM1)
      TERM=REAL(DRSLT2)/ZSCALE
      GOTO9000
C
 1383 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ARG6=SAVE5
      ZLOC=0.0
      ZSCALE=1.0
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL BWEPPF(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,RESULT,DTERM1)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1384 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ARG6=SAVE5
      ZLOC=0.0
      ZSCALE=1.0
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL BWEHAZ(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,RESULT,DRSLT2)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1385 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ARG6=SAVE5
      ZLOC=0.0
      ZSCALE=1.0
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL BWECDF(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,RESULT,DTERM1)
      DTERM2=1.0D0-DTERM1
      DRSLT2=0.0D0
      IF(DTERM2.GE.0.0D0)THEN
        DRSLT2=-DLOG(DTERM2)
      ELSE
        WRITE(ICOUT,1386)
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1386 FORMAT('**** WARNING FROM BWECHAZ: OVERFLOW IN COMPUTATION, ',
     1       'CUMULATIVE HAZARD SET TO 0')
      TERM=REAL(DRSLT2)/ZSCALE
      GOTO9000
C
 1391 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG2.EQ.-99.9)ARG2=0.0
      IF(ARG3.EQ.-99.9)ARG3=0.0
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GHCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1392 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG2.EQ.-99.9)ARG2=0.0
      IF(ARG3.EQ.-99.9)ARG3=0.0
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL GHPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1393 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      IF(ARG2.EQ.-99.9)ARG2=0.0
      IF(ARG3.EQ.-99.9)ARG3=0.0
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GHPPF(ARG1,ARG2,ARG3,RESULT,DBLE(ARG1),DTERM1)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1401 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL SLACDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
 1402 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL SLAPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1403 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL SLAPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC APRIL 2003: ADD SUPPORT FOR LANDAU DISTRIBUTION
 1411 CONTINUE
      DARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      DARG1=(DARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DRESLT=LANCDF(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1412 CONTINUE
      DARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
      DARG1=(DARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DRESLT=LANPDF(DARG1)
      TERM=REAL(DRESLT)/ZSCALE
      GOTO9000
C
 1413 CONTINUE
      DARG1=0.0D0
      DARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DRESLT=LANPPF(DARG1)
      TERM=ZLOC + ZSCALE*REAL(DRESLT)
      GOTO9000
C
 1414 CONTINUE
      DARG1=DBLE(X)
C
      DRESLT=LANXM1(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1415 CONTINUE
      DARG1=DBLE(X)
C
      DRESLT=LANXM2(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1416 CONTINUE
      DARG1=DBLE(X)
C
      DRESLT=LANDIF(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1421 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL IBCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1422 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL IBPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1423 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL IBPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1431 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ERRCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1432 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
      ARG1=(ARG1-ZLOC)/ZSCALE
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ERRPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1433 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,599)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ERRPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1441 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
C
      CALL TRACDF(ARG1,ARG2,ARG3,ARG4,ARG5,RESULT)
      TERM=RESULT
      GOTO9000
C
 1442 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
C
      CALL TRAPDF(ARG1,ARG2,ARG3,ARG4,ARG5,RESULT)
      TERM=RESULT
      GOTO9000
C
 1443 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
C
      CALL TRAPPF(ARG1,ARG2,ARG3,ARG4,ARG5,RESULT)
      TERM=RESULT
      GOTO9000
C
 1451 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ARG6=SAVE5
      ARG7=SAVE6
      ARG8=SAVE7
C
      CALL GTRCDF(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,ARG7,ARG8,RESULT)
      TERM=RESULT
      GOTO9000
C
 1452 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ARG6=SAVE5
      ARG7=SAVE6
      ARG8=SAVE7
C
      CALL GTRPDF(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,ARG7,ARG8,RESULT)
      TERM=RESULT
      GOTO9000
C
 1453 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ARG5=SAVE4
      ARG6=SAVE5
      ARG7=SAVE6
      ARG8=SAVE7
C
      CALL GTRPPF(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,ARG7,ARG8,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 2003.
 1461 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG2=INT(ARG2+0.5)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL FTCDF(ARG1,IARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1462 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG2=INT(ARG2+0.5)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL FTPDF(ARG1,IARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1463 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG2=INT(ARG2+0.5)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL FTPPF(ARG1,IARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 2003.
 1471 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL SNCDF(ARG1,ARG2,ISKNDF,RESULT)
      TERM=RESULT
      GOTO9000
C
 1472 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL SNPDF(ARG1,ARG2,ISKNDF,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1473 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL SNPPF(ARG1,ARG2,ISKNDF,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 2003.
 1481 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG2=INT(ARG2+0.5)
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL STCDF(ARG1,IARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1482 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG2=INT(ARG2+0.5)
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL STPDF(ARG1,IARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1483 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IARG2=INT(ARG2+0.5)
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL STPPF(ARG1,IARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER,   1995.
 1491 CONTINUE
      ARG1=X
      ARG2=SAVE1
CCCCC CALL ZIPCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1492 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL ZIPPDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1493 CONTINUE
      ARG1=X
      ARG2=SAVE1
CCCCC CALL ZIPPPF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED DECEMBER, 2003.
 1501 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IF(IMAKDF.EQ.'MEEK')THEN
        ARG1Z=ARG1/ARG2
        ARG2Z=ARG2
        ARG3Z=ARG3/ARG1
        ARG1=ARG1Z
        ARG2=ARG2Z
        ARG3=ARG3Z
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MAKCDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
 1502 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IF(IMAKDF.EQ.'MEEK')THEN
        ARG1Z=ARG1/ARG2
        ARG2Z=ARG2
        ARG3Z=ARG3/ARG1
        ARG1=ARG1Z
        ARG2=ARG2Z
        ARG3=ARG3Z
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MAKPDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1503 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IF(IMAKDF.EQ.'MEEK')THEN
        ARG1Z=ARG1/ARG2
        ARG2Z=ARG2
        ARG3Z=ARG3/ARG1
        ARG1=ARG1Z
        ARG2=ARG2Z
        ARG3=ARG3Z
      ENDIF
      CALL MAKPPF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1504 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IF(IMAKDF.EQ.'MEEK')THEN
        ARG1Z=ARG1/ARG2
        ARG2Z=ARG2
        ARG3Z=ARG3/ARG1
        ARG1=ARG1Z
        ARG2=ARG2Z
        ARG3=ARG3Z
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MAKHAZ(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1505 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      IF(IMAKDF.EQ.'MEEK')THEN
        ARG1Z=ARG1/ARG2
        ARG2Z=ARG2
        ARG3Z=ARG3/ARG1
        ARG1=ARG1Z
        ARG2=ARG2Z
        ARG3=ARG3Z
      ENDIF
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MAKCHA(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JULY, 2004.
 1506 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MA2CDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1507 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MA2PDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1508 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL MA2PPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1509 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MA2HAZ(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1510 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MA2CHA(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH, 2004.
 1511 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LSNCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1512 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LSNPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1513 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=1.0
      IF(SAVE2.NE.-99.9)ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LSNPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH, 2004.
 1521 CONTINUE
      ARG1=X
      IARG1=INT(SAVE1+0.5)
      ARG2=SAVE2
      ARG3=1.0
      IF(SAVE3.NE.-99.9)ARG3=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LSTCDF(ARG1,IARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1522 CONTINUE
      ARG1=X
      IARG1=INT(SAVE1+0.5)
      ARG2=SAVE2
      ARG3=1.0
      IF(SAVE3.NE.-99.9)ARG3=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL LSTPDF(ARG1,IARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1523 CONTINUE
      ARG1=X
      IARG1=INT(SAVE1+0.5)
      ARG2=SAVE2
      ARG3=1.0
      IF(SAVE3.NE.-99.9)ARG3=SAVE3
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL LSTPPF(ARG1,IARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
 1531 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      CALL HERCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1532 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      CALL HERPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1533 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      CALL HERPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED APRIL, 2004.
 1541 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
CCCCC CALL GWACDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
 1542 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      CALL GWAPDF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
 1543 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
CCCCC CALL GWAPPF(ARG1,ARG2,ARG3,ARG4,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 2003.
 1551 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL SDECDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1552 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL SDEPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1553 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL SDEPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JUNE 2004
 1561 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL ADECDF(ARG1,ARG2,IADEDF,RESULT)
      TERM=RESULT
      GOTO9000
C
 1562 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL ADEPDF(ARG1,ARG2,IADEDF,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1563 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ADEPPF(ARG1,ARG2,IADEDF,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JUNE 2004
 1571 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GALCDF(DARG1,DARG2,DARG3,IADEDF,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1572 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GALPDF(DARG1,DARG2,DARG3,IADEDF,DRESLT)
      TERM=REAL(DRESLT)/ZSCALE
      GOTO9000
C
 1573 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GALPPF(DARG1,DARG2,DARG3,IADEDF,DRESLT)
      TERM=ZLOC + ZSCALE*REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JUNE 2004
 1581 CONTINUE
      ARG1=X
      ARG2=1.0
      IF(SAVE1.NE.-99.9)ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MAXCDF(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
 1582 CONTINUE
      ARG1=X
      ARG2=1.0
      IF(SAVE1.NE.-99.9)ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL MAXPDF(ARG1,ARG2,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1583 CONTINUE
      ARG1=X
      ARG2=1.0
      IF(SAVE1.NE.-99.9)ARG2=SAVE1
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL MAXPPF(ARG1,ARG2,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JUNE 2004
 1591 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
CCCCC CALL FERCDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT
      GOTO9000
C
 1592 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
CCCCC CALL FERPDF(ARG1,ARG2,ARG3,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1593 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
CCCCC CALL FERPPF(ARG1,ARG2,ARG3,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED JUNE 2004
 1601 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL RAYCDF(ARG1,RESULT)
      TERM=RESULT
      GOTO9000
C
 1602 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      ARG1=(ARG1-ZLOC)/ZSCALE
      CALL RAYPDF(ARG1,RESULT)
      TERM=RESULT/ZSCALE
      GOTO9000
C
 1603 CONTINUE
      ARG1=X
      ZLOC=0.0
      IF(SAVE1.NE.-99.9)ZLOC=SAVE1
      ZSCALE=1.0
      IF(SAVE2.NE.-99.9)ZSCALE=SAVE2
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL RAYPPF(ARG1,RESULT)
      TERM=ZLOC + ZSCALE*RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED AUGUST 2004
 1611 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GIGCDF(DARG1,DARG2,DARG3,DARG4,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1612 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GIGPDF(DARG1,DARG2,DARG3,DARG4,DRESLT)
      TERM=REAL(DRESLT)/ZSCALE
      GOTO9000
C
 1613 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GIGPPF(DARG1,DARG2,DARG3,DARG4,DRESLT)
      TERM=ZLOC + ZSCALE*REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED AUGUST 2004
 1621 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL BEICDF(DARG1,DARG2,DARG3,DARG4,IBEIDF,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1622 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL BEIPDF(DARG1,DARG2,DARG3,DARG4,IBEIDF,DRESLT)
      TERM=REAL(DRESLT)/ZSCALE
      GOTO9000
C
 1623 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL BEIPPF(DARG1,DARG2,DARG3,DARG4,IBEIDF,DRESLT)
      TERM=ZLOC + ZSCALE*REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED AUGUST 2004
 1631 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
CCCCC CALL BEKCDF(DARG1,DARG2,DARG3,DARG4,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1632 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
CCCCC CALL BEKPDF(DARG1,DARG2,DARG3,DARG4,DRESLT)
      TERM=REAL(DRESLT)/ZSCALE
      GOTO9000
C
 1633 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      ZLOC=0.0
      IF(SAVE4.NE.-99.9)ZLOC=SAVE4
      ZSCALE=1.0
      IF(SAVE5.NE.-99.9)ZSCALE=SAVE5
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
CCCCC CALL BEKPPF(DARG1,DARG2,DARG3,DARG4,DRESLT)
      TERM=ZLOC + ZSCALE*REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED AUGUST 2004
 1641 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL MCLCDF(DARG1,DARG2,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1642 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL MCLPDF(DARG1,DARG2,DRESLT)
      TERM=REAL(DRESLT)/ZSCALE
      GOTO9000
C
 1643 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL MCLPPF(DARG1,DARG2,DRESLT)
      TERM=ZLOC + ZSCALE*REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2004
 1651 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GMCCDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1652 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GMCPDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT)/ZSCALE
      GOTO9000
C
 1653 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GMCPPF(DARG1,DARG2,DARG3,DRESLT)
      TERM=ZLOC + ZSCALE*REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2004
 1661 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL HBOCDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1662 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL HBOPDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT)/ZSCALE
      GOTO9000
C
 1663 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
CCCCC CALL HBOPPF(DARG1,DARG2,DARG3,DRESLT)
      TERM=ZLOC + ZSCALE*REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED FEBRUARY 2006
 1671 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=0.0D0
      IF(SAVE2.NE.-99.9)DARG3=DBLE(SAVE2)
      DARG4=1.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
C
      XPAR(1)=DARG3
      XPAR(2)=DARG4
      XPAR(3)=DARG2
      DRESLT=CDFGLO(DARG1,XPAR)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1672 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=0.0D0
      IF(SAVE2.NE.-99.9)DARG3=DBLE(SAVE2)
      DARG4=1.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
C
      IF(DARG4.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DARG3)/DARG4
      CALL GL5PDF(DARG1,DARG2,DRESLT)
      TERM=REAL(DRESLT/DARG4)
      GOTO9000
C
 1673 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=0.0D0
      IF(SAVE2.NE.-99.9)DARG3=DBLE(SAVE2)
      DARG4=1.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
C
      XPAR(1)=DARG3
      XPAR(2)=DARG4
      XPAR(3)=DARG2
      DRESLT=QUAGLO(DARG1,XPAR)
      TERM=REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED FEBRUARY 2006
 1681 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      DARG5=0.0D0
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
      DARG6=1.0D0
      IF(SAVE5.NE.-99.9)DARG6=DBLE(SAVE5)
C
      XPAR(1)=DARG5
      XPAR(2)=DARG6
      XPAR(3)=DARG2
      XPAR(4)=DARG3
      XPAR(5)=DARG4
      DRESLT=CDFWAK(DARG1,XPAR)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1682 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      DARG5=0.0D0
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
      DARG6=1.0D0
      IF(SAVE5.NE.-99.9)DARG6=DBLE(SAVE5)
C
      XPAR(1)=DARG5
      XPAR(2)=DARG6
      XPAR(3)=DARG2
      XPAR(4)=DARG3
      XPAR(5)=DARG4
CCCCC DRESLT=CDFGLO(DARG1,XPAR)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1683 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=DBLE(SAVE3)
      DARG5=0.0D0
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
      DARG6=1.0D0
      IF(SAVE5.NE.-99.9)DARG6=DBLE(SAVE5)
C
      XPAR(1)=DARG5
      XPAR(2)=DARG6
      XPAR(3)=DARG2
      XPAR(4)=DARG3
      XPAR(5)=DARG4
      DRESLT=QUAWAK(DARG1,XPAR)
      TERM=REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH 2006
 1691 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=0.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
      DARG5=1.0D0
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DARG4)/DARG5
      CALL BNOCDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1692 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=0.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
      DARG5=1.0D0
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DARG4)/DARG5
      CALL BNOPDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT/DARG5)
      GOTO9000
C
 1693 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=0.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
      DARG5=1.0D0
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL BNOPPF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DARG4 + DARG5*DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH  2006.
 1701 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GL2CDF(DARG1,DARG2,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1702 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GL2PDF(DARG1,DARG2,DRESLT)
      TERM=REAL(DRESLT/DBLE(ZSCALE))
      GOTO9000
C
 1703 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GL2PPF(DARG1,DARG2,DRESLT)
      DRESLT=DBLE(ZLOC) + DBLE(ZSCALE)*DRESLT
      TERM=REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH  2006.
 1711 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GL3CDF(DARG1,DARG2,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1712 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GL3PDF(DARG1,DARG2,DRESLT)
      TERM=REAL(DRESLT/DBLE(ZSCALE))
      GOTO9000
C
 1713 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      ZLOC=0.0
      IF(SAVE2.NE.-99.9)ZLOC=SAVE2
      ZSCALE=1.0
      IF(SAVE3.NE.-99.9)ZSCALE=SAVE3
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GL3PPF(DARG1,DARG2,DRESLT)
      DRESLT=DBLE(ZLOC) + DBLE(ZSCALE)*DRESLT
      TERM=REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH  2006.
 1721 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GL4CDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1722 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DBLE(ZLOC))/DBLE(ZSCALE)
      CALL GL4PDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT/DBLE(ZSCALE))
      GOTO9000
C
 1723 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      ZLOC=0.0
      IF(SAVE3.NE.-99.9)ZLOC=SAVE3
      ZSCALE=1.0
      IF(SAVE4.NE.-99.9)ZSCALE=SAVE4
C
      IF(ZSCALE.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL GL4PPF(DARG1,DARG2,DARG3,DRESLT)
      DRESLT=DBLE(ZLOC) + DBLE(ZSCALE)*DRESLT
      TERM=REAL(DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED MARCH 2006
 1731 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=0.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
      DARG5=1.0D0
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DARG4)/DARG5
      CALL ALDCDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT)
      GOTO9000
C
 1732 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=0.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
      DARG5=1.0D0
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      DARG1=(DARG1-DARG4)/DARG5
      CALL ALDPDF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DRESLT/DARG5)
      GOTO9000
C
 1733 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
      DARG3=DBLE(SAVE2)
      DARG4=0.0D0
      IF(SAVE3.NE.-99.9)DARG4=DBLE(SAVE3)
      DARG5=1.0D0
      IF(SAVE4.NE.-99.9)DARG5=DBLE(SAVE4)
C
      IF(DARG5.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,769)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
C
      CALL ALDPPF(DARG1,DARG2,DARG3,DRESLT)
      TERM=REAL(DARG4 + DARG5*DRESLT)
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2000 CONTINUE
      DARG1=DBLE(X)
      IARG2=1
      RESULT=DFRENC(DARG1,IARG2)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2010 CONTINUE
      DARG1=DBLE(X)
      IARG2=2
      RESULT=DFRENC(DARG1,IARG2)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2020 CONTINUE
      DARG1=DBLE(X)
      IARG2=3
      RESULT=DFRENC(DARG1,IARG2)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2030 CONTINUE
      DARG1=DBLE(X)
      IARG2=4
      RESULT=DFRENC(DARG1,IARG2)
      TERM=RESULT
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2100 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(PEQ(Z1))
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2105 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=AIMAG(PEQ(Z1))
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2110 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(PEQ1(Z1))
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2115 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=AIMAG(PEQ1(Z1))
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2120 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(PLEM(Z1))
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2125 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=AIMAG(PLEM(Z1))
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2130 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(PLEM1(Z1))
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2135 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=AIMAG(PLEM1(Z1))
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2200 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL JACELL(ARG1,ARG2,RESLT1,RESLT2,RESLT3)
      TERM=RESLT1
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2210 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL JACELL(ARG1,ARG2,RESLT1,RESLT2,RESLT3)
      TERM=RESLT2
      GOTO9000
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER, 1994.
 2220 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL JACELL(ARG1,ARG2,RESLT1,RESLT2,RESLT3)
      TERM=RESLT3
      GOTO9000
C
 5000 CONTINUE
      ARG=X
      TERM=C00
      GOTO9000
C
 5010 CONTINUE
      ARG=X
      TERM=(C11*ARG)
      GOTO9000
C
 5020 CONTINUE
      ARG=X
      TERM=(C22*ARG**2)+C20
      GOTO9000
C
 5030 CONTINUE
      ARG=X
      TERM=(C33*ARG**3)+(C31*ARG)
      GOTO9000
C
 5040 CONTINUE
      ARG=X
      TERM=(C44*ARG**4)+(C42*ARG**2)+C40
      GOTO9000
C
 5050 CONTINUE
      ARG=X
      TERM=(C55*ARG**5)+(C53*ARG**3)+(C51*ARG)
      GOTO9000
C
 5060 CONTINUE
      ARG=X
      TERM=(C66*ARG**6)+(C64*ARG**4)+(C62*ARG**2)+C60
      GOTO9000
C
 5070 CONTINUE
      ARG=X
      TERM=(C77*ARG**7)+(C75*ARG**5)+(C73*ARG**3)+(C71*ARG)
      GOTO9000
C
 5080 CONTINUE
      ARG=X
      TERM=(C88*ARG**8)+(C86*ARG**6)+(C84*ARG**4)+(C82*ARG**2)
     1            +C80
      GOTO9000
C
 5090 CONTINUE
      ARG=X
      TERM=(C99*ARG**9)+(C97*ARG**7)+(C95*ARG**5)+(C93*ARG**3)
     1            +(C91*ARG)
      GOTO9000
C
 5100 CONTINUE
      ARG=X
      TERM=(C1010*ARG**10)+(C108*ARG**8)+(C106*ARG**6)
     1            +(C104*ARG**4)+(C102*ARG**2)+C100
      GOTO9000
C
CCCCC JULY 1995.  ADD CHEBCHEV T POLYNOMIAL
 5110 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL CHEBT(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC JULY 1995.  ADD CHEBCHEV U POLYNOMIAL
 5120 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL CHEBU(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC JULY 1995.  ADD NORMALIZED LAGUERRE POLYNOMIAL
 5130 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL NRMLAG(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC JULY 1995.  ADD JACOBI POLYNOMIAL
 5140 CONTINUE
      DARG1=DBLE(X)
      IARG1=INT(SAVE1+0.5)
      DARG2=DBLE(SAVE2)
      DARG3=DBLE(SAVE3)
C
C  NOTE THAT JACOBP RETURNS DERIVATIVE AND RELATIVE OR ABSOLUTE
C  ERROR TERMS.  AT THIS POINT, DATAPLOT DOESN'T MAKE USE OF THIS
C  INFORMATION.  HOWEVER, LEAVE OUTPUT ARGUMENTS IN CASE WE DECIDE
C  TO IMPLEMENT SOME THINGS LATER.
C
      CALL JACOBP(IARG1,DARG2,DARG3,DARG1,DRESLT,DRSLT2,
     1E,ED,IOUT1,IOUT2)
      TERM=SNGL(DRESLT)
      GOTO9000
C
CCCCC JULY 1995.  ADD ULTRASPHERICAL (OR GEGENBAUER) POLYNOMIAL
 5150 CONTINUE
      DARG1=DBLE(X)
      IARG1=INT(SAVE1+0.5)
      DARG2=DBLE(SAVE2-0.5)
      DARG3=DBLE(SAVE2-0.5)
C
C  NOTE THAT JACOBP RETURNS DERIVATIVE AND RELATIVE OR ABSOLUTE
C  ERROR TERMS.  AT THIS POINT, DATAPLOT DOESN'T MAKE USE OF THIS
C  INFORMATION.  HOWEVER, LEAVE OUTPUT ARGUMENTS IN CASE WE DECIDE
C  TO IMPLEMENT SOME THINGS LATER.
C
      CALL JACOBP(IARG1,DARG2,DARG3,DARG1,DRESLT,DRSLT2,
     1E,ED,IOUT1,IOUT2)
C
      DTERM1=DGAMMA(DBLE(SAVE2+0.5))
      DTERM2=DGAMMA(DBLE(2.*SAVE2+REAL(IARG1)))
      DTERM3=DGAMR(DBLE(2.0*SAVE2))
      DTERM4=DGAMR(DBLE(SAVE2+REAL(IARG1)+0.5))
      DTERM5=DTERM1*DTERM2*DTERM3*DTERM4
      DTERM5=DTERM5*DRESLT
C
      TERM=SNGL(DTERM5)
      GOTO9000
C
CCCCC JULY 1995.  ADD GENERALIZED LAGUERRE POLYNOMIAL
 5160 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      CALL LAGUEL(ARG1,ARG2,ARG3,'NONO',RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC JULY 1995.  ADD NORMALIZED GENERALIZED LAGUERRE POLYNOMIAL
 5170 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      CALL LAGUEL(ARG1,ARG2,ARG3,'NORM',RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC JULY 1995.  ADD LEGENDRE POLYNOMIAL (NORMALIZED)
CCCCC NOTE THAT IN THIS CASE THE INPUT IS THETA (I.E., THE
CCCCC ANGLE) RATHER THAN X.  THIS IS BECAUSE USING THETA GIVES
CCCCC BETTER ACCURACY.
 5180 CONTINUE
      DARG1=DBLE(X)
      IF(IANGLU.EQ.'DEGR')DARG1=DARG1*DPI/180.D0
C
      IF(DARG1.LT.-DPI .OR. DARG1.GT.DPI)THEN
        WRITE(ICOUT,5181)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5182)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
      ISWTCH=0.0
      IF(DARG1.GT.(DPI/2.D0))ISWTCH=1
      IF(ISWTCH.EQ.1)DARG1=DPI-DARG1
 5181 FORMAT('***** ERROR FOR NRMLEG.  THE FIRST INPUT ARGUMENT IS ',
     1'OUTSIDE THE ALLOWABLE (-PI,PI) INTERVAL.')
 5182 FORMAT('      IT HAS THE VALUE ',E15.7)
      IARG1=INT(SAVE1+0.5)
      IF(IARG1.LT.0)THEN
        WRITE(ICOUT,5183)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5184)IARG1
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5183 FORMAT('***** ERROR FOR NRMLEG.  THE SECOND INPUT ARGUMENT IS ',
     1'NEGATIVE.')
 5184 FORMAT('      IT HAS THE VALUE ',I15)
C
      IARG2=0
      IARG3=2
      CALL DXNRMP(IARG1,IARG2,IARG2,DARG1,IARG3,DPN,IPN,ISIG,IERR2)
      IF(ISWTCH.EQ.1)DPN(1)=DPN(1)*(-1.D0)**(IARG1+IARG2)
      TERM=0.0
      IF(IERR2.EQ.0)THEN
        DRESLT=DPN(1)
        IF(IPN(1).EQ.0)THEN
          IF(ABS(DRESLT).GT.DBLE(R1MACH(2)))THEN
            IF(DRESLT.GE.0.D0)TERM=R1MACH(2)
            IF(DRESLT.LT.0.D0)TERM=-R1MACH(2)
          ELSE
            TERM=SNGL(DRESLT)
          ENDIF
        ELSE
          IF(IPN(1).GT.0)THEN
            TERM=R1MACH(2)
            WRITE(ICOUT,5185)
            CALL DPWRST('XXX','BUG ')
          ELSE
            TERM=0.
            WRITE(ICOUT,5189)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
      ELSEIF(IERR2.EQ.212 .OR. IERR2.EQ.213)THEN
        TERM=0.0
        WRITE(ICOUT,5186)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IERR2.GE.201.AND.IERR2.LE.204)THEN
        TERM=0.0
        WRITE(ICOUT,5187)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,5188)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
      GOTO9000
 5185 FORMAT('***** WARNING FROM NRMLEG.  CALCULATED VALUE OUTSIDE ',
     1'VALID MACHINE RANGE.  VALUE SET TO MACHINE MAXIMUM.')
 5186 FORMAT('***** ERROR FROM NRMLEG.  INVALID INPUT.')
 5187 FORMAT('***** ERROR FROM NRMLEG.  INVALID DXSET, CONTACT YOUR ',
     1'LOCAL SITE INSTALLER.')
 5188 FORMAT('***** ERROR FROM NRMLEG.  UNABLE TO PERFORM THE ',
     1'CALCULATIONS CORRECTLY, OUTPUT SET TO ZERO.')
 5189 FORMAT('***** WARNING FROM NRMLEG.  CALCULATED VALUE OUTSIDE ',
     1'VALID MACHINE RANGE.  VALUE SET TO 0.')
C
CCCCC JULY 1995.  ADD ASSOCIATED LEGENDRE POLYNOMIAL (NORMALIZED)
CCCCC NOTE THAT IN THIS CASE THE INPUT IS THEATA (I.E., THE
CCCCC ANGLE) RATHER THAN X.  THIS IS BECAUSE USING THETA GIVES
CCCCC BETTER ACCURACY.
 5200 CONTINUE
      DARG1=DBLE(X)
      IF(IANGLU.EQ.'DEGR')DARG1=DARG1*DPI/180.D0
C
      IF(DARG1.LT.-DPI.OR.DARG1.GT.DPI)THEN
        WRITE(ICOUT,5201)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5202)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5201 FORMAT('***** ERROR FOR NRMLEG.  THE FIRST INPUT ARGUMENT IS ',
     1'OUTSIDE THE ALLOWABLE (-DPI,DPI) INTERVAL.')
 5202 FORMAT('      IT HAS THE VALUE ',E15.7)
      ISWTCH=0.0
      IF(DARG1.GT.(DPI/2.D0))ISWTCH=1
      IF(ISWTCH.EQ.1)DARG1=DPI-DARG1
C
      IARG1=INT(SAVE1+0.5)
      IF(IARG1.LT.0)THEN
        WRITE(ICOUT,5203)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5204)IARG1
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5203 FORMAT('***** ERROR FOR NRMLEG.  THE SECOND INPUT ARGUMENT IS ',
     1'NEGATIVE.')
 5204 FORMAT('      IT HAS THE VALUE ',I15)
C
      IARG2=INT(SAVE2+0.5)
      IF(IARG2.LT.0)THEN
        WRITE(ICOUT,5213)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5204)IARG1
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5213 FORMAT('***** ERROR FOR NRMLEG.  THE THIRD INPUT ARGUMENT IS ',
     1'NEGATIVE.')
      IARG3=IARG2
      IARG4=2
      CALL DXNRMP(IARG1,IARG2,IARG3,DARG1,IARG4,DPN,IPN,ISIG,IERR2)
      IF(ISWTCH.EQ.1)DPN(1)=DPN(1)*(-1.D0)**(IARG1+IARG2)
      TERM=0.0
      IF(IERR2.EQ.0)THEN
        DRESLT=DPN(1)
        IF(IPN(1).EQ.0)THEN
          IF(ABS(DRESLT).GT.DBLE(R1MACH(2)))THEN
            IF(DRESLT.GE.0.D0)TERM=R1MACH(2)
            IF(DRESLT.LT.0.D0)TERM=-R1MACH(2)
          ELSE
            TERM=SNGL(DRESLT)
          ENDIF
        ELSE
          IF(IPN(1).GT.0)THEN
            TERM=R1MACH(2)
            WRITE(ICOUT,5205)
            CALL DPWRST('XXX','BUG ')
          ELSE
            TERM=0.
            WRITE(ICOUT,5209)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
      ELSEIF(IERR2.EQ.212 .OR. IERR2.EQ.213)THEN
        TERM=0.0
        WRITE(ICOUT,5206)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IERR2.GE.201.AND.IERR2.LE.204)THEN
        TERM=0.0
        WRITE(ICOUT,5207)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,5208)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
      GOTO9000
 5205 FORMAT('***** WARNING FROM NRMLEG.  CALCULATED VALUE OUTSIDE ',
     1'VALID MACHINE RANGE.  VALUE SET TO MACHINE MAXIMUM.')
 5206 FORMAT('***** ERROR FROM NRMLEG.  INVALID INPUT.')
 5207 FORMAT('***** ERROR FROM NRMLEG.  INVALID DXSET, CONTACT YOUR',
     1' LOCAL SITE INSTALLER.')
 5208 FORMAT('***** ERROR FROM NRMLEG.  UNABLE TO PERFORM THE ',
     1'CALCULATIONS CORRECTLY, OUTOUT SET TO ZERO.')
 5209 FORMAT('***** WARNING FROM NRMLEG.  CALCULATED VALUE OUTSIDE ',
     1'VALID MACHINE RANGE.  VALUE SET TO 0.')
C
CCCCC JULY 1995.  ADD ASSOCIATED LEGENDRE FUNCTION OF THE FIRST KIND.
CCCCC REDUCES TO LEGENDRE FUNCTION OF FIRST KIND IF M NOT SPECIFIED
CCCCC (OR IS EQUAL TO ZERO).
CCCCC NOTE THAT IN THIS CASE THE INPUT IS THEATA (I.E., THE
CCCCC ANGLE) RATHER THAN X.  THIS IS BECAUSE USING THETA GIVES
CCCCC BETTER ACCURACY.
 5220 CONTINUE
      DARG1=DBLE(X)
      IF(IANGLU.EQ.'DEGR')DARG1=DARG1*DPI/180.D0
C
      IF(DARG1.LT.0.D0.OR.DARG1.GE.DPI/2.0D0)THEN
        WRITE(ICOUT,5221)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5222)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5221 FORMAT('***** ERROR FOR LEGP.  THE FIRST INPUT ARGUMENT IS ',
     1'OUTSIDE THE ALLOWABLE (0,PI/2) INTERVAL.')
 5222 FORMAT('      IT HAS THE VALUE ',E15.7)
C
      DARG2=DBLE(SAVE1)
      IF(DARG2.LT.-0.5D0)THEN
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5224)DARG2
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5223 FORMAT('***** ERROR FOR LEGP.  THE SECOND INPUT ARGUMENT IS ',
     1'LESS THAN -0.5.')
 5224 FORMAT('      IT HAS THE VALUE ',I15)
C
      IF(SAVE2.EQ.-99.9)THEN
        IARG2=0
      ELSE
        IARG2=INT(SAVE2+0.5)
      ENDIF
      IARG1=0
      IARG3=IARG2
      IARG4=3
      IF(DARG2.LT.0.D0)IARG4=1
      IF(IARG2.LT.0)THEN
        IARG2=-IARG2
        IARG3=IARG2
        IARG4=1
      ENDIF
      CALL DXLEGF(DARG2,IARG1,IARG2,IARG3,DARG1,IARG4,DPN,IPN,IERR2)
      TERM=0.0
      IF(IERR2.EQ.0)THEN
        DRESLT=DPN(1)
        IF(IPN(1).EQ.0)THEN
          IF(DRESLT.GT.R1MACH(2))TERM=R1MACH(2)
          IF(DRESLT.LE.R1MACH(2))TERM=SNGL(DRESLT)
        ELSE
          TERM=R1MACH(2)
          WRITE(ICOUT,5225)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ELSEIF(IERR2.EQ.212 .OR. IERR2.EQ.213)THEN
        TERM=0.0
        WRITE(ICOUT,5226)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IERR2.GE.201.AND.IERR2.LE.204)THEN
        TERM=0.0
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,5228)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
      GOTO9000
 5225 FORMAT('***** WARNING FROM LEGP.  CALCULATED VALUE OUTSIDE ',
     1'VALID MACHINE RANGE.  VALUE SET TO MACHINE MAXIMUM.')
 5226 FORMAT('***** ERROR FROM LEGP.  INVALID INPUT.')
 5227 FORMAT('***** ERROR FROM LEGP.  INVALID DXSET, CONTACT YOUR ',
     1'LOCAL SITE INSTALLER.')
 5228 FORMAT('***** ERROR FROM LEGP.  UNABLE TO PERFORM THE ',
     1'CALCULATIONS CORRECTLY, OUTOUT SET TO ZERO.')
C
CCCCC JULY 1995.  ADD ASSOCIATED LEGENDRE FUNCTION OF THE SECOND KIND.
CCCCC REDUCES TO LEGENDRE FUNCTION OF FIRST KIND IF M NOT SPECIFIED
CCCCC (OR IS EQUAL TO ZERO).
CCCCC NOTE THAT IN THIS CASE THE INPUT IS THEATA (I.E., THE
CCCCC ANGLE) RATHER THAN X.  THIS IS BECAUSE USING THETA GIVES
CCCCC BETTER ACCURACY.
 5240 CONTINUE
      DARG1=DBLE(X)
      IF(IANGLU.EQ.'DEGR')DARG1=DARG1*DPI/180.D0
C
      IF(DARG1.LE.0.D0.OR.DARG1.GE.DPI/2.D0)THEN
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5242)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5241 FORMAT('***** ERROR FOR LEGQ.  THE FIRST INPUT ARGUMENT IS ',
     1'OUTSIDE THE ALLOWABLE (0,PI/2) INTERVAL.')
 5242 FORMAT('      IT HAS THE VALUE ',E15.7)
C
      DARG2=DBLE(SAVE1)
      IF(DARG2.LT.-0.5D0)THEN
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5244)DARG2
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5243 FORMAT('***** ERROR FOR LEGQ.  THE SECOND INPUT ARGUMENT IS ',
     1'LESS THAN -0.5.')
 5244 FORMAT('      IT HAS THE VALUE ',I15)
C
      IF(SAVE2.EQ.-99.9)THEN
        IARG2=0
      ELSE
        IARG2=INT(SAVE2+0.5)
      ENDIF
      IF(IARG2.LT.0)THEN
        WRITE(ICOUT,5253)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5254)SAVE2
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5253 FORMAT('***** ERROR FOR LEGQ.  THE THIRD INPUT ARGUMENT IS ',
     1'NEGATIVE.')
 5254 FORMAT('      IT HAS THE VALUE ',E15.7)
C
      IARG1=0
      IARG3=IARG2
      IARG4=2
      CALL DXLEGF(DARG2,IARG1,IARG2,IARG3,DARG1,IARG4,DPN,IPN,IERR2)
      TERM=0.0
      IF(IERR2.EQ.0)THEN
        DRESLT=DPN(1)
        IF(IPN(1).EQ.0)THEN
          IF(DRESLT.GT.R1MACH(2))TERM=R1MACH(2)
          IF(DRESLT.LE.R1MACH(2))TERM=SNGL(DRESLT)
        ELSE
          TERM=R1MACH(2)
          WRITE(ICOUT,5245)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ELSEIF(IERR2.EQ.212 .OR. IERR2.EQ.213)THEN
        TERM=0.0
        WRITE(ICOUT,5246)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IERR2.GE.201.AND.IERR2.LE.204)THEN
        TERM=0.0
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,5248)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
      GOTO9000
 5245 FORMAT('***** WARNING FROM LEGQ.  CALCULATED VALUE OUTSIDE ',
     1'VALID MACHINE RANGE.  VALUE SET TO MACHINE MAXIMUM.')
 5246 FORMAT('***** ERROR FROM LEGQ.  INVALID INPUT.')
 5247 FORMAT('***** ERROR FROM LEGQ.  INVALID DXSET, CONTACT YOUR ',
     1'LOCAL SITE INSTALLER.')
 5248 FORMAT('***** ERROR FROM LEGQ.  UNABLE TO PERFORM THE ',
     1'CALCULATIONS CORRECTLY, OUTOUT SET TO ZERO.')
C
CCCCC JULY 1995.  ADD ASSOCIATED LEGENDRE POLYNOMIAL OF THE FIRST KIND.
CCCCC REDUCES TO LEGENDRE POLYNOMIAL OF FIRST KIND IF M NOT SPECIFIED
CCCCC (OR IS EQUAL TO ZERO).  THIS IS THE UNNORMALIZED CASE.
CCCCC NOTE THAT IN THIS CASE THE INPUT IS THEATA (I.E., THE
CCCCC ANGLE) RATHER THAN X.  THIS IS BECAUSE USING THETA GIVES
CCCCC BETTER ACCURACY.
 5280 CONTINUE
      DARG1=DBLE(X)
      IF(IANGLU.EQ.'DEGR')DARG1=DARG1*DPI/180.D0
C
      IF(DARG1.LE.-DPI.OR.DARG1.GE.DPI)THEN
        WRITE(ICOUT,5281)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5282)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5281 FORMAT('***** ERROR FOR LEGENDRE.  THE FIRST INPUT ARGUMENT IS ',
     1'OUTSIDE THE ALLOWABLE (-PI,PI) INTERVAL.')
 5282 FORMAT('      IT HAS THE VALUE ',E15.7)
      ISWTCH=0.0
      IF(DARG1.GT.(DPI/2.D0))ISWTCH=1
      IF(ISWTCH.EQ.1)DARG1=DPI-DARG1
C
      ITEMP=INT(SAVE1+0.5)
      DARG2=DBLE(ITEMP)
      IF(DARG2.LT.-0.1D0)THEN
        WRITE(ICOUT,5283)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5284)DARG2
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5283 FORMAT('***** ERROR FOR LEGENDRE.  THE SECOND INPUT ARGUMENT IS',
     1' NEGATIVE.')
 5284 FORMAT('      IT HAS THE VALUE ',I15)
C
      IF(SAVE2.EQ.-99.9)THEN
        IARG2=0
      ELSE
        IARG2=INT(SAVE2+0.5)
      ENDIF
      IARG1=0
      IARG3=IARG2
      IARG4=3
      CALL DXLEGF(DARG2,IARG1,IARG2,IARG3,DARG1,IARG4,DPN,IPN,IERR2)
      IF(ISWTCH.EQ.1)DPN(1)=DPN(1)*(-1.D0)**(INT(DARG2)+IARG2)
      TERM=0.0
      IF(IERR2.EQ.0)THEN
        DRESLT=DPN(1)
        IF(IPN(1).EQ.0)THEN
          IF(DRESLT.GT.R1MACH(2))TERM=R1MACH(2)
          IF(DRESLT.LE.R1MACH(2))TERM=SNGL(DRESLT)
        ELSE
          TERM=R1MACH(2)
          WRITE(ICOUT,5285)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ELSEIF(IERR2.EQ.212 .OR. IERR2.EQ.213)THEN
        TERM=0.0
        WRITE(ICOUT,5286)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IERR2.GE.201.AND.IERR2.LE.204)THEN
        TERM=0.0
        WRITE(ICOUT,5287)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,5288)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
      GOTO9000
 5285 FORMAT('***** WARNING FROM LEGENDRE.  CALCULATED VALUE OUTSIDE ',
     1'VALID MACHINE RANGE.  VALUE SET TO MACHINE MAXIMUM.')
 5286 FORMAT('***** ERROR FROM LEGENDRE.  INVALID INPUT.')
 5287 FORMAT('***** ERROR FROM LEGENDRE.  INVALID DXSET, CONTACT YOUR',
     1' LOCAL SITE INSTALLER.')
 5288 FORMAT('***** ERROR FROM LEGENDRE.  UNABLE TO PERFORM THE ',
     1'CALCULATIONS CORRECTLY, OUTOUT SET TO ZERO.')
C
CCCCC JULY 1995.  ADD SHPERICAL HARMONICS.  BASED ON ASSOCIATED
CCCCC LEGENDRE POLYNOMIALS.
 5300 CONTINUE
      DARG1=DBLE(X)
      IF(IANGLU.EQ.'DEGR')DARG1=DARG1*DPI/180.D0
C
      IF(DARG1.LT.-DPI.OR.DARG1.GT.DPI)THEN
        WRITE(ICOUT,5301)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5302)X
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5301 FORMAT('***** ERROR FOR SPHRHRMR.  THE FIRST INPUT ARGUMENT IS ',
     1'OUTSIDE THE ALLOWABLE (-DPI,DPI) INTERVAL.')
 5302 FORMAT('      IT HAS THE VALUE ',E15.7)
      DARG2=DBLE(SAVE1)
      IF(IANGLU.EQ.'DEGR')DARG2=DARG2*DPI/180.D0
C
      IF(DARG2.LT.0.OR.DARG2.GT.2.0D0*DPI)THEN
        WRITE(ICOUT,5311)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5302)SAVE1
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5311 FORMAT('***** ERROR FOR SPHRHRMR.  THE SECOND INPUT ARGUMENT IS',
     1' OUTSIDE THE ALLOWABLE (0,2*PI) INTERVAL.')
C
      IARG1=INT(SAVE2+0.5)
      IF(IARG1.LT.0)THEN
        WRITE(ICOUT,5303)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5304)IARG1
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5303 FORMAT('***** ERROR FOR SPHRHRM.  THE THIRD INPUT ARGUMENT IS',
     1' NEGATIVE.')
 5304 FORMAT('      IT HAS THE VALUE ',I15)
C
      IARG2=INT(SAVE3+0.5)
      IF(ABS(IARG2).GT.IARG1)THEN
        WRITE(ICOUT,5313)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5314)IARG1,IARG2
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 5313 FORMAT('***** ERROR FOR SPHRHRM.  THE FOURTH INPUT ARGUMENT IS ',
     1'LARGER THAN THE THIRD ARGUMENT.')
 5314 FORMAT('      THEY HAVE THE VALUES: ',I15,1X,I15)
      IF(IARG2.LT.0)THEN
        ISWTCH=1
        IARG2=-IARG2
      ELSE
        ISWTCH=0
      ENDIF
      IARG3=IARG2
      IARG4=2
      CALL DXNRMP(IARG1,IARG2,IARG3,DARG1,IARG4,DPN,IPN,ISIG,IERR2)
C
      TERM=0.0
C
      IF(IERR2.EQ.0)THEN
        IF(IPN(1).EQ.0)THEN
          IF(ABS(DRESLT).GT.DBLE(R1MACH(2)))THEN
            IF(DRESLT.GE.0.D0)TERM=R1MACH(2)
            IF(DRESLT.LT.0.D0)TERM=-R1MACH(2)
          ELSE
            DTERM1=(-1.D0)**IARG2*DSQRT(1.0D0/(2.D0*DPI))
            DRESLT=DTERM1*DPN(1)
            DTERM1=DBLE(IARG2)*DARG2
            IF(ISJUNK.EQ.0)THEN
              DTERM2=DRESLT*DCOS(DTERM1)
              TERM=REAL(DTERM2)
            ELSE
              DTERM2=DRESLT*DSIN(DTERM1)
              TERM=REAL(DTERM2)
            ENDIF
            IF(ISWTCH.EQ.1)TERM=(-1.**IARG2)*TERM
          ENDIF
        ELSE
          IF(IPN(1).GT.0)THEN
            TERM=R1MACH(2)
            WRITE(ICOUT,5305)
            CALL DPWRST('XXX','BUG ')
          ELSE
            TERM=0.
            WRITE(ICOUT,5309)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
      ELSEIF(IERR2.EQ.212 .OR. IERR2.EQ.213)THEN
        TERM=0.0
        WRITE(ICOUT,5306)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IERR2.GE.201.AND.IERR2.LE.204)THEN
        TERM=0.0
        WRITE(ICOUT,5307)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,5308)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
      ENDIF
      GOTO9000
 5305 FORMAT('***** WARNING FROM SPHRHRM.  CALCULATED VALUE OUTSIDE ',
     1'VALID MACHINE RANGE.  VALUE SET TO MACHINE MAXIMUM.')
 5306 FORMAT('***** ERROR FROM SPHRHRM.  INVALID INPUT.')
 5307 FORMAT('***** ERROR FROM SPHRHRM.  INVALID DXSET, CONTACT YOUR',
     1' LOCAL SITE INSTALLER.')
 5308 FORMAT('***** ERROR FROM SPHRHRM.  UNABLE TO PERFORM THE ',
     1'CALCULATIONS CORRECTLY, OUTOUT SET TO ZERO.')
 5309 FORMAT('***** WARNING FROM SPHRHRM.  CALCULATED VALUE OUTSIDE ',
     1'VALID MACHINE RANGE.  VALUE SET TO 0.')
C
CCCCC USE SLATEC ROUTINE SINCE IT HANDLES ANY REAL X (NOT LIMITED TO
CCCCC (-3,INF).
 6000 CONTINUE
      ARG=X
      RESULT=BESJ0(X)
      TERM=RESULT
CCCCC IF(-3.0.LE.ARG.AND.ARG.LE.3.0)GOTO6001
CCCCC IF(3.0.LE.ARG)GOTO6002
CCCCC WRITE(ICOUT,6009)
 6009 FORMAT('BESS0 BESSEL FUNCTION ARGUMENT NOT IN (-3,INFINITY) ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC GOTO9000
C
 6001 CONTINUE
CCCCC ARG1=ARG/3.0
CCCCC RESULT=(D012*ARG1**12)+(D010*ARG1**10)+(D08*ARG1**8)
CCCCC1       +(D06*ARG1**6)+(D04*ARG1**4)+(D02*ARG1**2)+D00
CCCCC TERM=RESULT
CCCCC GOTO9000
C
 6002 CONTINUE
CCCCC ARG2=3.0/ARG
CCCCC F0=(F06*ARG2**6)+(F05*ARG2**5)+(F04*ARG2**4)
CCCCC1       +(F03*ARG2**3)+(F02*ARG2**2)+(F01*ARG2**1)+F00
CCCCC G0=(G06*ARG2**6)+(G05*ARG2**5)+(G04*ARG2**4)
CCCCC1       +(G03*ARG2**3)+(G02*ARG2**2)+(G01*ARG2**1)+G00
CCCCC THETA0=ARG+G0
CCCCC RESULT=(1.0/SQRT(ARG))*F0*COS(THETA0)
CCCCC TERM=RESULT
      GOTO9000
C
CCCCC USE SLATEC ROUTINE SINCE IT HANDLES ANY REAL X (NOT LIMITED TO
CCCCC (-3,INF).
 6010 CONTINUE
      ARG=X
      RESULT=BESJ1(X)
      TERM=RESULT
CCCCC IF(-3.0.LE.ARG.AND.ARG.LE.3.0)GOTO6011
CCCCC IF(3.0.LE.ARG)GOTO6012
CCCCC WRITE(ICOUT,6019)
 6019 FORMAT('BESS1 BESSEL FUNCTION ARGUMENT NOT IN (-3,INFINITY) ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC GOTO9000
 6011 CONTINUE
CCCCC ARG1=ARG/3.0
CCCCC RESULT=(D112*ARG1**12)+(D110*ARG1**10)+(D18*ARG1**8)
CCCCC1       +(D16*ARG1**6)+(D14*ARG1**4)+(D12*ARG1**2)+D10
CCCCC RESULT=ARG*RESULT
CCCCC TERM=RESULT
CCCCC GOTO9000
 6012 CONTINUE
CCCCC ARG2=3.0/ARG
CCCCC F1=(F16*ARG2**6)+(F15*ARG2**5)+(F14*ARG2**4)
CCCCC1       +(F13*ARG2**3)+(F12*ARG2**2)+(F11*ARG2**1)+F10
CCCCC G1=(G16*ARG2**6)+(G15*ARG2**5)+(G14*ARG2**4)
CCCCC1       +(G13*ARG2**3)+(G12*ARG2**2)+(G11*ARG2**1)+G10
CCCCC THETA1=ARG+G1
CCCCC RESULT=(1.0/SQRT(ARG))*F1*COS(THETA1)
CCCCC TERM=RESULT
      GOTO9000
C
CCCCC THE FOLLOWING SECTIONS (6100 TO 6700) WERE ADDED SEPTEMBER 1994
 6100 CONTINUE
      ARG1=X
      RESULT=BESY0(ARG1)
      TERM=RESULT
      GOTO9000
C
 6150 CONTINUE
      ARG1=X
      RESULT=BESY1(ARG1)
      TERM=RESULT
      GOTO9000
C
 6200 CONTINUE
      DARG1=DBLE(X)
      DRESLT=DBESI0(DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
 6230 CONTINUE
      DARG1=DBLE(X)
      DRESLT=DBSI0E(DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
 6250 CONTINUE
      DARG1=DBLE(X)
      DRESLT=DBESI1(DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
 6280 CONTINUE
      DARG1=DBLE(X)
      DRESLT=DBSI1E(DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
 6300 CONTINUE
      ARG1=X
      RESULT=BESK0(ARG1)
      TERM=RESULT
      GOTO9000
C
 6330 CONTINUE
      ARG1=X
      RESULT=BESK0E(ARG1)
      TERM=RESULT
      GOTO9000
C
 6350 CONTINUE
      ARG1=X
      RESULT=BESK1(ARG1)
      TERM=RESULT
      GOTO9000
C
 6380 CONTINUE
      ARG1=X
      RESULT=BESK1E(ARG1)
      TERM=RESULT
      GOTO9000
C
CCCCC NOTE: 2 CASES FOR BESSJ(X,ALPHA)
CCCCC       1) ALPHA IS INTEGER
CCCCC       2) ALPHA IS REAL
CCCCC       HOWEVER, CALL TO BESJ IS SAME.  BESJ ACTUALLY
CCCCC       COMPUTES A SEQUENCE OF BESJ VALUES, BUT WE ARE
CCCCC       ONLY COMPUTING 1 (SET ALPHA TO THIS VALUE).
 6400 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.EQ.0.0)THEN
        RESULT=BESJ0(ARG1)
      ELSEIF(ARG2.EQ.1.0)THEN
        RESULT=BESJ1(ARG1)
      ELSE
        IARG1=1
        CALL BESJ(ARG1,ARG2,IARG1,TEMP1,NZERO)
        RESULT=TEMP1(IARG1)
      ENDIF
      TERM=RESULT
      GOTO9000
C
 6500 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.EQ.0.0)THEN
        RESULT=BESY0(ARG1)
      ELSEIF(ARG2.EQ.1.0)THEN
        RESULT=BESY1(ARG1)
      ELSE
        IARG1=1
        CALL BESY(ARG1,ARG2,IARG1,TEMP1)
        RESULT=TEMP1(IARG1)
      ENDIF
      TERM=RESULT
      GOTO9000
C
 6600 CONTINUE
      DARG1=DBLE(X)
      DARG2=DBLE(SAVE1)
CCCCC APRIL 1995.  FIX BUG
CCCCC IF(ARG2.EQ.0.0)THEN
      IF(DARG2.EQ.0.D0)THEN
        DRESLT=DBESI0(DARG1)
CCCCC ELSEIF(ARG2.EQ.1.0)THEN
      ELSEIF(DARG2.EQ.1.D0)THEN
        DRESLT=DBESI1(DARG1)
      ELSE
        IARG1=1
        ISCALE=1
        CALL DBESI(DARG1,DARG2,ISCALE,IARG1,DTEMP1,NZERO)
        DRESLT=DTEMP1(IARG1)
      ENDIF
      TERM=SNGL(DRESLT)
      GOTO9000
C
 6650 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.EQ.0.0)THEN
        RESULT=BESI0E(ARG1)
      ELSEIF(ARG2.EQ.1.0)THEN
        RESULT=BESI1E(ARG1)
      ELSE
        IARG1=1
        ISCALE=2
        CALL BESI(ARG1,ARG2,ISCALE,IARG1,TEMP1,NZERO)
        RESULT=TEMP1(IARG1)
      ENDIF
      TERM=RESULT
      GOTO9000
C
 6700 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.EQ.0.0)THEN
        RESULT=BESK0(ARG1)
      ELSEIF(ARG2.EQ.1.0)THEN
        RESULT=BESK1(ARG1)
      ELSE
        IARG1=1
        ISCALE=1
        CALL BESK(ARG1,ARG2,ISCALE,IARG1,TEMP1,NZERO)
        RESULT=TEMP1(IARG1)
      ENDIF
      TERM=RESULT
      GOTO9000
C
 6750 CONTINUE
      ARG1=X
      ARG2=SAVE1
      IF(ARG2.EQ.0.0)THEN
        RESULT=BESK0E(ARG1)
      ELSEIF(ARG2.EQ.1.0)THEN
        RESULT=BESK1E(ARG1)
      ELSE
        IARG1=1
        ISCALE=2
        CALL BESK(ARG1,ARG2,ISCALE,IARG1,TEMP1,NZERO)
        RESULT=TEMP1(IARG1)
      ENDIF
      TERM=RESULT
      GOTO9000
C
 6800 CONTINUE
      ARG1=X
      RESULT=AI(ARG1)
      TERM=RESULT
      GOTO9000
C
 6900 CONTINUE
      ARG1=X
      RESULT=BI(ARG1)
      TERM=RESULT
      GOTO9000
C
 7000 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      IARG1=INT(SAVE2)
      ARG4=SAVE2-REAL(IARG1)
      IF(ARG4.GT.0.5)THEN
        IARG1=IARG1+1
        ARG4=-ARG4
      ENDIF
CCCCC IF(IARG1.GT.100.OR.SAVE.LT.0.0)THEN
      IF(IARG1.GT.100.OR.SAVE2.LT.0)THEN
        WRITE(ICOUT,7001)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7001 FORMAT('***** ORDER OF COMPLEX BESSEL FUNCTION NOT IN THE RANGE',
     1 ' (0,100). *****')
      CALL BESJCF(Z1,ARG4,IARG1,CTEMP1)
      TERM=REAL(CTEMP1(IARG1+2))
      GOTO9000
C
 7010 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      IARG1=INT(SAVE2)
      ARG4=SAVE2-REAL(IARG1)
      IF(ARG4.GT.0.5)THEN
        IARG1=IARG1+1
        ARG4=-ARG4
      ENDIF
      IF(IARG1.GT.100.OR.SAVE2.LT.0.0)THEN
        WRITE(ICOUT,7011)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7011 FORMAT('***** ORDER OF COMPLEX BESSEL FUNCTION NOT IN THE RANGE',
     1 ' (0,100). *****')
      CALL BESJCF(Z1,ARG4,IARG1,CTEMP1)
      TERM=AIMAG(CTEMP1(IARG1+2))
      GOTO9000
C
 7020 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      IARG1=INT(SAVE2)
      ARG4=SAVE2-REAL(IARG1)
      IF(ARG4.GT.0.5)THEN
        IARG1=IARG1+1
        ARG4=-ARG4
      ENDIF
      IF(IARG1.GT.100.OR.SAVE2.LT.0.0)THEN
        WRITE(ICOUT,7021)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7021 FORMAT('***** ORDER OF COMPLEX BESSEL FUNCTION NOT IN THE RANGE',
     1 ' (0,100). *****')
      CALL BESYCF(Z1,ARG4,IARG1,CTEMP1)
      TERM=REAL(CTEMP1(IARG1+2))
      GOTO9000
C
 7030 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      IARG1=INT(SAVE2)
      ARG4=SAVE2-REAL(IARG1)
      IF(ARG4.GT.0.5)THEN
        IARG1=IARG1+1
        ARG4=-ARG4
      ENDIF
      IF(IARG1.GT.100.OR.SAVE2.LT.0.0)THEN
        WRITE(ICOUT,7031)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7031 FORMAT('***** ORDER OF COMPLEX BESSEL FUNCTION NOT IN THE RANGE',
     1 ' (0,100). *****')
      CALL BESYCF(Z1,ARG4,IARG1,CTEMP1)
      TERM=AIMAG(CTEMP1(IARG1+2))
      GOTO9000
C
 7040 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      IARG1=INT(SAVE2)
      ARG4=SAVE2-REAL(IARG1)
      IF(ARG4.GT.0.5)THEN
        IARG1=IARG1+1
        ARG4=-ARG4
      ENDIF
      IF(IARG1.GT.100.OR.SAVE2.LT.0.0)THEN
        WRITE(ICOUT,7041)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7041 FORMAT('***** ORDER OF COMPLEX BESSEL FUNCTION NOT IN THE RANGE',
     1 ' (0,100). *****')
      CALL BESICF(Z1,ARG4,IARG1,CTEMP1)
      TERM=REAL(CTEMP1(IARG1+2))
      GOTO9000
C
 7050 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      IARG1=INT(SAVE2)
      ARG4=SAVE2-REAL(IARG1)
      IF(ARG4.GT.0.5)THEN
        IARG1=IARG1+1
        ARG4=-ARG4
      ENDIF
      IF(IARG1.GT.100.OR.SAVE2.LT.0.0)THEN
        WRITE(ICOUT,7051)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7051 FORMAT('***** ORDER OF COMPLEX BESSEL FUNCTION NOT IN THE RANGE',
     1 ' (0,100). *****')
      CALL BESICF(Z1,ARG4,IARG1,CTEMP1)
      TERM=AIMAG(CTEMP1(IARG1+2))
      GOTO9000
C
 7060 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      IARG1=INT(SAVE2)
      ARG4=SAVE2-REAL(IARG1)
      IF(ARG4.GT.0.5)THEN
        IARG1=IARG1+1
        ARG4=-ARG4
      ENDIF
      IF(IARG1.GT.100.OR.SAVE2.LT.0.0)THEN
        WRITE(ICOUT,7061)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7061 FORMAT('***** ORDER OF COMPLEX BESSEL FUNCTION NOT IN THE RANGE',
     1 ' (0,100). *****')
      CALL BESKCF(Z1,ARG4,IARG1,CTEMP1)
      TERM=REAL(CTEMP1(IARG1+2))
      GOTO9000
C
 7070 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      IARG1=INT(SAVE2)
      ARG4=SAVE2-REAL(IARG1)
      IF(ARG4.GT.0.5)THEN
        IARG1=IARG1+1
        ARG4=-ARG4
      ENDIF
      IF(IARG1.GT.100.OR.SAVE2.LT.0.0)THEN
        WRITE(ICOUT,7071)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7071 FORMAT('***** ORDER OF COMPLEX BESSEL FUNCTION NOT IN THE RANGE',
     1 ' (0,100). *****')
      CALL BESKCF(Z1,ARG4,IARG1,CTEMP1)
      TERM=AIMAG(CTEMP1(IARG1+2))
      GOTO9000
C
CCCCC THE FOLLOWING 4 SECTIONS (7100 TO 7400) WAS ADDED MAY 1989
 7100 CONTINUE
      ARG1=X
      IF(ARG1.GT.0.0)GOTO7109
      IF(ARG1.EQ.0.0)WRITE(ICOUT,7101)
 7101 FORMAT('ERROR--ARGUMENT OF CP FUNCTION IS 0')
      IF(ARG1.EQ.0.0)CALL DPWRST('XXX','BUG ')
      IF(ARG1.EQ.0.0)WRITE(ICOUT,7102)
 7102 FORMAT('ERROR--ARGUMENT OF CP FUNCTION IS NEGATIVE')
      IF(ARG1.EQ.0.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 7109 CONTINUE
      RESULT=1.0/(3.0*ARG1)
      TERM=RESULT
      GOTO9000
C
 7200 CONTINUE
      ARG1=X
      IF(X.LT.0.0)ARG1=(-X)
      ARG2=SAVE1
      IF(ARG2.GT.0.0)GOTO7209
      IF(ARG2.EQ.0.0)WRITE(ICOUT,7201)
 7201 FORMAT('ERROR--2ND ARGUMENT OF PERDEF FUNCTION IS 0')
      IF(ARG2.EQ.0.0)CALL DPWRST('XXX','BUG ')
      IF(ARG2.EQ.0.0)WRITE(ICOUT,7202)
 7202 FORMAT('ERROR--2ND ARGUMENT OF PERDEF FUNCTION IS NEGATIVE')
      IF(ARG2.EQ.0.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 7209 CONTINUE
      RESULT=(1.0-ARG1)/(3.0*ARG2)
      TERM=RESULT
      GOTO9000
C
 7300 CONTINUE
      ARG1=X
      IF(X.LT.0.0)ARG1=(-X)
      ARG2=SAVE1
      IF(ARG2.GT.0.0)GOTO7309
      IF(ARG2.EQ.0.0)WRITE(ICOUT,7301)
 7301 FORMAT('ERROR--2ND ARGUMENT OF PERDEF FUNCTION IS 0')
      IF(ARG2.EQ.0.0)CALL DPWRST('XXX','BUG ')
      IF(ARG2.EQ.0.0)WRITE(ICOUT,7302)
 7302 FORMAT('ERROR--2ND ARGUMENT OF PERDEF FUNCTION IS NEGATIVE')
      IF(ARG2.EQ.0.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 7309 CONTINUE
CCCCC Z1=(1.0-ARG1)/ARG2
      ARG3=(1.0-ARG1)/ARG2
      Z2=(-1.0-ARG1)/ARG2
      CALL NORCDF(ARG3,CDF1)
      CALL NORCDF(Z2,CDF2)
      RESULT=100.0*(1.0-(CDF1-CDF2))
      TERM=RESULT
      GOTO9000
C
 7400 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      RESULT=ARG3*(ARG1*ARG1+ARG2*ARG2)
      TERM=RESULT
      GOTO9000
CCCCC FOLLOWING SECTIONS ADDED SEPTEMBER 1994.
C
 7500 CONTINUE
      ARG1=X
      RESULT=DAWS(ARG1)
      TERM=RESULT
      GOTO9000
C
 7600 CONTINUE
      ARG1=X
      RESULT=E1(ARG1)
      TERM=RESULT
      GOTO9000
C
 7650 CONTINUE
      ARG1=X
      RESULT=EI(ARG1)
      TERM=RESULT
      GOTO9000
C
 7700 CONTINUE
      ARG1=X
      IARG2=INT(SAVE1+0.5)
      IARG3=1
      ISCALE=1
      TOL=1.0E-4
      IERR=0
C
C  APRIL 1995.  THE N=0 CASE HANDLED SEPARATELY.
C
      IF(X.GT.0.0 .AND. IARG2.EQ.0)THEN
        RESULT=EXP(-ARG1/ARG1)
        GOTO9000
      ENDIF
C
      CALL EXINT(ARG1,IARG2,ISCALE,IARG3,TOL,TEMP1,NZERO,IERR)
      IF(IERR.EQ.0)THEN
        RESULT=TEMP1(1)
      ELSEIF(IERR.EQ.1)THEN
        WRITE(ICOUT,7701)
        CALL DPWRST('XXX','BUG ')
        RESULT=0.0
      ELSEIF(IERR.EQ.2)THEN
        WRITE(ICOUT,7702)
        CALL DPWRST('XXX','BUG ')
        RESULT=0.0
      ELSEIF(IERR.EQ.3)THEN
        WRITE(ICOUT,7703)
        CALL DPWRST('XXX','BUG ')
        RESULT=0.0
      ENDIF
 7701 FORMAT('*****ERROR IN THE INPUT ARGUMENTS IN CALCULATING THE ',
     * 'EXPONENTIAL INTEGRAL. ****')
 7702 FORMAT('*****ERROR IN CALCULATING THE EXPONENTIAL INTEGRAL, THE',
     * ' ALGORITHM TERMINATION CONDITION NOT MET. ****')
 7703 FORMAT('*****ERROR IN CALCULATING THE EXPONENTIAL INTEGRAL. ***')
      TERM=RESULT
      GOTO9000
C
 7800 CONTINUE
      ARG1=X
      ARG2=SAVE1
      RESULT=RC(ARG1,ARG2,IERR)
      TERM=RESULT
      GOTO9000
C
 7810 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      RESULT=RD(ARG1,ARG2,ARG3,IERR)
      TERM=RESULT
      GOTO9000
C
 7815 CONTINUE
      ARG1=X
      IF(ARG1.LT.0.0.OR.ARG1.GE.1.0)THEN
        WRITE(ICOUT,7816)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7816 FORMAT('**** ERROR FROM ELLIPC2, ARGUMENT IS NOT IN THE (0,1)',
     1       ' INTERVAL. ****')
      ARG2=1.0-ARG1
      ARG3=0.0
      ARG4=1.0
      RESULT1=RF(ARG3,ARG2,ARG4,IERR)
      RESULT2=RD(ARG3,ARG2,ARG4,IERR)
      RESULT=RESULT1-(1.0/3.0)*ARG1*RESULT2
      TERM=RESULT
      GOTO9000
C
 7818 CONTINUE
      IF(X.LE.0.0.OR.X.GT.0.5*REALPI)THEN
        WRITE(ICOUT,7819)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7819 FORMAT('**** ERROR FROM ELLIP2, FIRST ARGUMENT IS NOT IN THE ',
     1       '(0,PI/2) INTERVAL. ****')
      ARG5=SIN(SAVE1)*SIN(SAVE1)
      ARG1=SIN(X)
      ARG2=COS(X)*COS(X)
      ARG3=1.0-ARG5*ARG1*ARG1
      ARG4=1.0
      RESULT1=RF(ARG2,ARG3,ARG4,IERR)
      RESULT2=RD(ARG2,ARG3,ARG4,IERR)
      RESULT=RESULT1-ARG1*ARG1*ARG5*RESULT2/3.0
      TERM=ARG1*RESULT
      GOTO9000
C
 7820 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      RESULT=RF(ARG1,ARG2,ARG3,IERR)
      TERM=RESULT
      GOTO9000
C
 7825 CONTINUE
      IF(ARG1.LT.0.0.OR.ARG1.GE.1.0)THEN
        WRITE(ICOUT,7826)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7826 FORMAT('**** ERROR FROM ELLIPC1, ARGUMENT IS NOT IN THE (0,1)',
     1       ' INTERVAL. ****')
      ARG1=0.0
      ARG2=1.0-X
      ARG3=1.0
      RESULT=RF(ARG1,ARG2,ARG3,IERR)
      TERM=RESULT
      GOTO9000
C
 7828 CONTINUE
      IF(X.LE.0.0.OR.X.GT.0.5*REALPI)THEN
        WRITE(ICOUT,7829)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7829 FORMAT('**** ERROR FROM ELLIP1, FIRST ARGUMENT IS NOT IN THE ',
     1       '(0,PI/2) INTERVAL. ****')
      ARG1=SIN(X)
      ARG2=COS(X)**2
      ARG3=(1.0-ARG1*SIN(SAVE1))*(1.0+ARG1*SIN(SAVE1))
      ARG4=1.0
      RESULT=RF(ARG2,ARG3,ARG4,IERR)
      TERM=ARG1*RESULT
      GOTO9000
C
 7830 CONTINUE
      ARG1=X
      ARG2=SAVE1
      ARG3=SAVE2
      ARG4=SAVE3
      RESULT=RJ(ARG1,ARG2,ARG3,ARG4,IERR)
      TERM=RESULT
      GOTO9000
C
 7838 CONTINUE
      IF(X.LE.0.0.OR.X.GT.0.5*REALPI)THEN
        WRITE(ICOUT,7839)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ENDIF
 7839 FORMAT('**** ERROR FROM ELLIP3, FIRST ARGUMENT IS NOT IN THE ',
     1       '(0,PI/2) INTERVAL. ****')
      ARG6=-SAVE1
      ARG1=SIN(X)
      ARG2=COS(X)*COS(X)
      ARG3=1.0-SIN(SAVE2)*SIN(SAVE2)*ARG1*ARG1
      ARG4=1.0+ARG6*ARG1*ARG1
      ARG5=1.0
      RESULT1=RF(ARG2,ARG3,ARG5,IERR)
      RESULT2=RJ(ARG2,ARG3,ARG5,ARG4,IERR)
      RESULT=(ARG6/3.0)*(ARG1**3)*RESULT2
      TERM=ARG1*RESULT1-RESULT
      GOTO9000
C
 7900 CONTINUE
      DARG1=DBLE(X)
      DRESLT=DSPENC(DARG1)
      TERM=SNGL(DRESLT)
      GOTO9000
C
 8000 CONTINUE
      ARG1=X
      RESULT=ALI(ARG1)
      TERM=RESULT
      GOTO9000
C
CCCCC ADD FOLLOWING SECTION (BN) SEPTEMBER 1997
 8010 CONTINUE
      IARG1=INT(X+0.5)
      ARG2=SAVE1
      IF(ARG2.EQ.-99.9)THEN
        CALL BERNOB(IARG1,DTEMP1(1))
        TERM=SNGL(DTEMP1(IARG1+1))
      ELSE
        DARG1=X
        IARG2=INT(ARG2+0.5)
        CALL BERNPN(DARG1,IARG2,DRESLT)
        TERM=SNGL(DRESLT)
      ENDIF
      GOTO9000
C
CCCCC ADD FOLLOWING SECTION (EN) SEPTEMBER 1997
 8020 CONTINUE
      IARG1=INT(X+0.5)
      ARG2=SAVE1
      IF(ARG2.EQ.-99.9)THEN
        CALL EULERB(IARG1,DTEMP1(1))
        TERM=SNGL(DTEMP1(IARG1+1))
      ELSE
        DARG1=X
        IARG2=INT(ARG2+0.5)
        CALL EULERP(DARG1,IARG2,DRESLT)
        TERM=SNGL(DRESLT)
      ENDIF
      GOTO9000
C
CCCCC ADD FOLLOWING SECTION (BINOM) SEPTEMBER 1997
 8030 CONTINUE
      IARG1=INT(X+0.5)
      IARG2=INT(SAVE1+0.5)
      RESULT=BINOM(IARG1,IARG2)
      TERM=RESULT
      GOTO9000
C
 8040 CONTINUE
      DARG1=DBLE(X)
      IARG2=INT(SAVE1+0.5)
      IF(IARG2.LT.0)IARG2=0
      IF(IARG2.EQ.0)THEN
        DRESLT=ABRAM0(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.1)THEN
        DRESLT=ABRAM1(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.2)THEN
        DRESLT=ABRAM2(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.LE.100)THEN
        DABRAM(0)=ABRAM0(DARG1)
        DABRAM(1)=ABRAM1(DARG1)
        DABRAM(2)=ABRAM2(DARG1)
        DO8041I=3,IARG2
          DABRAM(I)=(DBLE(I-1)*DABRAM(I-2) + DARG1*DABRAM(I-3))/2.0D0
 8041   CONTINUE
        DRESLT=DABRAM(IARG2)
        TERM=REAL(DRESLT)
      ELSE
        TERM=0.0
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8043)IARG2
        CALL DPWRST('XXX','BUG ')
      ENDIF
 8043 FORMAT('***** ERROR FROM ABRAM: MAXIMUM ORDER OF 100 ',
     1       'EXCEEDED.')
      GOTO9000
C
 8045 CONTINUE
      DARG1=DBLE(X)
      DRESLT=CLAUSN(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 8050 CONTINUE
      DARG1=DBLE(X)
      IARG2=INT(SAVE1+0.5)
      IF(IARG2.LT.1)IARG2=1
      IF(IARG2.EQ.1)THEN
        DRESLT=DEBYE1(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.2)THEN
        DRESLT=DEBYE2(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.3)THEN
        DRESLT=DEBYE3(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.4)THEN
        DRESLT=DEBYE4(DARG1)
        TERM=REAL(DRESLT)
      ELSE
        TERM=0.0
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8053)IARG2
        CALL DPWRST('XXX','BUG ')
      ENDIF
 8053 FORMAT('***** ERROR FROM DEBYE: MAXIMUM ORDER OF 4 ',
     1       'EXCEEDED.')
      GOTO9000
C
 8055 CONTINUE
      DARG1=DBLE(X)
      DRESLT=EXP3(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 8060 CONTINUE
      DARG1=DBLE(X)
      DRESLT=GOODST(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 8065 CONTINUE
      DARG1=DBLE(X)
      DRESLT=LOBACH(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 8070 CONTINUE
      DARG1=DBLE(X)
      DRESLT=STROM(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 8075 CONTINUE
      DARG1=DBLE(X)
      DRESLT=SYNCH1(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 8080 CONTINUE
      DARG1=DBLE(X)
      DRESLT=SYNCH2(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
 8085 CONTINUE
      DARG1=DBLE(X)
      IARG2=INT(SAVE1+0.5)
      IF(IARG2.LT.2)IARG2=2
      IF(IARG2.EQ.2)THEN
        DRESLT=TRAN02(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.3)THEN
        DRESLT=TRAN03(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.4)THEN
        DRESLT=TRAN04(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.5)THEN
        DRESLT=TRAN05(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.6)THEN
        DRESLT=TRAN06(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.7)THEN
        DRESLT=TRAN07(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.8)THEN
        DRESLT=TRAN08(DARG1)
        TERM=REAL(DRESLT)
      ELSEIF(IARG2.EQ.9)THEN
        DRESLT=TRAN09(DARG1)
        TERM=REAL(DRESLT)
      ELSE
        TERM=0.0
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8088)IARG2
        CALL DPWRST('XXX','BUG ')
      ENDIF
 8088 FORMAT('***** ERROR FROM TRAN: MAXIMUM ORDER OF 9 ',
     1       'EXCEEDED.')
      GOTO9000
C
 8100 CONTINUE
      DARG1=DBLE(X)
C
C  APRIL 1995.  SI(-X)=-SI(X)
C
      AFACT=1.0
      IF(DARG1.LT.0.D0)THEN
        AFACT=-1.0
        DARG1=-DARG1
      ENDIF
C
      IERR=0
      IOPT=1
      CALL SICIEI(IOPT,DARG1,DARG2,DARG3,DARG4,DARG5,DARG6,DARG7,
     1DARG8,DARG9,IERR)
      IF(IERR.GT.0)THEN
        WRITE(ICOUT,8101)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ELSE
        TERM=SNGL(DARG2)
        TERM=TERM*AFACT
      ENDIF
 8101 FORMAT('**** ERROR IN COMPUTING THE SINE INTEGRAL. ****')
      GOTO9000
C
 8200 CONTINUE
      DARG1=DBLE(X)
C
C  APRIL 1995.  SHI(-X)=-SHI(X)
C
      AFACT=1.0
      IF(DARG1.LT.0.D0)THEN
        AFACT=-1.0
        DARG1=-DARG1
      ENDIF
C
      IOPT=3
      IERR=0
      CALL SICIEI(IOPT,DARG1,DARG2,DARG3,DARG4,DARG5,DARG6,DARG7,
     1DARG8,DARG9,IERR)
      IF(IERR.GT.0)THEN
        WRITE(ICOUT,8201)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ELSE
        TERM=SNGL(DARG7)
        TERM=TERM*AFACT
      ENDIF
 8201 FORMAT('**** ERROR IN COMPUTING THE HYPERBOLIC SINE ',
     1'INTEGRAL. *****')
      GOTO9000
C
 8300 CONTINUE
      IF(X.EQ.0.0)THEN
        WRITE(ICOUT,8302)
        CALL DPWRST('XXX','BUG ')
        TERM=-R1MACH(2)
        GOTO9000
      ENDIF
 8302 FORMAT('**** ERROR, THE COSINE INTEGRAL IS UNDEFINED FOR 0.',
     1'  ****')
      DARG1=DBLE(X)
      IOPT=1
      IERR=0
      CALL SICIEI(IOPT,DARG1,DARG2,DARG3,DARG4,DARG5,DARG6,DARG7,
     1DARG8,DARG9,IERR)
      IF(IERR.GT.0)THEN
        WRITE(ICOUT,8301)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ELSE
        TERM=SNGL(DARG3)
      ENDIF
 8301 FORMAT('**** ERROR IN COMPUTING THE COSINE INTEGRAL. ****')
      GOTO9000
C
 8400 CONTINUE
      IF(X.EQ.0.0)THEN
        WRITE(ICOUT,8402)
        CALL DPWRST('XXX','BUG ')
        TERM=-R1MACH(2)
        GOTO9000
      ENDIF
 8402 FORMAT('**** ERROR, THE HYPERBOLIC COSINE INTEGRAL IS UNDEFINED',
     1' FOR 0. ****')
      DARG1=DBLE(X)
      IF(X.LT.0.0)DARG1=-DBLE(X)
      IOPT=3
      IERR=0
      CALL SICIEI(IOPT,DARG1,DARG2,DARG3,DARG4,DARG5,DARG6,DARG7,
     1DARG8,DARG9,IERR)
      IF(IERR.GT.0)THEN
        WRITE(ICOUT,8401)
        CALL DPWRST('XXX','BUG ')
        TERM=0.0
        GOTO9000
      ELSE
        TERM=SNGL(DARG8)
      ENDIF
 8401 FORMAT('**** ERROR IN COMPUTING THE HYPERBOLIC COSINE ',
     1'INTEGRAL. ****')
      GOTO9000
C
 8500 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(CABS(Z1))
      GOTO9000
C
 8600 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(CCOS(Z1))
      GOTO9000
C
 8610 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=AIMAG(CCOS(Z1))
      GOTO9000
C
 8700 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(CEXP(Z1))
      GOTO9000
C
 8710 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=AIMAG(CEXP(Z1))
      GOTO9000
C
 8800 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(CLOG(Z1))
      GOTO9000
C
 8810 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=AIMAG(CLOG(Z1))
      GOTO9000
C
 8900 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(CSIN(Z1))
      GOTO9000
C
 8910 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=AIMAG(CSIN(Z1))
      GOTO9000
C
 8950 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=REAL(CSQRT(Z1))
      GOTO9000
C
 8960 CONTINUE
      ARG1=X
      ARG2=SAVE1
      Z1=CMPLX(ARG1,ARG2)
      TERM=AIMAG(CSQRT(Z1))
      GOTO9000
C
CCCCC JULY 1995.  ADD HERMITE POLYNOMIAL
 8970 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL HERMIT(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC JULY 1995.  ADD LOG HERMITE POLYNOMIAL
 8975 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL LNHERM(ARG1,ARG2,RESULT,ISIGN)
      TERM=RESULT
      GOTO9000
C
CCCCC JULY 1995.  ADD SIGN OF LOG HERMITE POLYNOMIAL
 8978 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL LNHERM(ARG1,ARG2,RESULT,ISIGN)
      TERM=REAL(ISIGN)
      GOTO9000
C
CCCCC JULY 1995.  ADD LAGUERRE POLYNOMIAL
 8980 CONTINUE
      ARG1=X
      ARG2=SAVE1
      CALL LAGUE(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
CCCCC JULY 1995.  ADD LEGENDRE POLYNOMIAL (UNNORMALIZED)
CCCCC NOTE THAT IN THIS CASE THE INPUT IS THETA (I.E., THE
CCCCC ANGLE) RATHER THAN X.  THIS IS TO BE CONSISTENT WITH
CCCCC ASSOCIATED LEGENDRE POLYNOMILS AND FUNCTIONS.  CONVERT
CCCCC TO (-1,1) FOR LEGNDR ROUTINE.
 8990 CONTINUE
      IF(IANGLU.EQ.'DEGR')THEN
        ARG1=COS(X*REALPI/180.)
      ELSE
        ARG1=COS(X)
      ENDIF
      ARG2=SAVE1
      CALL LEGNDR(ARG1,ARG2,RESULT)
      TERM=RESULT
      GOTO9000
C
18090 CONTINUE
      DARG1=DBLE(X)
      DRESLT=AIRINT(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18095 CONTINUE
      DARG1=DBLE(X)
      DRESLT=AIRYGI(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18100 CONTINUE
      DARG1=DBLE(X)
      DRESLT=AIRYHI(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18105 CONTINUE
      DARG1=DBLE(X)
      DRESLT=ATNINT(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18110 CONTINUE
      DARG1=DBLE(X)
      DRESLT=BIRINT(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18115 CONTINUE
      DARG1=DBLE(X)
      DRESLT=I0INT(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18120 CONTINUE
      DARG1=DBLE(X)
      DRESLT=I0ML0(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18125 CONTINUE
      DARG1=DBLE(X)
      DRESLT=I1ML1(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18130 CONTINUE
      DARG1=DBLE(X)
      DRESLT=J0INT(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18135 CONTINUE
      DARG1=DBLE(X)
      DRESLT=K0INT(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
18140 CONTINUE
      DARG1=DBLE(X)
      DRESLT=Y0INT(DARG1)
      TERM=REAL(DRESLT)
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGEV.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPLIB3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IH,IH2,X
 9012 FORMAT('IH,IH2,X = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)SAVE1,SAVE2,I,IANGLU
 9013 FORMAT('SAVE1,SAVE2,I,IANGLU = ',E15.7,E15.7,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)RESULT,TERM,IBUGEV
 9014 FORMAT('RESULT,TERM,IBUGEV = ',2E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFOUND,IERROR
 9015 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLIBF(IH,IH2,X,SAVE1,SAVE2,SAVE3,SAVE4,SAVE5,
     1SAVE6,SAVE7,SAVE8,
     1I,IANGLU,
CCCCC MAY 1998.  ADD SAVE5 PARAMETER TO CALL LIST.
CCCCC SUBROUTINE DPLIBF(IH,IH2,X,SAVE1,SAVE2,SAVE3,SAVE4,I,IANGLU,
     1TERM,IBUGEV,IERROR)
CCCCC SAVE4 ARGUMENT ADDED SEPTEMBER 1994 (FOR DNFCDF ROUTINE).
CCCCC SUBROUTINE DPLIBF(IH,IH2,X,SAVE1,SAVE2,SAVE3,I,IANGLU,
C
C     PURPOSE--PERFORM A LIBRARY FUNCTION EVALUATION.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JANUARY  1979.
C     UPDATED         --NOVEMBER  1979.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1989.  INPUT ARG SAVE3 & SAVE3 IN CALL
C     UPDATED         --SEPTEMBER 1994.  ADD SAVE3,SAVE4 TO DPLIB3.
C     UPDATED         --MAY       1998.  ADD SAVE5 TO DPLIB3.
C     UPDATED         --JUNE      2003.  ADD SAVE6, SAVE7, SAVE8 TO
C                                        DPLIB3.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGEV
      CHARACTER*4 IERROR
C
      CHARACTER*4 IFOUNZ
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
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
      IFOUNZ='NO'
      IERROR='NO'
C
      ISUBN1='DPLI'
      ISUBN2='BF  '
C
      IF(IBUGEV.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPLIBF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IH,IH2,X
   52 FORMAT('IH,IH2,X = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)SAVE1,SAVE2,SAVE3,I,IANGLU
   53 FORMAT('SAVE1,SAVE2,SAVE3,I,IANGLU = ',3E15.7,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)TERM,IBUGEV,NUMBPW
   54 FORMAT('TERM,IBUGEV,NUMBPW = ',E15.7,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IERROR
   55 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUNZ='NO'
CCCCC THE SAVE3 ARGUEMNT WAS ADDED MARCH 1989
      CALL DPLIB1(IH,IH2,X,SAVE1,SAVE2,SAVE3,I,IANGLU,
     1TERM,IBUGEV,IFOUNZ,IERROR)
      IF(IFOUNZ.EQ.'YES')GOTO9000
C
      IFOUNZ='NO'
      CALL DPLIB2(IH,IH2,X,SAVE1,SAVE2,I,IANGLU,
     1TERM,IBUGEV,IFOUNZ,IERROR)
      IF(IFOUNZ.EQ.'YES')GOTO9000
C
      IFOUNZ='NO'
CCCCC SEPTEMBER 1994.  ADD SAVE3, SAVE4 FOR NON-CENTRAL DISTRIBUTIONS.
CCCCC MAY       1998.  ADD SAVE5 FOR MIXTURE DISTRIBUTIONS
CCCCC CALL DPLIB3(IH,IH2,X,SAVE1,SAVE2,I,IANGLU,
      CALL DPLIB3(IH,IH2,X,SAVE1,SAVE2,SAVE3,SAVE4,SAVE5,
     1SAVE6,SAVE7,SAVE8,
     1I,IANGLU,
     1TERM,IBUGEV,IFOUNZ,IERROR)
      IF(IFOUNZ.EQ.'YES')GOTO9000
C
      WRITE(ICOUT,419)
  419 FORMAT('***** ERROR IN DPLIBF--',
     1'UNKNOWN LIBRARY FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,396)I,IH,IH2
  396 FORMAT('I,IH,IH2 = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGEV.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPLIBF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IH,IH2,X
 9012 FORMAT('IH,IH2,X = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)SAVE1,SAVE2,SAVE3,I,IANGLU
 9013 FORMAT('SAVE1,SAVE2,SAVE3,I,IANGLU = ',3E15.7,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)TERM,IBUGEV
 9014 FORMAT('TERM,IBUGEV = ',E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFOUNZ,IERROR
 9015 FORMAT('IFOUNZ,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLICA(ICAPSW,ISEED,ISUBRO,IBUGA2,IBUGA3,IBUGQ,
     1                  IFOUND,IERROR)
C
C     PURPOSE--PERFORM A LINEAR CALIBRATRION ANALYSIS.
C              A LINEAR CALIBRATION WILL BE PERFORMED USING THE
C              FOLLOWING TECHNIQUES:
C               1) CLASSICAL (EISENHART: INVERSE PREDICTION LIMITS)
C               2) GRAYBILL-IYER METHOD
C               3) NETER, WASSERMAN, AND KUTNER
C               4) PROPOGATION OF ERROR
C               5) INVERSE (KRUTCHKOFF)
C               6) MAXIMUM LIKELIHOOD
C               7) BOOTSTRAP (EFRON--RESAMPLE RESIDUALS)
C               8) BOOTSTRAP (WU--RESAMPLE DATA)
C               9) BAYESIAN, CONTROLLED X'S, IMPROPER PRIOR (HOADLEY)
C                  (NOT ON INITIAL IMPLEMENTATION)
C              10) BAYESIAN, RANDOM X'S, IMPROPER PRIOR (HOADLEY)
C                  (NOT ON INITIAL IMPLEMENTATION)
C            --YOU CAN ALSO SPECIFY A QUADRATIC CALIBRATION.  THE
C              FOLLOWING TECHNIQUES ARE SUPPORTED:
C               1) INVERSE PREDICTION LIMITS
C               2) BOOTSTRAP (EFRON--RESAMPLE RESIDUALS)
C               3) BOOTSTRAP (WU--RESAMPLE DATA)
C     WRITTEN BY--JIM FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, 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     VERSION NUMBER--2003/7
C     ORIGINAL VERSION--JULY      2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES----------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ISUBRO
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHFACT
      CHARACTER*4 IHFAC2
C
      CHARACTER*4 ITYPE
      CHARACTER*4 ICASAN
      CHARACTER*10 ICALTY
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION Y3(MAXOBV)
C
      DIMENSION Z1(MAXOBV)
      DIMENSION Z2(MAXOBV)
      DIMENSION Z3(MAXOBV)
      DIMENSION Z4(MAXOBV)
      DIMENSION Z5(MAXOBV)
      DIMENSION Z6(MAXOBV)
      DIMENSION IZ(MAXOBV)
C
CCCCC NOTE: EQUIVALENCE TO DOUBLE PRECISION COMMON SINCE DPLIC3
CCCCC CALLS DPFIT WHICH ESSENTIALLY UTILIZES ALL THE SINGLE
CCCCC PRECISION STORAGE.
C
      INCLUDE 'DPCOZD.INC'
      EQUIVALENCE (DGARBG(IDGAR2),Y1(1))
      EQUIVALENCE (DGARBG(IDGAR3),Y2(1))
      EQUIVALENCE (DGARBG(IDGAR4),Y3(1))
      EQUIVALENCE (DGARBG(IDGAR5),Z1(1))
      EQUIVALENCE (DGARBG(IDGAR6),Z2(1))
      EQUIVALENCE (DGARBG(IDGAR7),Z3(1))
      EQUIVALENCE (DGARBG(IDGAR8),Z4(1))
      EQUIVALENCE (DGARBG(IDGAR9),Z5(1))
      EQUIVALENCE (DGARBG(IDGAR10),Z6(1))
C
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (IGARBG(IIGAR1),IZ(1))
C
C-----COMMON----------------------------------------------------
C
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C----------------------------------------------------------------
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='DPLI'
      ISUBN2='CA  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      MAXV2=3
      MINN2=2
C
      ICASEQ='UNKN'
      ICASAN='LICA'
C
C               *****************************************
C               **  TREAT THE LINEAR CALIBRATION CASE  **
C               *****************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPLICA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA2,IBUGA3
   52   FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)IBUGQ
   53   FORMAT('IBUGQ = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.ICOM.EQ.'LINE'.AND.
     1IHARG(1).EQ.'CALI'.AND.IHARG(2).EQ.'ANAL')GOTO112
      IF(NUMARG.GE.2.AND.ICOM.EQ.'QUAD'.AND.
     1IHARG(1).EQ.'CALI'.AND.IHARG(2).EQ.'ANAL')THEN
        ICASAN='QUCA'
        GOTO112
      ENDIF
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'LINE'.AND.
     1IHARG(1).EQ.'CALI')GOTO111
      IF(NUMARG.GE.1.AND.ICOM.EQ.'QUAD'.AND.
     1IHARG(1).EQ.'CALI')THEN
        ICASAN='QUCA'
        GOTO111
      ENDIF
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
      ICALTY='LINEAR'
      IF(ICASAN.EQ.'QUCA')ICALTY='QUADRATIC'
C
C               **************************************************
C               **  STEP 2--                                    **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT        **
C               **  ARGUMENTS.                                  **
C               **************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=3
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE DEPENDENT VARIABLE) **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               *************************************************
C               **  STEP 4--                                   **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS**
C               **  (NLEFT)                                    **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.    **
C               *************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,311)ICALTY
  311   FORMAT('***** ERROR IN ',A9,' CALIBRATION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,312)
  312   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,313)ICALTY
  313   FORMAT('      ',A9,' CALIBRATION WAS TO HAVE BEEN CARRIED ',
     1         'OUT MUST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,315)MINN2
  315   FORMAT('      BE ',I8,' OR LARGER;  SUCH WAS NOT THE CASE ',
     1         'HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,316)NLEFT
  316   FORMAT('      NLEFT = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,318)
  318   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,319)(IANS(I),I=1,MIN(IWIDTH,80))
  319     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
        J1=J
        IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
        IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
        IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')THEN
        WRITE(ICOUT,491)NUMARG,ILOCQ
  491   FORMAT('NUMARG,ILOCQ = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ******************************************
C               **  STEP 6--                            **
C               **  CHECK FOR A VALID NUMBER            **
C               **  OF VARIABLES (THERE ARE 2 VARIABLES **
C               **  FOLLOWED BY ONE PARAMETER OR        **
C               **  VARIABLE (THIS DEFINES THE VALUES   **
C               **  AT WHICH TO COMPUTE THE             **
C               **  CALIBRATION).                       **
C               **  CHECK THE VALIDITY OF EACH          **
C               **  OF THE VARIABLES (THAT IS, FOR EACH **
C               **  OF THE VARIABLES, DOES THE NAME     **
C               **  EXIST IN THE TABLE?  DOES THE NUMBER**
C               **  OF ELEMENTS  AGREE WITH THE NUMBER  **
C               **  OF ELEMENTS IN THE FIRST VARIABLE?  **
C               ******************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.NE.3)THEN
C
        WRITE(ICOUT,511)ICALTY
  511   FORMAT('***** ERROR IN ',A9,' CALIBRATION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,512)ICALTY
  512   FORMAT('      FOR A ',A9,' CALIBRATION, THERE MUST BE TWO ',
     1         'VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,514)
  514   FORMAT('      FOLLOWED BY A PARAMETER/SCALAR VALUE.  SUCH ',
     1         'WAS NOT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,515)NUMVAR
  515   FORMAT('      THE CASE HERE; THE SPECIFIED NUMBER OF ',
     1         'VARIABLES/PARAMETERS WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,518)
  518   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,519)(IANS(I),I=1,MIN(80,IWIDTH))
  519     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      J=2
      IHRIGH=IHARG(J)
      IHRIG2=IHARG2(J)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLIV=IVALUE(ILOCV)
      NIV=IN(ILOCV)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')THEN
        WRITE(ICOUT,532)IHFACT,IHFAC2,ICOLIV,NIV
  532   FORMAT('IFAC,IHFACT,IHFAC2,ICOLIV,NIV = ',A4,2X,A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(NIV.NE.NLEFT)THEN
        WRITE(ICOUT,551)ICALTY
  551   FORMAT('***** ERROR IN ',A9,' CALIBRATION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,552)ICALTY
  552   FORMAT('      FOR A ',A9,' CALIBRATION, THE NUMBER OF ',
     1         'ELEMENTS IN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,554)
  554   FORMAT('      THE DEPENDENT AND INDEPENDENT VARIABLES ',
     1         'SHOULD BE THE SAME;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,557)
  557   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,562)IHLEFT,IHLEF2,NLEFT
  562   FORMAT('      THE DEPENDENT VARIABLE ',A4,A4,'  HAS ',I8,
     1         ' ELEMENTS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,563)IHRIGH,IHRIG2,NIV
  563   FORMAT('      THE INDEPENDENT VARIABLE',A4,A4,'  HAS ',I8,
     1         ' ELEMENTS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,567)
  567   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,568)(IANS(I),I=1,MIN(80,IWIDTH))
  568     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      J=3
      IHFACT=IHARG(J)
      IHFAC2=IHARG2(J)
      ITYPE='PARA'
      IF(IARGT(J).EQ.'NUMB')THEN
        Y0=ARG(J)
      ELSE
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHFACT,IHFAC2,IHWUSE,
     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'NO')THEN
          Y0=VALUE(ILOCV)
        ELSE
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHFACT,IHFAC2,IHWUSE,
     1         IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1         ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ITYPE='VARI'
          ICOLCV=IVALUE(ILOCV)
          NCV=IN(ILOCV)
        ENDIF
      ENDIF
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'SUBS')THEN
        NIOLD=NLEFT
        CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
        NQ=NIOLD
      ELSEIF(ICASEQ.EQ.'FOR')THEN
        NIOLD=NLEFT
        CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1             NLOCAL,ILOCS,NS,IBUGQ,IERROR)
        NQ=NFOR
      ELSE
        DO615I=1,NLEFT
          ISUB(I)=1
  615   CONTINUE
        NQ=NLEFT
      ENDIF
C
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO660
        J=J+1
C
        IJ=MAXN*(ICOLL-1)+I
        IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
        IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
        IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
        IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
        IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
        IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
        IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
        ICOLR=ICOLIV
        IJ=MAXN*(ICOLR-1)+I
        IF(ICOLR.LE.MAXCOL)Y2(J)=V(IJ)
        IF(ICOLR.EQ.MAXCP1)Y2(J)=PRED(I)
        IF(ICOLR.EQ.MAXCP2)Y2(J)=RES(I)
        IF(ICOLR.EQ.MAXCP3)Y2(J)=YPLOT(I)
        IF(ICOLR.EQ.MAXCP4)Y2(J)=XPLOT(I)
        IF(ICOLR.EQ.MAXCP5)Y2(J)=X2PLOT(I)
        IF(ICOLR.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
  660 CONTINUE
      NS=J
C
      IF(ITYPE.EQ.'PARA')THEN
        Y3(1)=Y0
        NCALPT=1
      ELSE
        J=0
        DO670I=1,NCV
          J=J+1
C
          IJ=MAXN*(ICOLCV-1)+I
          IF(ICOLCV.LE.MAXCOL)Y3(J)=V(IJ)
          IF(ICOLCV.EQ.MAXCP1)Y3(J)=PRED(I)
          IF(ICOLCV.EQ.MAXCP2)Y3(J)=RES(I)
          IF(ICOLCV.EQ.MAXCP3)Y3(J)=YPLOT(I)
          IF(ICOLCV.EQ.MAXCP4)Y3(J)=XPLOT(I)
          IF(ICOLCV.EQ.MAXCP5)Y3(J)=X2PLOT(I)
          IF(ICOLCV.EQ.MAXCP6)Y3(J)=TAGPLO(I)
  670   CONTINUE
        NCALPT=NCV
      ENDIF
C
C
C               ***********************************************
C               **  STEP 9--                                 **
C               **  CARRY OUT THE LINEAR CALIBRATION         **
C               ***********************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LICA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LICA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,711)
  711   FORMAT('***** FROM DPLICA, AS WE ARE ABOUT TO CALL DPLIC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,712)NLEFT,MAXN,NS,NUMVAR
  712   FORMAT('NLEFT,MAXN,NS,NUMVAR = ',4I8)
        CALL DPWRST('XXX','BUG ')
        DO715I=1,NS
          WRITE(ICOUT,716)I,Y1(I),Y2(I)
  716     FORMAT('I,Y1(I),Y2(I) = ',I6,2X,2G15.7)
          CALL DPWRST('XXX','BUG ')
  715   CONTINUE
        WRITE(ICOUT,731)IBUGA3
  731   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IH='ALPH'
      IH2='A   '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        ALPHA=0.05
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)ALPHA=0.05
        IF(ALPHA.GT.0.5)ALPHA=1.0 - ALPHA
      ENDIF
C
      IWRITE='OFF'
      IF(ICASAN.EQ.'LICA')THEN
        CALL DPLIC2(Y1,Y2,Y3,NS,NCALPT,NUMVAR,
     1  Z1,Z2,Z3,Z4,Z6,IZ,
     1  IHLEFT,IHLEF2,IHRIGH,IHRIG2,
     1  ALPHA,MAXOBV,ISEED,
     1  EISEN,EISENL,EISENU,
     1  GRAYB,GRAYBL,GRAYBU,
     1  ANWK,ANWKL,ANWKU,
     1  PROPE,PROPEL,PROPEU,
     1  AINVR,AINVRL,AINVRU,
     1  AMLE,AMLEL,AMLEU,
     1  BOOTE,BOOTEL,BOOTEU,
     1  BOOTW,BOOTWL,BOOTWU,
     1  CBAYE,CBAYEL,CBAYEU,
     1  FBAYE,FBAYEL,FBAYEU,
     1  IWRITE,
     1  ICAPSW,ICAPTY,
     1  ISUBRO,IBUGA3,IERROR)
      ELSE
        CALL DPLIC3(Y1,Y2,Y3,NS,NCALPT,NUMVAR,
     1  Z1,Z2,Z3,Z4,Z5,Z6,IZ,
     1  IHLEFT,IHLEF2,IHRIGH,IHRIG2,
     1  ALPHA,MAXOBV,ISEED,
     1  EISEN,EISENL,EISENU,
     1  GRAYB,GRAYBL,GRAYBU,
     1  ANWK,ANWKL,ANWKU,
     1  PROPE,PROPEL,PROPEU,
     1  AINVR,AINVRL,AINVRU,
     1  AMLE,AMLEL,AMLEU,
     1  BOOTE,BOOTEL,BOOTEU,
     1  BOOTW,BOOTWL,BOOTWU,
     1  CBAYE,CBAYEL,CBAYEU,
     1  FBAYE,FBAYEL,FBAYEU,
     1  IWRITE,
     1  ICAPSW,ICAPTY,
     1  ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C               ***************************************
C               **  STEP 10--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='10'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NCALPT.GT.1)GOTO9000
      IH='EISE'
      IH2='N   '
      VALUE0=EISEN
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='EISE'
      IH2='NLCL'
      VALUE0=EISENL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='EISE'
      IH2='NUCL'
      VALUE0=EISENU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='GRAY'
      IH2='B   '
      VALUE0=GRAYB
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='GRAY'
      IH2='BLCL'
      VALUE0=GRAYBL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='GRAY'
      IH2='BUCL'
      VALUE0=GRAYBU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='NWK '
      IH2='    '
      VALUE0=ANWK
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='NWKL'
      IH2='CL  '
      VALUE0=ANWKL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='NWKU'
      IH2='CL  '
      VALUE0=ANWKU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='PROP'
      IH2='E   '
      VALUE0=PROPE
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='PROP'
      IH2='ELCL'
      VALUE0=PROPEL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='PROP'
      IH2='EUCL'
      VALUE0=PROPEU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='INVE'
      IH2='R   '
      VALUE0=AINVR
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='INVE'
      IH2='RLCL'
      VALUE0=AINVRL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='INVE'
      IH2='RUCL'
      VALUE0=AINVRU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='MLE '
      IH2='    '
      VALUE0=AMLE
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='MLEL'
      IH2='CL  '
      VALUE0=AMLEL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='MLEU'
      IH2='CL  '
      VALUE0=AMLEU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOOT'
      IH2='E   '
      VALUE0=BOOTE
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOOT'
      IH2='ELCL'
      VALUE0=BOOTEL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOOT'
      IH2='EUCL'
      VALUE0=BOOTEU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOOT'
      IH2='W   '
      VALUE0=BOOTW
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOOT'
      IH2='WLCL'
      VALUE0=BOOTWL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOOT'
      IH2='WUCL'
      VALUE0=BOOTWU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC BAYES NOT IMPLEMENTED YET, UNCOMMENT WHEN ACTIVATED IN DPLIC2.
C
CCCCC IH='CBAY'
CCCCC IH2='E   '
CCCCC VALUE0=CBAYE
CCCCC CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC IH='CBAY'
CCCCC IH2='ELCL'
CCCCC VALUE0=CBAYEL
CCCCC CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC IH='CBAY'
CCCCC IH2='EUCL'
CCCCC VALUE0=CBAYEU
CCCCC CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC IH='FBAY'
CCCCC IH2='E   '
CCCCC VALUE0=FBAYE
CCCCC CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC IH='FBAY'
CCCCC IH2='ELCL'
CCCCC VALUE0=FBAYEL
CCCCC CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC IH='FBAY'
CCCCC IH2='EUCL'
CCCCC VALUE0=FBAYEU
CCCCC CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LICA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPLICA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA2,IBUGA3,IBUGQ
 9012   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)NS,NUMVAR
 9014   FORMAT('NS,NUMVAR = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)IFOUND,IERROR
 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLIC2(Y1,Y2,Y3,NPTS,NCALPT,NUMVAR,
     1Z1,Z2,Z3,Z4,Z6,IZ,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,
     1ALPHA,MAXNXT,ISEED,
     1EISEN,EISENL,EISENU,
     1GRAYB,GRAYBL,GRAYBU,
     1ANWK,ANWKL,ANWKU,
     1PROPE,PROPEL,PROPEU,
     1AINVR,AINVRL,AINVRU,
     1AMLE,AMLEL,AMLEU,
     1BOOTE,BOOTEL,BOOTEU,
     1BOOTW,BOOTWL,BOOTWU,
     1CBAYE,CBAYEL,CBAYEU,
     1FBAYE,FBAYEL,FBAYEU,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--PERFORM A LINEAR CALIBRATRION ANALYSIS.
C              A LINEAR CALIBRATION WILL BE PERFORMED USING THE
C              FOLLOWING TECHNIQUES:
C               1) CLASSICAL (EISENHART: INVERSE PREDICTION LIMITS)
C               2) GRAYBILL-IYER METHOD
C               3) NETER, WASSERMAN, AND KUTNER
C               4) PROPOGATION OF ERROR
C               5) INVERSE (KRUTCHKOFF)
C               6) MAXIMUM LIKELIHOOD
C               7) BOOTSTRAP (EFRON)
C               8) BOOTSTRAP (WU)
C               9) BAYESIAN, CONTROLLED X'S, IMPROPER PRIOR (HOADLEY)
C                  (NOT ON INITIAL IMPLEMENTATION)
C              10) BAYESIAN, RANDOM X'S, IMPROPER PRIOR (HOADLEY)
C                  (NOT ON INITIAL IMPLEMENTATION)
C     PRINTING--YES
C     SUBROUTINES NEEDED--LINFIT, TPPF
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--2003/7
C     ORIGINAL VERSION--JULY      2003.
C     UPDATED         --OCTOBER   2003. ADD SUPPORT FOR LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IPTEMP
C
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
C
      CHARACTER*4 ICASJB
C
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
      CHARACTER*80 IFILE4
      CHARACTER*12 ISTAT4
      CHARACTER*12 IFORM4
      CHARACTER*12 IACCE4
      CHARACTER*12 IPROT4
      CHARACTER*12 ICURS4
      CHARACTER*4 IERRF4
      CHARACTER*4 IENDF4
      CHARACTER*4 IREWI4
C
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DMEAN
C
C----------------------------------------------------------------
C
      REAL Y1(*)
      REAL Y2(*)
      REAL Y3(*)
C
      REAL Z1(*)
      REAL Z2(*)
      REAL Z3(*)
      REAL Z4(*)
      REAL Z6(*)
      INTEGER IZ(*)
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
      IERROR='NO'
C
      ISUBN1='DPLI'
      ISUBN2='C2  '
C
      EISEN=0.0
      EISENL=0.0
      EISENU=0.0
      GRAYB=0.0
      GRAYBL=0.0
      GRAYBU=0.0
      ANWK=0.0
      ANWKL=0.0
      ANWKU=0.0
      PROPE=0.0
      PROPEL=0.0
      PROPEU=0.0
      AINVR=0.0
      AINVRL=0.0
      AINVRU=0.0
      AMLE=0.0
      AMLEL=0.0
      AMLEU=0.0
      BOOTE=0.0
      BOOTEL=0.0
      BOOTEU=0.0
      BOOTW=0.0
      BOOTWL=0.0
      BOOTWU=0.0
      CBAYE=0.0
      CBAYEL=0.0
      CBAYEU=0.0
      FBAYE=0.0
      FBAYEL=0.0
      FBAYEU=0.0
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LIC2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPLIC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NCALPT,NUMVAR
   52   FORMAT('NPTS,NCALPT,NUMVAR = ',3I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NPTS
          WRITE(ICOUT,56)I,Y1(I),Y2(I)
   56     FORMAT('I,Y1(I),Y2(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
        DO65I=1,NCALPT
          WRITE(ICOUT,66)I,Y3(I)
   66     FORMAT('I,Y3(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
   65   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NPTS.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,101)
  101   FORMAT('***** ERROR IN DPLIC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,102)
  102   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE LINEAR ',
     1         'CALIBRATION MUST BE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,103)NPTS
  103   FORMAT('      AT LEAST 2; THE ENTERED NUMBER OF ',
     1         'OBSERVATIONS = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               **************************************************
C               **  STEP 1.1--                                  **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
      ISTEPN='1.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='LIC2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='LIC2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='LIC2'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IOUNI4=IST4NU
      IFILE4=IST4NA
      ISTAT4=IST4ST
      IFORM4=IST4FO
      IACCE4=IST4AC
      IPROT4=IST4PR
      ICURS4=IST4CS
      ISUBN0='LIC2'
      IERRF4='NO'
C
      IREWI4='ON'
      CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               ***********************************************
C               **  STEP 2--                                 **
C               **  COMPUTE THE LINEAR FIT AND PRINT OUT     **
C               **  SUMMARY OF FIT INFORMATION.              **
C               ***********************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL LINFIT(Y1,Y2,NPTS,
     1A0,A1,RESSD,RESDF,CCXY,SDA0,SDA1,CCALBE,
     1ISUBRO,IBUGA3,IERROR)
C
      TA0=A0/SDA0
      TA1=A1/SDA1
C
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5101)
 5101   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5102)
 5102   FORMAT('<H1>LINEAR CALIBRATION ANALYSIS</H1>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5104)
 5104   FORMAT('<BR><BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
 5107   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('<TABLE BORDER CELLPADDING=5 CELLSPACING=5>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
 5113   FORMAT('   <CAPTION ALIGN=CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)IHLEFT,IHLEF2,IHRIGH,IHRIG2
 5115   FORMAT('      <B>SUMMARY OF THE LINEAR FIT BETWEEN ',
     1         A4,A4,' AND ',A4,A4,'</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
 5119   FORMAT('   </CAPTION>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
 5121   FORMAT('   <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
 5123   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
 5125   FORMAT('         NUMBER OF OBSERVATIONS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
 5127   FORMAT('      </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
 5126   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)NPTS
 5129   FORMAT('         ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
 5128   FORMAT('   </TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5141)
 5141   FORMAT('         EQUATION OF FITTED LINE:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)IHLEFT,IHLEF2,A0,A1,IHRIGH,IHRIG2
 5151   FORMAT('         ',A4,A4,' = ',G15.7,' + ',G15.7,' * ',A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5142)
 5142   FORMAT('         RESIDUAL STANDARD DEVIATION:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)RESSD
 5152   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5146)
 5146   FORMAT('         SD(INTERCEPT):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)SDA0
 5154   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
 5147   FORMAT('         T(INTERCEPT):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5156)TA0
 5156   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5144)
 5144   FORMAT('         SD(SLOPE):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5164)SDA1
 5164   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
 5149   FORMAT('         T(SLOPE):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5153)TA1
 5153   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5991)
 5991   FORMAT('</TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5993)
 5993   FORMAT('</UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5995)
 5995   FORMAT('<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5995)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5307)
 5307   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5311)
 5311   FORMAT('<TABLE BORDER CELLSPACING=5 CELLPADDING=5>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
 5313   FORMAT('   <CAPTION ALIGN=CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5315)
 5315   FORMAT('      <B>LINEAR CALIBRATION SUMMARY</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
 5319   FORMAT('   </CAPTION>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
 5321   FORMAT('   <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
 5323   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5341)
 5341   FORMAT('         METHOD')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
 5327   FORMAT('      </TD>')
 5329   FORMAT('      </TH>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
 5326   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5351)
 5351   FORMAT('         X0')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        ATEMP=1.0-ALPHA
        ITEMP=100.*ATEMP + 0.00001
        WRITE(ICOUT,5355)ITEMP
 5355   FORMAT('         ',I2,'% <BR>LOWER LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5357)ITEMP
 5357   FORMAT('         ',I2,'%<BR> UPPER LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
 5328   FORMAT('   </TR>')
        CALL DPWRST('XXX','WRIT')
C
CCCCC OCTOBER 2003: ADD LATEX SUPPORT.
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8001 FORMAT('{',A1,'bf LINEAR CALIBRATION ANALYSIS}')
 8002 FORMAT(A1,A1)
 8003 FORMAT(5X,'{',A1,'bf Summary of the Linear Fit Between Y and X}')
 8007 FORMAT(A1,'begin{center}')
 8009 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8010 FORMAT(A1,'end{center}')
 8012 FORMAT(A1,'end{verbatim}')
 8013 FORMAT(A1,'begin{table}')
 8014 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8016 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Equation of the Fitted Line: & ',
     1       A4,A4,' = ',G15.7,' + ',G15.7,'*',A4,A4,2X,A1,A1)
 8023 FORMAT(5X,'Residual Standard Deviation: & ',E15.7,2X,A1,A1)
 8024 FORMAT(5X,'SD(Intercept): & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'T(Intercept): & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'SD(Slope): & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'T(Slope): & ',G15.7,2X,A1,A1)
 8029 FORMAT(A1,'end{table}')
 8030 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)NPTS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)IHLEFT,IHLEF2,A0,A1,IHRIGH,IHRIG2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)RESSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)SDA0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)TA0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)SDA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)TA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,231)
  231   FORMAT('            LINEAR CALIBRATION ANALYSIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,233)IHLEFT,IHLEF2,IHRIGH,IHRIG2
  233   FORMAT('      SUMMARY OF THE LINEAR FIT BETWEEN ',
     1         A4,A4,' AND ',A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,235)NPTS
  235   FORMAT('NUMBER OF OBSERVATIONS:        ',7X,I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,237)A0
  237   FORMAT('ESTIMATE OF INTERCEPT           ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,239)SDA0
  239   FORMAT('SD(INTERCEPT)                   ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,240)TA0
  240   FORMAT('T(INTERCEPT)                    ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,247)A1
  247   FORMAT('ESTIMATE OF SLOPE               ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,249)SDA1
  249   FORMAT('SD(SLOPE)                       ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,250)TA1
  250   FORMAT('T(SLOPE)                        ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,254)RESSD
  254   FORMAT('RESIDUAL STANDARD DEVIATION:     ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6315)
 6315   FORMAT('      LINEAR CALIBRATION SUMMARY')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=1.0-ALPHA
        ITEMP=100.*ATEMP + 0.00001
        WRITE(ICOUT,6340)ITEMP,ITEMP
 6340   FORMAT(52X,I2,'%',12X,I2,'%')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6341)
 6341   FORMAT(13X,'METHOD',18X,'X0',8X,'LOWER LIMIT',6X,
     1         'UPPER LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6327)
 6327   FORMAT('------------------------',
     1         '------------------------',
     1         '---------------------------')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               ***********************************************
C               **  STEP 3--                                 **
C               **  COMPUTE THE LINEAR CALIBRATION ESTIMATES **
C               **  USING VARIOUS METHODS.                   **
C               ***********************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUNT=0
 3000 CONTINUE
      ICOUNT=ICOUNT+1
      IF(ICOUNT.GT.NCALPT)GOTO3999
      Y0=Y3(ICOUNT)
C
C               ***********************************************
C               **  STEP 3.1--                               **
C               **  CLASSICAL: EISENHART INVERTED PREDICTION **
C               **  LIMITS.                                  **
C               ***********************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ATEMP=1.0 - (ALPHA/2.0)
      N=NPTS
      AN=REAL(N)
      X0=(Y0 - A0)/A1
      NM2=N - 2
      CALL TPPF(ATEMP,NM2,T)
      TSSQ=T*T*RESSD*RESSD
      CALL MEAN(Y1,N,IWRITE,YBAR,IBUGA3,IERROR)
      CALL SD(Y1,N,IWRITE,YSD,IBUGA3,IERROR)
      CALL VAR(Y1,N,IWRITE,YVAR,IBUGA3,IERROR)
      CALL MEAN(Y2,N,IWRITE,XBAR,IBUGA3,IERROR)
      CALL SD(Y2,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL VAR(Y2,N,IWRITE,XVAR,IBUGA3,IERROR)
      CALL COV(Y1,Y2,N,IWRITE,COVXY,IBUGA3,IERROR)
      SSDX=(AN-1.0)*XVAR
      SSDY=(AN-1.0)*YVAR
      SSDXY=(AN-1.0)*COVXY
      RATIO=TSSQ/SSDX
C
      A=A1*A1 - RATIO
      B=2.0*(A0*A1 - A1*Y0 + RATIO*XBAR)
      C1=Y0*Y0 + A0*A0 - 2.0*A0*Y0
      C2=TSSQ*(1.0 + (1.0/AN) + (XBAR*XBAR)/SSDX)
      C=C1 - C2
      TERM3=B*B - 4.0*A*C
      TERM4=0.0
      IF(TERM3.GT.0.0)TERM4=SQRT(TERM3)
      EISEN=X0
      EISENL=(-B - TERM4)/(2.0*A)
      EISENU=(-B + TERM4)/(2.0*A)
C
C               ***********************************************
C               **  STEP 3.2--                               **
C               **  GRAYBILL AND IYER METHOD.                **
C               ***********************************************
C
      ISTEPN='3.2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      TERMA=A1*A1 - RATIO
      TERMB=TERMA*(1.0+(1.0/AN)) + ((Y0 - YBAR)**2)/SSDX
      TERMC=A1*(Y0-YBAR)
      TERMD=RESSD*T
      GRAYB=X0
      GRAYBL=XBAR + (TERMC - TERMD*SQRT(TERMB))/TERMA
      GRAYBU=XBAR + (TERMC + TERMD*SQRT(TERMB))/TERMA
C
C               ***********************************************
C               **  STEP 3.3--                               **
C               **  NETER, WASSERMAN, AND KUTNER             **
C               ***********************************************
C
      ISTEPN='3.3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      TERM=1.0 + (1.0/AN) + ((X0 - XBAR)**2)/SSDX
      SDX0=(RESSD/ABS(A1))*SQRT(TERM)
      ANWK=X0
      ANWKL=X0 - T*SDX0
      ANWKU=X0 + T*SDX0
C
C               ***********************************************
C               **  STEP 3.4--                               **
C               **  PROPOGATION OF ERROR                     **
C               ***********************************************
C
      ISTEPN='3.4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DSUM=0.0D0
      DO3410I=1,N
        DSUM=DSUM+DBLE(Y2(I))**2
 3410 CONTINUE
      DMEAN=DSUM/DBLE(N)
      AMNX2=REAL(DMEAN)
      TERM=AMNX2 + X0**2 + 2.0*X0*XBAR
      SDX0=(RESSD/(ABS(A1)*SQRT(SSDX)))*SQRT(TERM)
      PROPE=X0
      PROPEL=X0 - T*SDX0
      PROPEU=X0 + T*SDX0
C
C               ***********************************************
C               **  STEP 3.5--                               **
C               **  INVERSE (KRUTCHKOFF)                     **
C               ***********************************************
C
      ISTEPN='3.5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL LINFIT(Y2,Y1,NPTS,
     1B0,B1,RESSDX,RESDFX,CCXY2,SDB0,SDB1,CCALB2,
     1ISUBRO,IBUGA3,IERROR)
C
      C=T*RESSDX*(1.0 + (1.0/AN) + ((Y0-YBAR)**2)/SSDY)
      AINVR=XBAR + (SSDXY/SSDY)*(Y0-YBAR)
      AINVRL=AINVR - C
      AINVRU=AINVR + C
C
C               ***********************************************
C               **  STEP 3.6--                               **
C               **  MAXIMUM LIKELIHOOD                       **
C               ***********************************************
C
      ISTEPN='3.6'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO3610I=1,NPTS
        Z1(I)=Y2(I) - XBAR
 3610 CONTINUE
C
      CALL LINFIT(Y1,Z1,NPTS,
     1B0,B1,RESSDX,RESDFX,CCXY2,SDB0,SDB1,CCALB2,
     1ISUBRO,IBUGA3,IERROR)
C
      AMLE=0.0
      IF(B1.NE.0.0)AMLE=(Y0 - (B0-B1*XBAR))/B1
C
      NUMSIM=10000
      CALL NORRAN(NUMSIM,ISEED,Z2)
      CALL NORRAN(NUMSIM,ISEED,Z3)
C
      DO3620I=1,NUMSIM
        Z2(I)=SDB0*Z2(I) + B0
        Z3(I)=SDB1*Z3(I) + B1
        IF(Z3(I).NE.0.0)THEN
          Z4(I)=(Y0 - (Z2(I) - Z3(I)*XBAR))/Z3(I)
        ELSE
          Z4(I)=0.0
        ENDIF
 3620 CONTINUE
C
      P100=100.0*(ALPHA/2.0)
      CALL PERCEN(P100,Z4,NUMSIM,IWRITE,Z1,MAXNXT,
     1            AMLEL,IBUGA3,IERROR)
      P100=100.0*(1.0 - (ALPHA/2.0))
      CALL PERCEN(P100,Z4,NUMSIM,IWRITE,Z1,MAXNXT,
     1            AMLEU,IBUGA3,IERROR)
C
C               ***********************************************
C               **  STEP 3.7--                               **
C               **  BOOTSTRAP (EFROM RESAMPLING, I.E.,       **
C               **  RESAMPLE THE RESIDUALS)                  **
C               ***********************************************
C
      ISTEPN='3.7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL LINFIT(Y1,Y2,NPTS,
     1            B0,B1,XRESSD,XRESDF,CCXY,SDB0,SDB1,CCALBE,
     1            ISUBRO,IBUGA3,IERROR)
      DO3711I=1,NPTS
        Z1(I)=Y1(I)-(B0+B1*Y2(I))
 3711 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')THEN
         WRITE(ICOUT,3712)B0,B1
 3712    FORMAT('B0,B1 = ',2G15.7)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ICASJB='BOOT'
      NRESAM=1000
C
      DO3720IRESAM=1,NRESAM
        CALL DPJBS3(Z1,NPTS,ICASJB,IRESAM,ISEED,Z2,NPTS2,IZ,
     1              Z6,IBUGA3,IERROR)
        DO3722I=1,NPTS2
          Z3(I)=(B0+B1*Y2(I))+Z2(I)
 3722   CONTINUE
        CALL LINFIT(Z3,Y2,NPTS2,
     1      C0,C1,XRESSD,XRESDF,CCXY,SDC0,SDC1,CCALBE,
     1      ISUBRO,IBUGA3,IERROR)
        Z4(IRESAM)=(Y0-C0)/C1
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')THEN
          WRITE(ICOUT,3725)IERROR,IRESAM,C0,C1,Z4(IRESAM)
 3725     FORMAT('IERROR,IRESAM,C0,C1,Z4(IRESAM) = ',A4,I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
 3720 CONTINUE
C
      BOOTE=X0
      P100=100.0*(ALPHA/2.0)
      CALL PERCEN(P100,Z4,NRESAM,IWRITE,Z3,MAXNXT,
     1            BOOTEL,IBUGA3,IERROR)
      P100=100.0*(1.0 - ALPHA/2.0)
      CALL PERCEN(P100,Z4,NRESAM,IWRITE,Z3,MAXNXT,
     1            BOOTEU,IBUGA3,IERROR)
C
C               ***********************************************
C               **  STEP 3.8--                               **
C               **  BOOTSTRAP (WU RESAMPLING, I.E., RESAMPLE **
C               **  THE ORIGINAL (X,Y) DATA                  **
C               ***********************************************
C
      ISTEPN='3.8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASJB='BOOT'
      NRESAM=1000
C
      DO3810IRESAM=1,NRESAM
        CALL DPJBS3(Y1,NPTS,ICASJB,IRESAM,ISEED,Z1,NPTS2,IZ,
     1              Z6,IBUGA3,IERROR)
        DO3820IJ=1,NPTS2
          Z2(IJ)=Y2(IZ(IJ))
 3820   CONTINUE
        CALL LINFIT(Z1,Z2,NPTS2,
     1       C0,C1,XRESSD,XRESDF,CCXY,SDC0,SDC1,CCALBE,
     1       ISUBRO,IBUGA3,IERROR)
        Z4(IRESAM)=(Y0-C0)/C1
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')THEN
          WRITE(ICOUT,3822)IRESAM,C0,C1,Z4(IRESAM)
 3822     FORMAT('IRESAM,C0,C1,Z4(IRESAM) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
 3810 CONTINUE
C
      BOOTW=X0
      P100=100.0*(ALPHA/2.0)
      CALL PERCEN(P100,Z4,NRESAM,IWRITE,Z3,MAXNXT,
     1            BOOTWL,IBUGA3,IERROR)
      P100=100.0*(1.0 - ALPHA/2.0)
      CALL PERCEN(P100,Z4,NRESAM,IWRITE,Z3,MAXNXT,
     1            BOOTWU,IBUGA3,IERROR)
C
C               ***********************************************
C               **  STEP 4--                                 **
C               **  PRINT OUT THE RESULTS.                   **
C               ***********************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMETHD=1
      WRITE(IOUNI1,5401)IMETHD,Y0,EISEN,EISENL,EISENU
      IMETHD=2
      WRITE(IOUNI1,5401)IMETHD,Y0,GRAYB,GRAYBL,GRAYBU
      IMETHD=3
      WRITE(IOUNI1,5401)IMETHD,Y0,ANWK,ANWKL,ANWKU
      IMETHD=4
      WRITE(IOUNI1,5401)IMETHD,Y0,PROPE,PROPEL,PROPEU
      IMETHD=5
      WRITE(IOUNI1,5401)IMETHD,Y0,AINVR,AINVRL,AINVRU
      IMETHD=6
      WRITE(IOUNI1,5401)IMETHD,Y0,AMLE,AMLEL,AMLEU
      IMETHD=7
      WRITE(IOUNI1,5401)IMETHD,Y0,BOOTE,BOOTEL,BOOTEU
      IMETHD=8
      WRITE(IOUNI1,5401)IMETHD,Y0,BOOTW,BOOTWL,BOOTWU
 5401 FORMAT(I2,2X,4E15.7)
      WRITE(IOUNI2,5411)Y0,EISEN,GRAYB,ANWK,PROPE,AINVR,AMLE,
     1                  BOOTE,BOOTW
      WRITE(IOUNI3,5411)Y0,EISENL,GRAYBL,ANWKL,PROPEL,AINVRL,AMLEL,
     1                  BOOTEL,BOOTWL
      WRITE(IOUNI4,5411)Y0,EISENU,GRAYBU,ANWKU,PROPEU,AINVRU,AMLEU,
     1                  BOOTEU,BOOTWU
 5411 FORMAT(9E15.7)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5424)
 5423   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM COLSPAN=4>')
 5424   FORMAT('      <TH ALIGN=LEFT VALIGN=BOTTOM COLSPAN=4>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5431)Y0
 5431   FORMAT('         Y0 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5361)
 5361   FORMAT('         1. CLASSICAL (EISENHART:<BR>INVERSE ',
     1         'PREDICTION LIMITS):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)EISEN
 5371   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)EISENL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)EISENU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5363)
 5363   FORMAT('         2. GRAYBILL-IYER:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)GRAYB
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)GRAYBL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)GRAYBU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5365)
 5365   FORMAT('         3. NETER-WASSERMAN-KUTNER:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)ANWK
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)ANWKL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)ANWKU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5367)
 5367   FORMAT('         4. PROPOGATION OF ERROR:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)PROPE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)PROPEL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)PROPEU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5369)
 5369   FORMAT('         5. INVERSE (KRUTCHKOFF):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)AINVR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)AINVRL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)AINVRU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5373)
 5373   FORMAT('         6. MAXIMUM LIKELIHOOD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)AMLE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)AMLEL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)AMLEU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5375)
 5375   FORMAT('         7. BOOTSTRAP (RESAMPLE RESIDUALS):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTEL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTEU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5377)
 5377   FORMAT('         8. BOOTSTRAP (RESAMPLE DATA):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTW
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTWL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTWU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
CCCCC OCTOBER 2003: ADD SUPPORT FOR LATEX OUTPUT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8041 FORMAT(5X,'{',A1,'bf Linear Calibration Summary: Y0 = ',G15.7,'}')
C
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,Y0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8042 FORMAT(5X,A1,'begin{tabular} {|l|l|r|r|r|}')
 8043 FORMAT(5X,A1,'hline')
 8044 FORMAT(5X,'  &  & 95',A1,'% & 95',A1,'% ',A1,A1)
 8045 FORMAT(5X,'Method & X0 & Lower Limit & Upper Limit ',A1,A1)
 8051 FORMAT(5X,'1. Classical (Eisenhart &  &  &  ',A1,A1)
 8052 FORMAT(5X,'   Inverse Prediction Limits:',3(' & ',G15.7),A1,A1)
 8053 FORMAT(5X,'2. Graybill-Iyer:',3(' & ',G15.7),A1,A1)
 8054 FORMAT(5X,'3. Neter-Wasserman-Kutner:',3(' & ',G15.7),A1,A1)
 8055 FORMAT(5X,'4. Propogation of Error:',3(' & ',G15.7),A1,A1)
 8056 FORMAT(5X,'5. Inverse (Krutchkoff):',3(' & ',G15.7),A1,A1)
 8057 FORMAT(5X,'6. Maximum Likelihood:',3(' & ',G15.7),A1,A1)
 8058 FORMAT(5X,'7. Bootstrap (resample residuals):',3(' & ',G15.7),
     1       A1,A1)
 8059 FORMAT(5X,'8. Bootstrap (resample data):',3(' & ',G15.7),A1,A1)
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8042)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8051)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8052)EISEN,EISENL,EISENU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8053)GRAYB,GRAYBL,GRAYBU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8054)ANWK,ANWKL,ANWKU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8055)PROPE,PROPEL,PROPEU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8056)AINVR,AINVRL,AINVRU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8057)AMLE,AMLEL,AMLEU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8058)BOOTE,BOOTEL,BOOTEU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8059)BOOTW,BOOTWL,BOOTWU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
C
        WRITE(ICOUT,6355)Y0
 6355   FORMAT('Y0 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6361)EISEN,EISENL,EISENU
 6361   FORMAT(' 1. INVERSE PREDICTION LIMITS:',G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6363)GRAYB,GRAYBL,GRAYBU
 6363   FORMAT(' 2. GRAYBILL-IYER:',12X,G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6367)ANWK,ANWKL,ANWKU
 6367   FORMAT(' 3. NETER-WASSERMAN-KUTNER:',3X,G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6371)PROPE,PROPEL,PROPEU
 6371   FORMAT(' 4. PROPOGATION OF ERROR:',5X,G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6375)AINVR,AINVRL,AINVRU
 6375   FORMAT(' 5. INVERSE (KRUTCHKOFF):',5X,G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6379)AMLE,AMLEL,AMLEU
 6379   FORMAT(' 6. MAXIMUM LIKELIHOOD:',7X,G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6383)BOOTE,BOOTEL,BOOTEU
 6383   FORMAT(' 7. BOOTSTRAP (RESIDUALS):',4X,G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6387)BOOTW,BOOTWL,BOOTWU
 6387   FORMAT(' 8. BOOTSTRAP (DATA):',9X,G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      GOTO3000
C
 3999 CONTINUE
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5991)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5993)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7991)
 7991   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC OCTOBER 2003: ADD SUPPORT FOR LATEX OUTPUT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8190 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8190)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
C
        WRITE(ICOUT,6327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      IF(IFEEDB.EQ.'ON')THEN
C
        WRITE(ICOUT,8102)
 8102   FORMAT('FOLLOWING INFORMATION WRITTEN OUT TO FILES.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8112)
 8112   FORMAT('DPST1F.DAT: METHOD (1 - 8), Y0, X0, LOWER LIMIT, ',
     1         'UPPER LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)
 8122   FORMAT('DPST2F.DAT: Y0 AND X0 FOR ALL EIGHT METHODS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8132)
 8132   FORMAT('DPST3F.DAT: Y0 AND LOWER LIMIT FOR ALL EIGHT METHODS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8142)
 8142   FORMAT('DPST4F.DAT: Y0 AND UPPER LIMIT FOR ALL EIGHT METHODS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IENDF3,IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IENDF4='OFF'
      IREWI4='ON'
      CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LIC2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPLIC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA3,IERROR
 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NUMVAR
 9013   FORMAT('NPTS,NUMVAR = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLIC3(Y1,Y2,Y3,NPTS,NCALPT,NUMVAR,
     1Z1,Z2,Z3,Z4,Z5,Z6,IZ,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,
     1ALPHA,MAXNXT,ISEED,
     1EISEN,EISENL,EISENU,
     1GRAYB,GRAYBL,GRAYBU,
     1ANWK,ANWKL,ANWKU,
     1PROPE,PROPEL,PROPEU,
     1AINVR,AINVRL,AINVRU,
     1AMLE,AMLEL,AMLEU,
     1BOOTE,BOOTEL,BOOTEU,
     1BOOTW,BOOTWL,BOOTWU,
     1CBAYE,CBAYEL,CBAYEU,
     1FBAYE,FBAYEL,FBAYEU,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--PERFORM A QUADRATIC CALIBRATRION ANALYSIS.
C              A QUADRATIC CALIBRATION WILL BE PERFORMED USING THE
C              FOLLOWING TECHNIQUES:
C               1) CLASSICAL (EISENHART: INVERSE PREDICTION LIMITS)
C               2) BOOTSTRAP (EFRON)
C               3) BOOTSTRAP (WU)
C     PRINTING--YES
C     SUBROUTINES NEEDED--QUAFIT, TPPF
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--2003/7
C     ORIGINAL VERSION--JULY      2003.
C     UPDATED         --OCTOBER   2003. ADD SUPPORT FOR LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ICASAN
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IPTEMP
C
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
C
      CHARACTER*4 ICASJB
C
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
      CHARACTER*80 IFILE4
      CHARACTER*12 ISTAT4
      CHARACTER*12 IFORM4
      CHARACTER*12 IACCE4
      CHARACTER*12 IPROT4
      CHARACTER*12 ICURS4
      CHARACTER*4 IERRF4
      CHARACTER*4 IENDF4
      CHARACTER*4 IREWI4
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 ICOMT
      CHARACTER*4 ICOM2T
      PARAMETER (MAXART=20)
      CHARACTER*4 ITHARG
      CHARACTER*4 ITHAR2
      CHARACTER*4 ITARGT
      CHARACTER*4 IANST
      DIMENSION ITHARG(MAXART)
      DIMENSION ITHAR2(MAXART)
      DIMENSION ITARG(MAXART)
      DIMENSION TARG(MAXART)
      DIMENSION ITARGT(MAXART)
      DIMENSION IANST(MAXSTR)
C
C----------------------------------------------------------------
C
      REAL Y1(*)
      REAL Y2(*)
      REAL Y3(*)
C
      REAL Z1(*)
      REAL Z2(*)
      REAL Z3(*)
      REAL Z4(*)
      REAL Z5(*)
      REAL Z6(*)
      INTEGER IZ(*)
C
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DMEAN
      DOUBLE PRECISION DX
      DOUBLE PRECISION DY
      DOUBLE PRECISION DA0
      DOUBLE PRECISION DA1
      DOUBLE PRECISION DA2
      DOUBLE PRECISION DC0
      DOUBLE PRECISION DC1
      DOUBLE PRECISION DC2
      DOUBLE PRECISION DC3
      DOUBLE PRECISION DC4
      DOUBLE PRECISION DC6
      DOUBLE PRECISION DEPS
      DOUBLE PRECISION DSIG
      DOUBLE PRECISION DZERO
      DOUBLE PRECISION DY0
      DOUBLE PRECISION DXL
      DOUBLE PRECISION DXR
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DXRML
      DOUBLE PRECISION DXTEMP
      DOUBLE PRECISION DFXL
      DOUBLE PRECISION DFXR
      DOUBLE PRECISION DFCS
C
      CHARACTER*4 IPRNT2
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
      IERROR='NO'
      IPRNT2=IPRINT
C
      ISUBN1='DPLI'
      ISUBN2='C3  '
C
      EISEN=0.0
      EISENL=0.0
      EISENU=0.0
      GRAYB=0.0
      GRAYBL=0.0
      GRAYBU=0.0
      ANWK=0.0
      ANWKL=0.0
      ANWKU=0.0
      PROPE=0.0
      PROPEL=0.0
      PROPEU=0.0
      AINVR=0.0
      AINVRL=0.0
      AINVRU=0.0
      AMLE=0.0
      AMLEL=0.0
      AMLEU=0.0
      BOOTE=0.0
      BOOTEL=0.0
      BOOTEU=0.0
      BOOTW=0.0
      BOOTWL=0.0
      BOOTWU=0.0
      CBAYE=0.0
      CBAYEL=0.0
      CBAYEU=0.0
      FBAYE=0.0
      FBAYEL=0.0
      FBAYEU=0.0
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LIC3')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPLIC3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NCALPT,NUMVAR
   52   FORMAT('NPTS,NCALPT,NUMVAR = ',3I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NPTS
          WRITE(ICOUT,56)I,Y1(I),Y2(I)
   56     FORMAT('I,Y1(I),Y2(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
        DO65I=1,NCALPT
          WRITE(ICOUT,66)I,Y3(I)
   66     FORMAT('I,Y3(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
   65   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NPTS.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,101)
  101   FORMAT('***** ERROR IN DPLIC3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,102)
  102   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE QUADRATIC ',
     1         'CALIBRATION MUST BE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,103)NPTS
  103   FORMAT('      AT LEAST 2; THE ENTERED NUMBER OF ',
     1         'OBSERVATIONS = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ********************************************
C               **  STEP 1B--                             **
C               **  PERFORM A QUADRATIC FIT ON ORIGINAL   **
C               **  DATA; SAVE RELEVANT PARAMETERS        **
C               **  (COEFFICIENTS, COEFFICIENT SD'S,      **
C               **  T-VALUES, RESSD)                      **
C               ********************************************
C
      ISTEPN='1.B'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
C  SAVE ORIGINAL COMMAND LINE
C
      ICOMT=ICOM
      ICOM2T=ICOM2
      NUMART=NUMARG
      DO100I=1,NUMARG
        ITHARG(I)=IHARG(I)
        ITHAR2(I)=IHARG2(I)
        ITARG(I)=IARG(I)
        TARG(I)=ARG(I)
        ITARGT(I)=IARGT(I)
  100 CONTINUE
      DO112I=1,MAXSTR
        IANST(I)=IANS(I)
  112 CONTINUE
      IWIDT=IWIDTH
C
C  GENERATE A "QUADRATIC FIT Y X" COMMAND
C
      ICOM='QUAD'
      ICOM2='RATI'
      IHARG(1)='FIT '
      IHARG2(1)='    '
      IHARG(2)=IHLEFT
      IHARG2(2)=IHLEF2
      IHARG(3)=IHRIGH
      IHARG2(3)=IHRIG2
      ICASAN='FIT'
      IBUGG2='OFF'
      IBUGG3='OFF'
      IBUGCO='OFF'
      IBUGEV='OFF'
      IBUGQ='OFF'
C
      IPRINT='OFF'
      CALL DPFIT(ICAPSW,IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,
     1           IFOUND,IERROR)
C
      IPRINT=IPRNT2
C
C  RESTORE ORIGINAL COMMAND LINE
C
      NUMARG=NUMART
      ICOM=ICOMT
      ICOM2=ICOM2T
      DO900I=1,NUMARG
        IHARG(I)=ITHARG(I)
        IHARG2(I)=ITHAR2(I)
        IARG(I)=ITARG(I)
        ARG(I)=TARG(I)
        IARGT(I)=ITARGT(I)
  900 CONTINUE
      DO902I=1,MAXSTR
        IANS(I)=IANST(I)
  902 CONTINUE
      IWIDTH=IWIDT
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='LIC3'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      READ(IOUNI1,*,ERR=959,END=959)A0,SDA0,TA0
      READ(IOUNI1,*,ERR=959,END=959)A1,SDA1,TA1
      READ(IOUNI1,*,ERR=959,END=959)A2,SDA2,TA2
      GOTO969
C
  959 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,961)
  961 FORMAT('***** ERROR FROM QUADRATIC CALIBRATION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,963)
  963 FORMAT('      UNABLE TO PERFORM THE INITIAL QUADRATIC FIT.')
      CALL DPWRST('XXX','BUG ')
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IERROR='YES'
      GOTO9000
C
  969 CONTINUE
      IHP='RESS'
      IHP2='D   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      RESSD=VALUE(ILOCP)
      IHP='RESD'
      IHP2='F   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      RESDF=VALUE(ILOCP)
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
C
      IOUNI4=IST4NU
      IFILE4=IST4NA
      ISTAT4=IST4ST
      IFORM4=IST4FO
      IACCE4=IST4AC
      IPROT4=IST4PR
      ICURS4=IST4CS
      ISUBN0='LIC3'
      IERRF4='NO'
C
      IREWI4='ON'
      CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
      READ(IOUNI4,*,ERR=979,END=979)B11
      READ(IOUNI4,*,ERR=979,END=979)B21
      READ(IOUNI4,*,ERR=979,END=979)B31
      READ(IOUNI4,*,ERR=979,END=979)B12
      READ(IOUNI4,*,ERR=979,END=979)B22
      READ(IOUNI4,*,ERR=979,END=979)B32
      READ(IOUNI4,*,ERR=979,END=979)B13
      READ(IOUNI4,*,ERR=979,END=979)B23
      READ(IOUNI4,*,ERR=979,END=979)B33
      GOTO989
C
  979 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,971)
  971 FORMAT('***** ERROR FROM QUADRATIC CALIBRATION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,973)
  973 FORMAT('      UNABLE TO PERFORM THE INITIAL QUADRATIC FIT.')
      CALL DPWRST('XXX','BUG ')
      IENDF4='OFF'
      IREWI4='ON'
      CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IERROR='YES'
      GOTO9000
C
  989 CONTINUE
C
      C0=B11
      C1=B12+B21
      C2=B13+B22+B31
      C3=B23+B32
      C4=B33
C
      IDF=N-3
      CALL TPPF((1.0-ALPHA)/2.0,IDF,TVAL)
      C6=TVAL*RESSD
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
        WRITE(ICOUT,991)A0,SDA0,TA0
  991   FORMAT('AFTER QUADRATIC FIT, A0,SDA0,TA0=',3G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,992)A1,SDA1,TA1
  992   FORMAT('AFTER QUADRATIC FIT, A1,SDA1,TA1=',3G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,993)A2,SDA2,TA2
  993   FORMAT('AFTER QUADRATIC FIT, A2,SDA2,TA2=',3G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,994)RESSD,RESDF
  994   FORMAT('AFTER QUADRATIC FIT, RESSD,RESDF=',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **************************************************
C               **  STEP 1.1--                                  **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
      ISTEPN='1.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='LIC3'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='LIC3'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='LIC3'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IOUNI4=IST4NU
      IFILE4=IST4NA
      ISTAT4=IST4ST
      IFORM4=IST4FO
      IACCE4=IST4AC
      IPROT4=IST4PR
      ICURS4=IST4CS
      ISUBN0='LIC3'
      IERRF4='NO'
C
      IREWI4='ON'
      CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               ***********************************************
C               **  STEP 2--                                 **
C               **  PRINT OUT SUMMARY OF FIT INFORMATION     **
C               ***********************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5101)
 5101   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5102)
 5102   FORMAT('<H1>QUADRATIC CALIBRATION ANALYSIS</H1>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5104)
 5104   FORMAT('<BR><BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
 5107   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('<TABLE BORDER CELLPADDING=5 CELLSPACING=5>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
 5113   FORMAT('   <CAPTION ALIGN=CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)IHLEFT,IHLEF2,IHRIGH,IHRIG2
 5115   FORMAT('      <B>SUMMARY OF THE LINEAR FIT BETWEEN ',
     1         A4,A4,' AND ',A4,A4,'</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
 5119   FORMAT('   </CAPTION>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
 5121   FORMAT('   <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
 5123   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
 5125   FORMAT('         NUMBER OF OBSERVATIONS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
 5127   FORMAT('      </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
 5126   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)NPTS
 5129   FORMAT('         ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
 5128   FORMAT('   </TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5141)
 5141   FORMAT('         EQUATION OF FITTED LINE:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)IHLEFT,IHLEF2,A0,A1,IHRIGH,IHRIG2,
     1                   A2,IHRIGH,IHRIG2
 5151   FORMAT('         ',A4,A4,' = ',G15.7,' + ',G15.7,' * ',A4,A4,
     1         ' + ',G15.7,' * ',A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5142)
 5142   FORMAT('         RESIDUAL STANDARD DEVIATION:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)RESSD
 5152   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5146)
 5146   FORMAT('         SD(INTERCEPT):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)SDA0
 5154   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
 5147   FORMAT('         T(INTERCEPT):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5156)TA0
 5156   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5144)
 5144   FORMAT('         SD(LINEAR TERM):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5164)SDA1
 5164   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
 5149   FORMAT('         T(LINEAR TERM):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5153)TA1
 5153   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7144)
 7144   FORMAT('         SD(QUADRATIC TERM):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7164)SDA2
 7164   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7149)
 7149   FORMAT('         T(QUADRATIC TERM):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7153)TA2
 7153   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5991)
 5991   FORMAT('</TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5993)
 5993   FORMAT('</UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5995)
 5995   FORMAT('<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5995)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5307)
 5307   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5311)
 5311   FORMAT('<TABLE BORDER CELLSPACING=5 CELLPADDING=5>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
 5313   FORMAT('   <CAPTION ALIGN=CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5315)
 5315   FORMAT('      <B>QUADRATIC CALIBRATION SUMMARY</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
 5319   FORMAT('   </CAPTION>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
 5321   FORMAT('   <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
 5323   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5341)
 5341   FORMAT('         METHOD')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
 5327   FORMAT('      </TD>')
 5329   FORMAT('      </TH>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
 5326   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5351)
 5351   FORMAT('         X0')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        ATEMP=1.0-ALPHA
        ITEMP=100.*ATEMP + 0.00001
        WRITE(ICOUT,5355)ITEMP
 5355   FORMAT('         ',I2,'% <BR>LOWER LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5357)ITEMP
 5357   FORMAT('         ',I2,'%<BR> UPPER LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
 5328   FORMAT('   </TR>')
        CALL DPWRST('XXX','WRIT')
C
CCCCC OCTOBER 2003: ADD LATEX SUPPORT.
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8001 FORMAT('{',A1,'bf QUADRATIC CALIBRATION ANALYSIS}')
 8002 FORMAT(A1,A1)
 8003 FORMAT(5X,'{',A1,
     1      'bf Summary of the Quadratic Fit Between Y and X}')
 8007 FORMAT(A1,'begin{center}')
 8009 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8010 FORMAT(A1,'end{center}')
 8012 FORMAT(A1,'end{verbatim}')
 8013 FORMAT(A1,'begin{table}')
 8014 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8016 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Equation of the Fitted Line: & ',
     1       A4,A4,' = ',G15.7,' + ',G15.7,'*',A4,A4,
     1       ' + ',G15.7,'*',A4,A4,'**2',2X,A1,A1)
 8023 FORMAT(5X,'Residual Standard Deviation: & ',E15.7,2X,A1,A1)
 8024 FORMAT(5X,'SD(Intercept): & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'T(Intercept): & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'SD(Linear Term): & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'T(Linear Term): & ',G15.7,2X,A1,A1)
 8126 FORMAT(5X,'SD(Quadratic Term): & ',G15.7,2X,A1,A1)
 8127 FORMAT(5X,'T(Quadratic Term): & ',G15.7,2X,A1,A1)
 8029 FORMAT(A1,'end{table}')
 8030 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)NPTS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)IHLEFT,IHLEF2,A0,A1,IHRIGH,IHRIG2,A2,
     1                   IHRIGH,IHRIG2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)RESSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)SDA0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)TA0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)SDA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)TA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)SDA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8127)TA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,231)
  231   FORMAT('            QUADRATIC CALIBRATION ANALYSIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,233)IHLEFT,IHLEF2,IHRIGH,IHRIG2
  233   FORMAT('      SUMMARY OF THE QUADRATIC FIT BETWEEN ',
     1         A4,A4,' AND ',A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,235)NPTS
  235   FORMAT('NUMBER OF OBSERVATIONS:        ',7X,I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,237)A0
  237   FORMAT('ESTIMATE OF INTERCEPT           ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,239)SDA0
  239   FORMAT('SD(INTERCEPT)                   ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,240)TA0
  240   FORMAT('T(INTERCEPT)                    ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,247)A1
  247   FORMAT('ESTIMATE OF LINEAR TERM         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,249)SDA1
  249   FORMAT('SD(LINEAR TERM)                 ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,250)TA1
  250   FORMAT('T(LINEAR TERM)                  ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,253)A2
  253   FORMAT('ESTIMATE OF QUADRATIC TERM      ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,252)SDA2
  252   FORMAT('SD(QUADRATIC TERM)              ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,251)TA2
  251   FORMAT('T(QUADRATIC TERM)               ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,254)RESSD
  254   FORMAT('RESIDUAL STANDARD DEVIATION:     ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6315)
 6315   FORMAT('      QUADRATIC CALIBRATION SUMMARY')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=1.0-ALPHA
        ITEMP=100.*ATEMP + 0.00001
        WRITE(ICOUT,6340)ITEMP,ITEMP
 6340   FORMAT(52X,I2,'%',12X,I2,'%')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6341)
 6341   FORMAT(13X,'METHOD',18X,'X0',8X,'LOWER LIMIT',6X,
     1         'UPPER LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6327)
 6327   FORMAT('------------------------',
     1         '------------------------',
     1         '---------------------------')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               **************************************************
C               **  STEP 3--                                    **
C               **  COMPUTE THE QUADRATIC CALIBRATION ESTIMATES **
C               **  USING VARIOUS METHODS.                      **
C               **************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUNT=0
 3000 CONTINUE
      ICOUNT=ICOUNT+1
      IF(ICOUNT.GT.NCALPT)GOTO3999
      Y0=Y3(ICOUNT)
C
C  FIND X0 (THIS APPLIES TO MOST METHODS, SO DO ONCE HERE
C  RATHER THAN FOR EACH METHOD.
C
      CALL MINIM(Y2,NPTS,IWRITE,XLEFT,IBUGA3,IERROR)
      CALL MAXIM(Y2,NPTS,IWRITE,XRIGHT,IBUGA3,IERROR)
      C=A0 - Y0
      B=A1
      A=A2
      X0=0.0
      TERM1=B**2 - 4.0*A*C
C
C  FIND SOME BOUNDING PARAMETERS
C
      RIGH10=0.0
      RIGH20=0.0
      IF(TERM1.GE.0.0)THEN
        TERM1=SQRT(TERM1)
        RIGH10=(-B + TERM1)/(2*A)
        RIGH20=(-B - TERM1)/(2*A)
      ENDIF
      IF(RIGH10.GE.XLEFT .AND. RIGH10.LE.XRIGHT)THEN
        RIGHT0=RIGH10
      ELSEIF(RIGH20.GE.XLEFT .AND. RIGH20.LE.XRIGHT)THEN
        RIGHT0=RIGH20
      ELSE
        RIGHT0=RIGH10
      ENDIF
C
C  FIND ESTIMATE OF X0
C
      TERM1=B**2 - 4.0*A*C
      IF(TERM1.EQ.0.0)THEN
        RIGHT=(-B + TERM1)/(2*A)
      ELSEIF(TERM1.GT.0.0)THEN
        TERM1=SQRT(TERM1)
        RIGH1=(-B + TERM1)/(2*A)
        RIGH2=(-B - TERM1)/(2*A)
        IF(RIGH1.GE.XLEFT .AND. RIGH1.LE.XRIGHT)THEN
          IF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
            D1DIFF=ABS(RIGH1-RIGHT0)
            D2DIFF=ABS(RIGH2-RIGHT0)
            IF(D1DIFF.LE.D2DIFF)THEN
              RIGHT=RIGH1
            ELSE
              RIGHT=RIGH2
            ENDIF
          ELSE
            RIGHT=RIGH1
          ENDIF
        ELSEIF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
          RIGHT=RIGH2
        ELSE
          IF(RIGH1.GT.0.0 .AND. RIGH2.LE.0.0)THEN
            RIGHT=RIGH1
          ELSEIF(RIGH2.GT.0.0 .AND. RIGH1.LE.0.0)THEN
            RIGHT=RIGH2
          ELSE
            D1DIFF=ABS(RIGH1-RIGHT0)
            D2DIFF=ABS(RIGH2-RIGHT0)
            IF(D1DIFF.LE.D2DIFF)THEN
              RIGHT=RIGH1
            ELSE
              RIGHT=RIGH2
            ENDIF
          ENDIF
        ENDIF
      ELSEIF(TERM1.LT.0.0)THEN
        IERROR='YES'
        WRITE(ICOUT,3002)
 3002   FORMAT('***** ERROR IN QUADRATIC CALIBRATION.  NO REAL')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3004)
 3004   FORMAT('      ROOTS FOR QUADRATIC FIT OF ORIGINAL ',
     1         'DATA.')
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      X0=RIGHT
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
        WRITE(ICOUT,3012)RIGH10,RIGH20,RIGHT0
 3012   FORMAT('FULL SAMPLE ROOTS: RIGH10,RIGH20,RIGHT0 = ',3E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3013)RIGHT,X0,RIGH1,RIGH2
 3013   FORMAT('RIGHT,X0,RIGH1,RIGH2 = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***********************************************
C               **  STEP 3.1--                               **
C               **  CLASSICAL: EISENHART INVERTED PREDICTION **
C               **  LIMITS.                                  **
C               ***********************************************
C
      ISTEPN='3.11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  FIND ROOTS OF 4TH DEGREE POLYNOMIAL USING A BISECTION METHOD
C
 3109 CONTINUE
C
      EISEN=X0     
      DEPS=0.000001D0
      DSIG=1.0D-6
      MAXIT=2000
      DZERO=0.0D0
      DY0=DBLE(Y0)
      IC = 0
      DXL=DBLE(XLEFT)
      DXR=DBLE(XRIGHT)
      DA0=DBLE(A0)
      DA1=DBLE(A1)
      DA2=DBLE(A2)
      DC0=DBLE(C0)
      DC1=DBLE(C1)
      DC2=DBLE(C2)
      DC3=DBLE(C3)
      DC4=DBLE(C4)
      DC6=DBLE(C6)
C
      DTERM1 = DA0 + DA1*DXL + DA2*DXL*DXL - DY0
      DTERM2 = DC0 + DC1*DXL + DC2*DXL**2 + DC3*DXL**3 + DC4*DXL**4
      DFXL = DTERM1 + DC6*DSQRT(1.0D0 + DTERM2)
      DTERM1 = DA0 + DA1*DXR + DA2*DXR*DXR - DY0
      DTERM2 = DC0 + DC1*DXR + DC2*DXR**2 + DC3*DXR**3 + DC4*DXR**4
      DFXR = DTERM1 + DC6*DSQRT(1.0D0 + DTERM2)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
        ISTEPN='3.12'
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,3104)DXL,DXR,DFXL,DFXR
 3104   FORMAT('DXL,DXR,DFXL,DFXR = ',4G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
 3105 CONTINUE
C
      DXTEMP = (DXL+DXR)*0.5D0
      DTERM1 = DA0 + DA1*DXTEMP + DA2*DXTEMP*DXTEMP - DY0
      DTERM2 = DC0 + DC1*DXTEMP + DC2*DXTEMP**2 + DC3*DXTEMP**3
     1         + DC4*dXTEMP**4
      DFCS = DTERM1 + DC6*DSQRT(1.0D0 + DTERM2)
      IF(DFCS*DFXL.GT.DZERO)GOTO3110
      DXR = DXTEMP
      DFXR = DFCS 
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
        ISTEPN='3.13'
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,3124)DXL,DXR,DXTEMP,DFXL,DFXR,DFCS
 3124   FORMAT('DXL,DXR,DXTEMP,DFXL,DFXR,DFCS = ',6G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      GOTO3115
 3110 CONTINUE
      DXL = DXTEMP
      DFXL = DFCS
 3115 CONTINUE
      DXRML = DXR - DXL
      IF(DXRML.LE.DSIG .AND. DABS(DFCS).LE.DEPS)GOTO3149
      IC = IC + 1
      IF(IC.LE.MAXIT)GOTO3105
      WRITE(ICOUT,3130)
      CALL DPWRST('XXX','BUG ')
 3130 FORMAT('***** ERROR IN QUADRATIC CALIBRATION: NO CONVERGENCE.')
      EISENL=0.0     
      EISENU=0.0     
      GOTO3199
C
 3149 CONTINUE
      EISENU=REAL(DXTEMP)
C
      IC = 0
      DXL=DBLE(XLEFT)
      DXR=DBLE(XRIGHT)
      DTERM1 = DA0 + DA1*DXL + DA2*DXL*DXL - DY0
      DTERM2 = DC0 + DC1*DXL + DC2*DXL**2 + DC3*DXL**3 + DC4*DXL**4
      DFXL = DTERM1 - DC6*DSQRT(1.0D0 + DTERM2)
      DTERM1 = DA0 + DA1*DXR + DA2*DXR*DXR - DY0
      DTERM2 = DC0 + DC1*DXR + DC2*DXR**2 + DC3*DXR**3 + DC4*DXR**4
      DFXR = DTERM1 - DC6*DSQRT(1.0D0 + DTERM2)
C
 3155 CONTINUE
C
      DXTEMP = (DXL+DXR)*0.5D0
      DTERM1 = DA0 + DA1*DXTEMP + DA2*DXTEMP*DXTEMP - DY0
      DTERM2 = DC0 + DC1*DXTEMP + DC2*DXTEMP**2 + DC3*DXTEMP**3
     1         + DC4*DXTEMP**4
      DFCS = DTERM1 - DC6*DSQRT(1.0D0 + DTERM2)
      IF(DFCS*DFXL.GT.DZERO)GOTO3160
      DXR = DXTEMP
      DFXR = DFCS 
      GOTO3175
 3160 CONTINUE
      DXL = DXTEMP
      DFXL = DFCS
 3175 CONTINUE
      DXRML = DXR - DXL
      IF(DXRML.LE.DSIG .AND. DABS(DFCS).LE.DEPS)GOTO3189
      IC = IC + 1
      IF(IC.LE.MAXIT)GOTO3155
      WRITE(ICOUT,3180)
      CALL DPWRST('XXX','BUG ')
 3180 FORMAT('***** ERROR IN QUADRATIC CALIBRATION: NO CONVERGENCE.')
      EISENL=0.0     
      EISENU=0.0     
      GOTO3199
C
 3189 CONTINUE
      EISENL=REAL(DXTEMP)
C
      IF(EISENL.GT.EISENU)THEN
        ATEMP=EISENL
        EISENL=EISENH
        EISENH=ATEMP
      ENDIF
C
 3199 CONTINUE
C
C
C               ***********************************************
C               **  STEP 3.2--                               **
C               **  GRAYBILL AND IYER METHOD.                **
C               ***********************************************
C
CCCCC ISTEPN='3.2'
CCCCC IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC TERMA=A1*A1 - RATIO
CCCCC TERMB=TERMA*(1.0+(1.0/AN)) + ((Y0 - YBAR)**2)/SSDX
CCCCC TERMC=A1*(Y0-YBAR)
CCCCC TERMD=RESSD*T
CCCCC GRAYB=X0
CCCCC GRAYBL=XBAR + (TERMC - TERMD*SQRT(TERMB))/TERMA
CCCCC GRAYBU=XBAR + (TERMC + TERMD*SQRT(TERMB))/TERMA
C
C               ***********************************************
C               **  STEP 3.3--                               **
C               **  NETER, WASSERMAN, AND KUTNER             **
C               ***********************************************
C
CCCCC ISTEPN='3.3'
CCCCC IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC TERM=1.0 + (1.0/AN) + ((X0 - XBAR)**2)/SSDX
CCCCC SDX0=(RESSD/ABS(A1))*SQRT(TERM)
CCCCC ANWK=X0
CCCCC ANWKL=X0 - T*SDX0
CCCCC ANWKU=X0 + T*SDX0
C
C               ***********************************************
C               **  STEP 3.4--                               **
C               **  PROPOGATION OF ERROR                     **
C               ***********************************************
C
CCCCC ISTEPN='3.4'
CCCCC IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC DSUM=0.0D0
CCCCC DO3410I=1,N
CCCCC   DSUM=DSUM+DBLE(Y2(I))**2
 3410 CONTINUE
CCCCC DMEAN=DSUM/DBLE(N)
CCCCC AMNX2=REAL(DMEAN)
CCCCC TERM=AMNX2 + X0**2 + 2.0*X0*XBAR
CCCCC SDX0=(RESSD/(ABS(A1)*SQRT(SSDX)))*SQRT(TERM)
CCCCC PROPE=X0
CCCCC PROPEL=X0 - T*SDX0
CCCCC PROPEU=X0 + T*SDX0
C
C               ***********************************************
C               **  STEP 3.5--                               **
C               **  INVERSE (KRUTCHKOFF)                     **
C               ***********************************************
C
CCCCC ISTEPN='3.5'
CCCCC IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC CALL LINFIT(Y2,Y1,NPTS,
CCCCC1B0,B1,RESSDX,RESDFX,CCXY2,SDB0,SDB1,CCALB2,
CCCCC1ISUBRO,IBUGA3,IERROR)
C
CCCCC C=T*RESSDX*(1.0 + (1.0/AN) + ((Y0-YBAR)**2)/SSDY)
CCCCC AINVR=XBAR + (SSDXY/SSDY)*(Y0-YBAR)
CCCCC AINVRL=AINVR - C
CCCCC AINVRU=AINVR + C
C
C               ***********************************************
C               **  STEP 3.6--                               **
C               **  MAXIMUM LIKELIHOOD                       **
C               ***********************************************
C
CCCCC ISTEPN='3.6'
CCCCC IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC DO3610I=1,NPTS
CCCCC   Z1(I)=Y2(I) - XBAR
 3610 CONTINUE
C
CCCCC CALL LINFIT(Y1,Z1,NPTS,
CCCCC1B0,B1,RESSDX,RESDFX,CCXY2,SDB0,SDB1,CCALB2,
CCCCC1ISUBRO,IBUGA3,IERROR)
C
CCCCC AMLE=0.0
CCCCC IF(B1.NE.0.0)AMLE=(Y0 - (B0-B1*XBAR))/B1
C
CCCCC NUMSIM=10000
CCCCC CALL NORRAN(NUMSIM,ISEED,Z2)
CCCCC CALL NORRAN(NUMSIM,ISEED,Z3)
C
CCCCC DO3620I=1,NUMSIM
CCCCC   Z2(I)=SDB0*Z2(I) + B0
CCCCC   Z3(I)=SDB1*Z3(I) + B1
CCCCC   IF(Z3(I).NE.0.0)THEN
CCCCC     Z4(I)=(Y0 - (Z2(I) - Z3(I)*XBAR))/Z3(I)
CCCCC   ELSE
CCCCC     Z4(I)=0.0
CCCCC   ENDIF
 3620 CONTINUE
C
CCCCC P100=100.0*(ALPHA/2.0)
CCCCC CALL PERCEN(P100,Z4,NUMSIM,IWRITE,Z1,MAXNXT,
CCCCC1            AMLEL,IBUGA3,IERROR)
CCCCC P100=100.0*(1.0 - (ALPHA/2.0))
CCCCC CALL PERCEN(P100,Z4,NUMSIM,IWRITE,Z1,MAXNXT,
CCCCC1            AMLEU,IBUGA3,IERROR)
C
C               ***********************************************
C               **  STEP 3.7--                               **
C               **  BOOTSTRAP (EFROM RESAMPLING, I.E.,       **
C               **  RESAMPLE THE RESIDUALS)                  **
C               ***********************************************
C
      ISTEPN='3.7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,3714)A0,A1,A2
 3714   FORMAT('A0,A1,A2 = ',3G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      DO3716I=1,NPTS
CCCCC   DY=DBLE(Y1(I))
CCCCC   DX=DBLE(Y2(I))
CCCCC   DTERM1=DBLE(A0) + DBLE(A1)*DX + DBLE(A2)*DX*DX
CCCCC   Z1(I)=REAL(DY - DTERM1)
        Z1(I)=RES(I)
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
           WRITE(ICOUT,3717)I,Y1(I),Y2(I),Z1(I)
 3717      FORMAT('I,Y1(I),Y2(I),Z1(I) (=Y,X,RES) =',I8,4G15.7)
           CALL DPWRST('XXX','BUG ')
        ENDIF
 3716 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
         WRITE(ICOUT,3718)A0,A1,A2
 3718    FORMAT('A0,A1,A2 = ',3G15.7)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ICASJB='BOOT'
      NRESAM=1000
      NREJ=0
      NNEG=0
      NCOUNT=0
C
      DO3720IRESAM=1,NRESAM
        CALL DPJBS3(Z1,NPTS,ICASJB,IRESAM,ISEED,Z2,NPTS2,IZ,
     1              Z6,IBUGA3,IERROR)
        DO3722I=1,NPTS2
          DX=DBLE(Y2(I))
          DTERM1=DBLE(A0) + DBLE(A1)*DX + DBLE(A2)*DX*DX
          Z3(I)=REAL(DTERM1) + Z2(I)
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
            WRITE(ICOUT,3727)I,Y2(I),Z3(I)
 3727       FORMAT('I,Y2(I),Z3(I) (I.E., X,Y TO BE FIT) =',I8,2G15.7)
           CALL DPWRST('XXX','BUG ')
        ENDIF
 3722   CONTINUE
        CALL QUAFI2(Y2,Z3,NPTS,
     1            Z5,
     1            B0,B1,B2,
     1            ISUBRO,IBUGA3,IERROR)
C
C  DETERMINE APPROPRIATE ROOT
C
        C=B0 - Y0
        B=B1
        A=B2
        TERM1=B**2 - 4.0*A*C
        IF(TERM1.EQ.0.0)THEN
          RIGHT=(-B + TERM1)/(2.0*A)
        ELSEIF(TERM1.GT.0.0)THEN
          TERM1=SQRT(TERM1)
          RIGH1=(-B + TERM1)/(2.0*A)
          RIGH2=(-B - TERM1)/(2.0*A)
          IF(RIGH1.GE.XLEFT .AND. RIGH1.LE.XRIGHT)THEN
            IF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
              D1DIFF=ABS(RIGH1-RIGHT0)
              D2DIFF=ABS(RIGH2-RIGHT0)
              IF(D1DIFF.LE.D2DIFF)THEN
                RIGHT=RIGH1
              ELSE
                RIGHT=RIGH2
              ENDIF
            ELSE
              RIGHT=RIGH1
            ENDIF
          ELSEIF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
            RIGHT=RIGH2
          ELSE
            IF(RIGH1.GT.0.0 .AND. RIGH2.LE.0.0)THEN
              RIGHT=RIGH1
            ELSEIF(RIGH2.GT.0.0 .AND. RIGH1.LE.0.0)THEN
              RIGHT=RIGH2
            ELSE
              D1DIFF=ABS(RIGH1-RIGHT0)
              D2DIFF=ABS(RIGH2-RIGHT0)
              IF(D1DIFF.LE.D2DIFF)THEN
                RIGHT=RIGH1
              ELSE
                RIGHT=RIGH2
              ENDIF
            ENDIF
          ENDIF
          IF(RIGHT.LT.0)NNEG=NNEG+1
        ELSEIF(TERM1.LT.0.0)THEN
          NREJ=NREJ+1
          GOTO3720
        ENDIF
C
        NCOUNT=NCOUNT+1
        Z4(NCOUNT)=RIGHT
C
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
          WRITE(ICOUT,3725)IERROR,NCOUNT,B0,B1,B2,Z4(NCOUNT)
 3725     FORMAT('IERROR,NCOUNT,B0,B1,B2,Z4(NCOUNT) = ',A4,I8,4G15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
 3720 CONTINUE
C
      BOOTE=X0
      P100=100.0*(ALPHA/2.0)
      CALL PERCEN(P100,Z4,NCOUNT,IWRITE,Z3,MAXNXT,
     1            BOOTEL,IBUGA3,IERROR)
      P100=100.0*(1.0 - ALPHA/2.0)
      CALL PERCEN(P100,Z4,NCOUNT,IWRITE,Z3,MAXNXT,
     1            BOOTEU,IBUGA3,IERROR)
C
C               ***********************************************
C               **  STEP 3.8--                               **
C               **  BOOTSTRAP (WU RESAMPLING, I.E., RESAMPLE **
C               **  THE ORIGINAL (X,Y) DATA                  **
C               ***********************************************
C
      ISTEPN='3.8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NNEG=0
      NREJ=0
      NCOUNT=0
      ICASJB='BOOT'
      NRESAM=1000
C
      DO3810IRESAM=1,NRESAM
        IERROR='NO'
        CALL DPJBS3(Y1,NPTS,ICASJB,IRESAM,ISEED,Z1,NPTS2,IZ,
     1              Z6,IBUGA3,IERROR)
        DO3820IJ=1,NPTS2
          Z2(IJ)=Y2(IZ(IJ))
 3820   CONTINUE
        CALL QUAFI2(Z2,Z1,NPTS,
     1            Z5,
     1            B0,B1,B2,
     1            ISUBRO,IBUGA3,IERROR)
C
        IF(IERROR.EQ.'YES')GOTO3810
C
C  DETERMINE APPROPRIATE ROOT
C
        C=B0 - Y0
        B=B1
        A=B2
        TERM1=B**2 - 4.0*A*C
        IF(TERM1.EQ.0.0)THEN
          RIGHT=(-B + TERM1)/(2*A)
        ELSEIF(TERM1.GT.0.0)THEN
          TERM1=SQRT(TERM1)
          RIGH1=(-B + TERM1)/(2*A)
          RIGH2=(-B - TERM1)/(2*A)
          IF(RIGH1.GE.XLEFT .AND. RIGH1.LE.XRIGHT)THEN
            IF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
              D1DIFF=ABS(RIGH1-RIGHT0)
              D2DIFF=ABS(RIGH2-RIGHT0)
              IF(D1DIFF.LE.D2DIFF)THEN
                RIGHT=RIGH1
              ELSE
                RIGHT=RIGH2
              ENDIF
            ELSE
              RIGHT=RIGH1
            ENDIF
          ELSEIF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
            RIGHT=RIGH2
          ELSE
            IF(RIGH1.GT.0.0 .AND. RIGH2.LE.0.0)THEN
              RIGHT=RIGH1
            ELSEIF(RIGH2.GT.0.0 .AND. RIGH1.LE.0.0)THEN
              RIGHT=RIGH2
            ELSE
              D1DIFF=ABS(RIGH1-RIGHT0)
              D2DIFF=ABS(RIGH2-RIGHT0)
              IF(D1DIFF.LE.D2DIFF)THEN
                RIGHT=RIGH1
              ELSE
                RIGHT=RIGH2
              ENDIF
            ENDIF
          ENDIF
          IF(RIGHT.LT.0)NNEG=NNEG+1
        ELSEIF(TERM1.LT.0.0)THEN
          NREJ=NREJ+1
          GOTO3810
        ENDIF
C
        NCOUNT=NCOUNT+1
        Z4(NCOUNT)=RIGHT
C
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')THEN
          WRITE(ICOUT,3822)NCOUNT,B0,B1,B2,Z4(IRESAM)
 3822     FORMAT('NCOUNT,B0,B1,B2,Z4(IRESAM) = ',I8,4G15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
 3810 CONTINUE
C
      BOOTW=X0
      P100=100.0*(ALPHA/2.0)
      CALL PERCEN(P100,Z4,NCOUNT,IWRITE,Z3,MAXNXT,
     1            BOOTWL,IBUGA3,IERROR)
      P100=100.0*(1.0 - ALPHA/2.0)
      CALL PERCEN(P100,Z4,NCOUNT,IWRITE,Z3,MAXNXT,
     1            BOOTWU,IBUGA3,IERROR)
C
C               ***********************************************
C               **  STEP 4--                                 **
C               **  PRINT OUT THE RESULTS.                   **
C               ***********************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LIC3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMETHD=1
      WRITE(IOUNI1,5401)IMETHD,Y0,EISEN,EISENL,EISENU
CCCCC IMETHD=2
CCCCC WRITE(IOUNI1,5401)IMETHD,Y0,GRAYB,GRAYBL,GRAYBU
CCCCC IMETHD=3
CCCCC WRITE(IOUNI1,5401)IMETHD,Y0,ANWK,ANWKL,ANWKU
CCCCC IMETHD=4
CCCCC WRITE(IOUNI1,5401)IMETHD,Y0,PROPE,PROPEL,PROPEU
CCCCC IMETHD=5
CCCCC WRITE(IOUNI1,5401)IMETHD,Y0,AINVR,AINVRL,AINVRU
CCCCC IMETHD=6
CCCCC WRITE(IOUNI1,5401)IMETHD,Y0,AMLE,AMLEL,AMLEU
      IMETHD=7
      WRITE(IOUNI1,5401)IMETHD,Y0,BOOTE,BOOTEL,BOOTEU
      IMETHD=8
      WRITE(IOUNI1,5401)IMETHD,Y0,BOOTW,BOOTWL,BOOTWU
 5401 FORMAT(I2,2X,4E15.7)
CCCCC WRITE(IOUNI2,5411)Y0,EISEN,GRAYB,ANWK,PROPE,AINVR,AMLE,
CCCCC1                  BOOTE,BOOTW
      WRITE(IOUNI2,5411)EISEN,BOOTE,BOOTW
CCCCC WRITE(IOUNI3,5411)Y0,EISENL,GRAYBL,ANWKL,PROPEL,AINVRL,AMLEL,
CCCCC1                  BOOTEL,BOOTWL
CCCCC WRITE(IOUNI4,5411)Y0,EISENU,GRAYBU,ANWKU,PROPEU,AINVRU,AMLEU,
CCCCC1                  BOOTEU,BOOTWU
      WRITE(IOUNI3,5411)EISENL,BOOTEL,BOOTWL
      WRITE(IOUNI4,5411)EISENU,BOOTEU,BOOTWU
 5411 FORMAT(9E15.7)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5424)
 5423   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM COLSPAN=4>')
 5424   FORMAT('      <TH ALIGN=LEFT VALIGN=BOTTOM COLSPAN=4>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5431)Y0
 5431   FORMAT('         Y0 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5361)
 5361   FORMAT('         1. CLASSICAL (EISENHART:<BR>INVERSE ',
     1         'PREDICTION LIMITS):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)EISEN
 5371   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)EISENL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)EISENU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5321)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5323)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5363)
 5363   FORMAT('         2. GRAYBILL-IYER:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)GRAYB
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)GRAYBL
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)GRAYBU
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5328)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5321)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5323)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5365)
 5365   FORMAT('         3. NETER-WASSERMAN-KUTNER:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)ANWK
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)ANWKL
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)ANWKU
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5328)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5321)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5323)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5367)
 5367   FORMAT('         4. PROPOGATION OF ERROR:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)PROPE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)PROPEL
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)PROPEU
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5328)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5321)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5323)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5369)
 5369   FORMAT('         5. INVERSE (KRUTCHKOFF):')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)AINVR
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)AINVRL
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)AINVRU
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5328)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5321)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5323)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5373)
 5373   FORMAT('         6. MAXIMUM LIKELIHOOD:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)AMLE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)AMLEL
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5326)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5371)AMLEU
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5327)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5328)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5375)
 5375   FORMAT('         7. BOOTSTRAP (RESAMPLE RESIDUALS):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTEL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTEU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5377)
 5377   FORMAT('         8. BOOTSTRAP (RESAMPLE DATA):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTW
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTWL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5371)BOOTWU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
CCCCC OCTOBER 2003: ADD SUPPORT FOR LATEX OUTPUT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8041 FORMAT(5X,'{',A1,'bf Quadratic Calibration Summary: Y0 = ',
     1       G15.7,'}')
C
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,Y0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8042 FORMAT(5X,A1,'begin{tabular} {|l|l|r|r|r|}')
 8043 FORMAT(5X,A1,'hline')
 8044 FORMAT(5X,'  &  & 95',A1,'% & 95',A1,'% ',A1,A1)
 8045 FORMAT(5X,'Method & X0 & Lower Limit & Upper Limit ',A1,A1)
 8051 FORMAT(5X,'1. Classical (Eisenhart &  &  &  ',A1,A1)
 8052 FORMAT(5X,'   Inverse Prediction Limits:',3(' & ',G15.7),A1,A1)
C8053 FORMAT(5X,'2. Graybill-Iyer:',3(' & ',G15.7),A1,A1)
C8054 FORMAT(5X,'3. Neter-Wasserman-Kutner:',3(' & ',G15.7),A1,A1)
C8055 FORMAT(5X,'4. Propogation of Error:',3(' & ',G15.7),A1,A1)
C8056 FORMAT(5X,'5. Inverse (Krutchkoff):',3(' & ',G15.7),A1,A1)
C8057 FORMAT(5X,'6. Maximum Likelihood:',3(' & ',G15.7),A1,A1)
 8058 FORMAT(5X,'2. Bootstrap (resample residuals):',3(' & ',G15.7),
     1       A1,A1)
 8059 FORMAT(5X,'3. Bootstrap (resample data):',3(' & ',G15.7),A1,A1)
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8042)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8051)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8052)EISEN,EISENL,EISENU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8053)GRAYB,GRAYBL,GRAYBU,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8043)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8054)ANWK,ANWKL,ANWKU,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8043)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8055)PROPE,PROPEL,PROPEU,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8043)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8056)AINVR,AINVRL,AINVRU,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8043)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8057)AMLE,AMLEL,AMLEU,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8043)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8058)BOOTE,BOOTEL,BOOTEU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8059)BOOTW,BOOTWL,BOOTWU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
C
        WRITE(ICOUT,6355)Y0
 6355   FORMAT('Y0 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6361)EISEN,EISENL,EISENU
 6361   FORMAT(' 1. INVERSE PREDICTION LIMITS:',G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,6363)GRAYB,GRAYBL,GRAYBU
 6363   FORMAT(' 2. GRAYBILL-IYER:',12X,G15.7,2G16.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,6367)ANWK,ANWKL,ANWKU
 6367   FORMAT(' 3. NETER-WASSERMAN-KUTNER:',3X,G15.7,2G16.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,6371)PROPE,PROPEL,PROPEU
 6371   FORMAT(' 4. PROPOGATION OF ERROR:',5X,G15.7,2G16.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,6375)AINVR,AINVRL,AINVRU
 6375   FORMAT(' 5. INVERSE (KRUTCHKOFF):',5X,G15.7,2G16.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,6379)AMLE,AMLEL,AMLEU
 6379   FORMAT(' 6. MAXIMUM LIKELIHOOD:',7X,G15.7,2G16.7)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6383)BOOTE,BOOTEL,BOOTEU
 6383   FORMAT(' 7. BOOTSTRAP (RESIDUALS):',4X,G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6387)BOOTW,BOOTWL,BOOTWU
 6387   FORMAT(' 8. BOOTSTRAP (DATA):',9X,G15.7,2G16.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      GOTO3000
C
 3999 CONTINUE
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5991)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5993)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7991)
 7991   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC OCTOBER 2003: ADD SUPPORT FOR LATEX OUTPUT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8190 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8190)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
C
        WRITE(ICOUT,6327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      IF(IFEEDB.EQ.'ON')THEN
C
        WRITE(ICOUT,8102)
 8102   FORMAT('FOLLOWING INFORMATION WRITTEN OUT TO FILES.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8112)
 8112   FORMAT('DPST1F.DAT: METHOD (1, 7 - 8), Y0, X0, LOWER LIMIT, ',
     1         'UPPER LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)
 8122   FORMAT('DPST2F.DAT: Y0 AND X0 FOR THREE METHODS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8132)
 8132   FORMAT('DPST3F.DAT: Y0 AND LOWER LIMIT FOR THREE METHODS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8142)
 8142   FORMAT('DPST4F.DAT: Y0 AND UPPER LIMIT FOR THREE METHODS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IENDF3,IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IENDF4='OFF'
      IREWI4='ON'
      CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LIC3')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPLIC3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA3,IERROR
 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NUMVAR
 9013   FORMAT('NPTS,NUMVAR = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLICL(IHARG,NUMARG,IDEFCO,MAXLIN,ILINCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT LINE COLORS FOR USE IN MULTI-TRACE PLOTS.
C              THE COLOR FOR THE LINE FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ILINCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C                     --MAXLIN
C     OUTPUT ARGUMENTS--ILINCO  (A  HOLLERITH VECTOR
C                       WHOSE I-TH ELEMENT IS THE COLOR
C                       FOR THE LINE
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCO
      CHARACTER*4 ILINCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ILINCO(*)
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
      IFOUND='NO'
      IERROR='NO'
C
 1100 CONTINUE
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COLO')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'COLO')GOTO1105
      GOTO1199
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      IFOUND='YES'
      DO1115I=1,MAXLIN
      ILINCO(I)=IDEFCO
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ILINCO(I)
 1116 FORMAT('ALL LINE COLORS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1190
C
 1120 CONTINUE
      IFOUND='YES'
      ILINCO(1)=IHARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,ILINCO(I)
 1126 FORMAT('THE COLOR FOR LINE ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1190
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXLIN
      ILINCO(I)=IHARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ILINCO(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1190
C
 1140 CONTINUE
      IFOUND='YES'
      DO1145I=1,MAXLIN
      ILINCO(I)=IHARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ILINCO(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1190
C
 1150 CONTINUE
      IFOUND='YES'
      IMAX=NUMARG-1
      IF(MAXLIN.LT.IMAX)IMAX=MAXLIN
      DO1155I=1,IMAX
      IP1=I+1
      ILINCO(I)=IHARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,ILINCO(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO1190
C
 1160 CONTINUE
      IFOUND='YES'
      DO1165I=1,MAXLIN
      ILINCO(I)=IDEFCO
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ILINCO(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO1190
C
 1190 CONTINUE
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLICO(IHARG,NUMARG,IANSSV,IREPMX,ILISMX,IPOINT,
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
CCCCC 5 ARGS. (IHELMX, ICPREH, ETC.) WERE ADDED ABOVE   JULY 1993
C
C     PURPOSE--RECALL (THAT IS, LIST) THE LAST ILISMX (USUALLY 20, 30, 50)
C              COMMANDS ENTERED
C              FOR POTENTIAL USE BY A    REPEAT OR SAVE     COMMAND.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--86/1
C     ORIGINAL VERSION--MARCH     1984.
C     UPDATED         --JANUARY   1986.
C     UPDATED         --APRIL     1993. SOFT-CODE DIMEN. FOR IANSSV()
C     UPDATED         --JULY      1993.  ALLOW MORE... TO STOP LIST
C     UPDATED         --SEPTEMBER 1993.  DELETE LEAD BLANK LINES
C     UPDATED         --SEPTEMBER 1993.  ALLOW ALWAYS-PRINTING
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1993
      INCLUDE 'DPCOPA.INC'
      CHARACTER*4 IHARG
      CHARACTER*1 IANSSV
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED JULY 1993
      CHARACTER*40 ICPREH
      CHARACTER*40 ICPOSH
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
      CHARACTER*4 IFOUND
C
      CHARACTER*1 IC1
      CHARACTER*80 ISTRIN
C
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1993
      CHARACTER*4 IRESP
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
CCCCC THE FOLLOWING LINE WAS CHANGED APRIL 1993
CCCCC DIMENSION IANSSV(50,80)
      DIMENSION IANSSV(MAXLIS,MAXCIS)
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
      ISUBN1='DPLI'
      ISUBN2='CO  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'LICO')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPLICO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO
   53 FORMAT('IBUGS2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO57
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   57 CONTINUE
      WRITE(ICOUT,61)IREPMX,ILISMX,IHELMX,IPOINT
   61 FORMAT('IREPMX,ILISMX,IHELMX,IPOINT = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO62J=1,IREPMX
      WRITE(ICOUT,63)(IANSSV(J,I),I=1,80)
   63 FORMAT('(IANSSV(J,I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
      WRITE(ICOUT,69)IFOUND,IERROR
   69 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  RECALL (= LIST OUT) THE LAST ILISMX COMMANDS    **
C               **  THE COMMAND ILISMX AGO BEING LISTED FIRST,      **
C               **  AND THE MOST RECENT COMMAND BEING LISTED LAST.  **
C               ******************************************************
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 1989
      NUMLPR=0
      IRESP='YES'
C
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT    SEPTEMBER 1993
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1010)ILISMX
 1010 FORMAT('THE LAST ',I2,' COMMAND LINES--')
CCCCC THE FOLLOWING LINE WAS CHANGED TO ALLOW ALWAYS-WRITING  SEPTEMBER 1993
CCCCC CALL DPWRST('XXX','BUG ')
      CALL DPWRST('XXX','WRIT')
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT    SEPTEMBER 1993
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,999)
C
CCCCC IPOIN2=11
CCCCC IPOIN2=21
      IPOIN2=ILISMX+1
      IF(ILISMX.GT.IREPMX)IPOIN2=IREPMX+1
C
CCCCC JMIN=IPOINT
      JMIN=IPOINT+(IREPMX-ILISMX)
      JMAX=IREPMX
      IF(JMAX.LT.JMIN)GOTO1190
      DO1100J=JMIN,JMAX
      IPOIN2=IPOIN2-1
      IF(IPOIN2.LE.0)GOTO1190
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED JULY 1993
      IF(NUMLPR.GE.IHELMX)
     1CALL DPMORE(NUMLPR,NCPREH,ICPREH,IRESP,IBUGS2,IERROR)
      IF(NUMLPR.GE.IHELMX)NUMLPR=0
      IF(IRESP.EQ.'NO')GOTO1290
C
      DO1110I=1,80
      IC1=IANSSV(J,I)
      ISTRIN(I:I)=IC1
 1110 CONTINUE
      CALL DPDB80(ISTRIN,IMAX,IBUGS2,ISUBRO,IERROR)
      WRITE(ICOUT,1115)IPOIN2,(ISTRIN(I:I),I=1,IMAX)
CCCCC THE FOLLOWING LINE WAS CHANGED TO ALLOW ALWAYS-WRITING  SEPTEMBER 1993
CCCCC CALL DPWRST('XXX','BUG ')
      CALL DPWRST('XXX','WRIT')
CCCCC THE FOLLOWING LINE WAS CHANGED APRIL 1993
C1115 FORMAT(4X,I2,'--',80A1)
 1115 FORMAT(4X,I4,'--',80A1)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1989
      NUMLPR=NUMLPR+1
 1100 CONTINUE
 1190 CONTINUE
C
CCCCC JMIN=1
      JMIN=IPOINT-ILISMX
      IF(JMIN.LE.0)JMIN=1
      JMAX=IPOINT-1
      IF(JMAX.LT.JMIN)GOTO1290
      DO1200J=JMIN,JMAX
      IPOIN2=IPOIN2-1
      IF(IPOIN2.LE.0)GOTO1290
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED JULY 1993
      IF(NUMLPR.GE.IHELMX)
     1CALL DPMORE(NUMLPR,NCPREH,ICPREH,IRESP,IBUGS2,IERROR)
      IF(NUMLPR.GE.IHELMX)NUMLPR=0
      IF(IRESP.EQ.'NO')GOTO1290
C
      DO1210I=1,80
      IC1=IANSSV(J,I)
      ISTRIN(I:I)=IC1
 1210 CONTINUE
      CALL DPDB80(ISTRIN,IMAX,IBUGS2,ISUBRO,IERROR)
CCCCC THE FOLLOWING SECTION HAD CHANGES MADE   SEPTEMBER 1993
      IF(J.NE.JMAX)THEN
         WRITE(ICOUT,1215)IPOIN2,(ISTRIN(I:I),I=1,IMAX)
 1215    FORMAT(4X,I4,'--',80A1)
CCCCC    CALL DPWRST('XXX','BUG ')
         CALL DPWRST('XXX','WRIT')
      ENDIF
      IF(J.EQ.JMAX)THEN
         WRITE(ICOUT,1216)IPOIN2,(ISTRIN(I:I),I=1,IMAX)
 1216    FORMAT(4X,I4,'--',80A1)
CCCCC    CALL DPWRST('XXX','BUG ')
         CALL DPWRST('XXX','WRIT')
      ENDIF
      NUMLPR=NUMLPR+1
 1200 CONTINUE
 1290 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'LICO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPLICO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,ISUBRO
 9013 FORMAT('IBUGS2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMARG
 9014 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9017
      DO9015I=1,NUMARG
      WRITE(ICOUT,9016)I,IHARG(I)
 9016 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9017 CONTINUE
      WRITE(ICOUT,9021)IREPMX,ILISMX,IHELMX,IPOINT
 9021 FORMAT('IREPMX,ILISMX,IHELMX,IPOINT = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO9022J=1,IREPMX
      WRITE(ICOUT,9023)(IANSSV(J,I),I=1,80)
 9023 FORMAT('(IANSSV(J,I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
      WRITE(ICOUT,9029)IFOUND,IERROR
 9029 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IRESP
 9031 FORMAT('IRESP = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLIGR(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--LIST THE CURRENTLY SAVED PIXMAPS
C
C                  LIST PLOT  (OR LIST GRAPH, LG, LP)
C                      REPEAT PLOT -2 PLOTS THE SIXTH PIXMAP
C
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 TECHNOLOGU
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--97/4
C     ORIGINAL VERSION--APRIL     1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      INCLUDE 'DPCOPA.INC'
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
      CHARACTER*4 IFOUND
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*80 CTEMP
C
      DIMENSION IANSLC(*)
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPM.INC'
      INCLUDE 'DPCOF2.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
      ISUBN1='DPLI'
      ISUBN2='GR  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'LIGR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPLIGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IFOUND,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,54)(IANSLC(I),I=1,IWIDTH)
   54 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMARG
   55 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO58
      DO56I=1,NUMARG
      WRITE(ICOUT,57)I,IHARG(I)
   57 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   58 CONTINUE
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
C
C               *******************************
C               **  STEP 12--                **
C               **  LOOP THROUGH LIST IN     **
C               **  DPCOPM.INC               **
C               *******************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REGR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMPXM.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1203)
        CALL DPWRST('XXX','BUG')
        GOTO9000
      ENDIF
 1203 FORMAT('***** THERE ARE NO PIXMAPS SAVED FROM THE CURRENT ',
     1       'DATAPLOT SESSION.')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1220I=1,NUMPXM
        WRITE(ICOUT,1229)I
        CALL DPWRST('XXX','BUG ')
        NCSTR=1
        DO1230J=128,1,-1
          NCSTR=J
          IF(IPXMFN(I)(J:J).NE.' ')GOTO1235
 1230   CONTINUE
 1235   CONTINUE
        CTEMP(1:80)=IPXMFN(I)(1:80)
        WRITE(ICOUT,1239)CTEMP
        CALL DPWRST('XXX','BUG ')
        NCSTR=1
        DO1240J=128,1,-1
          NCSTR=J
          IF(IPXMCM(I)(J:J).NE.' ')GOTO1245
 1240   CONTINUE
 1245   CONTINUE
        CTEMP(1:80)=IPXMCM(I)(1:80)
        WRITE(ICOUT,1249)CTEMP
        CALL DPWRST('XXX','BUG ')
 1220 CONTINUE
 1229 FORMAT('PIXMAP ',I5,':')
 1239 FORMAT('      FILE NAME = ',A80)
 1249 FORMAT('      FILE TITLE = ',A80)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'REGR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPLIGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IFOUND,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IWIDTH
 9013 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,9014)(IANSLC(I),I=1,IWIDTH)
 9014 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMARG
 9015 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9018
      DO9016I=1,NUMARG
      WRITE(ICOUT,9017)I,IHARG(I)
 9017 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9018 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLIM(ICOM,IHARG,IARGT,ARG,NUMARG,
     1GX1MIN,GX1MAX,GY1MIN,GY1MAX,
     1GX2MIN,GX2MAX,GY2MIN,GY2MAX,
     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
     1FX2MIN,FX2MAX,FY2MIN,FY2MAX,
     1IX1MIN,IX1MAX,IY1MIN,IY1MAX,
     1IX2MIN,IX2MAX,IY2MIN,IY2MAX,
CCCCC NOVEMBER 1997.  ADD FOLLOWING 2 LINES
     1FX1MNZ,FX1MXZ,FX2MNZ,FX2MXZ,
     1FY1MNZ,FY1MXZ,FY2MNZ,FY2MXZ,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE AXIS LIMITS
C              (HORIZONTAL AXIS OR VERTICAL AXIS OR BOTH)
C              WHICH IN TURN WILL DEFINE THE EXTREMES
C              WHICH WILL APPEAR ON THE PLOT.
C              THE LIMITS WILL BE PLACED IN THE 8 VARIABLES
C              GX1MIN,GX1MAX,GY1MIN,GY1MAX,
C              GX2MIN,GX2MAX,GY2MIN,GY2MAX,
C              THE STATUS (FIXED OR LOAT) WILL BE PLACED
C              IN THE 8 VARIABLES
C              IX1MIN,IX1MAX,IY1MIN,IY1MAX,
C              IX2MIN,IX2MAX,IY2MIN,IY2MAX
C     INPUT  ARGUMENTS--ICOM  (A  HOLLERITH VARIABLE)
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --GX1MIN = MINIMUM FOR BOTTOM HORIZONTAL AXIS
C                     --GX1MAX = MAXIMUM FOR BOTTOM HORIZONTAL AXIS
C                     --GY1MIN = MINIMUM FOR LEFT   VERTICAL   AXIS
C                     --GY1MAX = MAXIMUM FOR LEFT   VERTICAL   AXIS
C                     --GX2MIN = MINIMUM FOR TOP    HORIZONTAL AXIS
C                     --GX2MAX = MAXIMUM FOR TOP    HORIZONTAL AXIS
C                     --GX2MIN = MINIMUM FOR RIGHT  VERTICAL   AXIS
C                     --GX2MAX = MAXIMUM FOR RIGHT  VERTICAL   AXIS
C                     --IX1MIN = STATUS FOR MINIMUM FOR BOTTOM HORIZONTAL AXIS
C                     --IX1MAX = STATUS FOR MAXIMUM FOR BOTTOM HORIZONTAL AXIS
C                     --IY1MIN = STATUS FOR MINIMUM FOR LEFT   VERTICAL   AXIS
C                     --IY1MAX = STATUS FOR MAXIMUM FOR LEFT   VERTICAL   AXIS
C                     --IX2MIN = STATUS FOR MINIMUM FOR TOP    HORIZONTAL AXIS
C                     --IX2MAX = STATUS FOR MAXIMUM FOR TOP    HORIZONTAL AXIS
C                     --IX2MIN = STATUS FOR MINIMUM FOR RIGHT  VERTICAL   AXIS
C                     --IX2MAX = STATUS FOR MAXIMUM FOR RIGHT  VERTICAL   AXIS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1986.
C     UPDATED         --FEBRUARY  1992. FIX YLIMITS WITH NO ARGS BOMB
C     UPDATED         --JULY      1996. ALLOW UPPER AND LOWER LIMIT TO
C                                       BE SAME (FOR LOG SCALES WHICH
C                                       VARY OVER SMALL RANGE)
C     UPDATED         --NOVEMBER  1997. FIX BUG WITH TIC OFFSET AND
C                                       LIMITS FREEZE.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IX1MIN
      CHARACTER*4 IX1MAX
      CHARACTER*4 IY1MIN
      CHARACTER*4 IY1MAX
      CHARACTER*4 IX2MIN
      CHARACTER*4 IX2MAX
      CHARACTER*4 IY2MIN
      CHARACTER*4 IY2MAX
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
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
      IFOUND='NO'
      IERROR='NO'
C
CCCCC THE FOLLOWING LINE WAS FIXED FEBRUARY 1992
CCCCC IF(IHARG(NUMARG).EQ.'?')GOTO8100
      IF(NUMARG.LE.0)GOTO1090
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  BOTH HORIZONTAL AXIS LIMITS ARE TO BE FIXED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XLIM')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1110
      IF(IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')GOTO1120
      IF(IHARG(1).EQ.'FROZ')GOTO1130
      IF(IHARG(1).EQ.'FREE')GOTO1130
      GOTO1110
C
 1110 CONTINUE
      IFOUND='YES'
      GX1MIN=CPUMIN
      GX1MAX=CPUMAX
      GX2MIN=CPUMIN
      GX2MAX=CPUMAX
      IX1MIN='FLOA'
      IX1MAX='FLOA'
      IX2MIN='FLOA'
      IX2MAX='FLOA'
 1113 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE X AXIS LIMITS (FOR BOTH HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('FRAME LINES) HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('SO THAT THEY WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO9000
C
 1120 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      A2=ARG(2)
      IF(A1.LT.A2)GOTO1121
      IF(A1.GT.A2)GOTO1122
CCCCC JULY 1996.  ALLOW UPPER AND LOWER LIMIT TO BE SAME.
CCCCC IF(A1.EQ.A2)GOTO1113
      IF(A1.EQ.A2)GOTO1121
 1121 CONTINUE
      GX1MIN=A1
      GX1MAX=A2
      GX2MIN=A1
      GX2MAX=A2
      IX1MIN='FIXE'
      IX1MAX='FIXE'
      IX2MIN='FIXE'
      IX2MAX='FIXE'
      GOTO1123
 1122 CONTINUE
      GX1MIN=A2
      GX1MAX=A1
      GX2MIN=A2
      GX2MAX=A1
      IX1MIN='FIXE'
      IX1MAX='FIXE'
      IX2MIN='FIXE'
      IX2MAX='FIXE'
      GOTO1123
 1123 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE X AXIS LIMITS (FOR BOTH HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)GX1MIN,GX1MAX
 1126 FORMAT('FRAME LINES) HAVE JUST BEEN SET TO ',
     1E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO9000
C
 1130 CONTINUE
      IFOUND='YES'
CCCCC NOVEMBER 1997.  FIX FOR TIC OFFSET AND LIMITS
CCCCC GX1MIN=FX1MIN
CCCCC GX1MAX=FX1MAX
CCCCC GX2MIN=FX2MIN
CCCCC GX2MAX=FX2MAX
      GX1MIN=FX1MNZ
      GX1MAX=FX1MXZ
      GX2MIN=FX2MNZ
      GX2MAX=FX2MXZ
      IX1MIN='FIXE'
      IX1MAX='FIXE'
      IX2MIN='FIXE'
      IX2MAX='FIXE'
 1133 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('THE X AXIS LIMITS (FOR BOTH HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('FRAME LINES) HAVE JUST BEEN FROZEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('TO THE VALUES FROM THE PREVIOUS PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)GX1MIN,GX1MAX
 1138 FORMAT('NAMELY--',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO9000
C
 1199 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  BOTTOM HORIZONTAL AXIS LIMITS ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'X1LI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1210
      IF(IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')GOTO1220
      IF(IHARG(1).EQ.'FROZ')GOTO1230
      IF(IHARG(1).EQ.'FREE')GOTO1230
      GOTO1210
C
 1210 CONTINUE
      IFOUND='YES'
      GX1MIN=CPUMIN
      GX1MAX=CPUMAX
      IX1MIN='FLOA'
      IX1MAX='FLOA'
 1213 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE X AXIS LIMITS (FOR THE BOTTOM HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('FRAME LINE) HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('SO THAT THEY WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO9000
C
 1220 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      A2=ARG(2)
      IF(A1.LT.A2)GOTO1221
      IF(A1.GT.A2)GOTO1222
CCCCC JULY 1996.  ALLOW UPPER AND LOWER LIMIT TO BE SAME.
CCCCC IF(A1.EQ.A2)GOTO1213
      IF(A1.EQ.A2)GOTO1221
 1221 CONTINUE
      GX1MIN=A1
      GX1MAX=A2
      IX1MIN='FIXE'
      IX1MAX='FIXE'
      GOTO1223
 1222 CONTINUE
      GX1MIN=A2
      GX1MAX=A1
      IX1MIN='FIXE'
      IX1MAX='FIXE'
      GOTO1223
 1223 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE X AXIS LIMITS (FOR THE BOTTOM HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1226)GX1MIN,GX1MAX
 1226 FORMAT('FRAME LINE) HAVE JUST BEEN SET TO ',
     1E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO9000
C
 1230 CONTINUE
      IFOUND='YES'
CCCCC NOVEMBER 1997.  FIX FOR TIC OFFSET AND LIMITS
CCCCC GX1MIN=FX1MIN
CCCCC GX1MAX=FX1MAX
      GX1MIN=FX1MNZ
      GX1MAX=FX1MXZ
      IX1MIN='FIXE'
      IX1MAX='FIXE'
 1233 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1239
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1235)
 1235 FORMAT('THE X AXIS LIMITS (FOR THE BOTTOM HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1236)
 1236 FORMAT('FRAME LINE) HAVE JUST BEEN FROZEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1237)
 1237 FORMAT('TO THE VALUES FROM THE PREVIOUS PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1238)GX1MIN,GX1MAX
 1238 FORMAT('NAMELY--',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1239 CONTINUE
      GOTO9000
C
 1299 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  TOP    HORIZONTAL AXIS LIMITS ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'X2LI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1310
      IF(IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')GOTO1320
      IF(IHARG(1).EQ.'FROZ')GOTO1330
      IF(IHARG(1).EQ.'FREE')GOTO1330
      GOTO1310
C
 1310 CONTINUE
      IFOUND='YES'
      GX2MIN=CPUMIN
      GX2MAX=CPUMAX
      IX2MIN='FLOA'
      IX2MAX='FLOA'
 1313 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE X AXIS LIMITS (FOR THE TOP    HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('FRAME LINE) HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)
 1317 FORMAT('SO THAT THEY WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO9000
C
 1320 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      A2=ARG(2)
      IF(A1.LT.A2)GOTO1321
      IF(A1.GT.A2)GOTO1322
CCCCC JULY 1996.  ALLOW UPPER AND LOWER LIMIT TO BE SAME.
CCCCC IF(A1.EQ.A2)GOTO1313
      IF(A1.EQ.A2)GOTO1321
 1321 CONTINUE
      GX2MIN=A1
      GX2MAX=A2
      IX2MIN='FIXE'
      IX2MAX='FIXE'
      GOTO1323
 1322 CONTINUE
      GX2MIN=A2
      GX2MAX=A1
      IX2MIN='FIXE'
      IX2MAX='FIXE'
      GOTO1323
 1323 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE X AXIS LIMITS (FOR THE TOP    HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)GX2MIN,GX2MAX
 1326 FORMAT('FRAME LINE) HAVE JUST BEEN SET TO ',
     1E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO9000
C
 1330 CONTINUE
      IFOUND='YES'
CCCCC NOVEMBER 1997.  FIX FOR TIC OFFSET AND LIMITS
CCCCC GX2MIN=FX2MIN
CCCCC GX2MAX=FX2MAX
      GX2MIN=FX2MNZ
      GX2MAX=FX2MXZ
      IX2MIN='FIXE'
      IX2MAX='FIXE'
 1333 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1335)
 1335 FORMAT('THE X AXIS LIMITS (FOR THE TOP HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1336)
 1336 FORMAT('FRAME LINE) HAVE JUST BEEN FROZEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1337)
 1337 FORMAT('TO THE VALUES FROM THE PREVIOUS PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1338)GX2MIN,GX2MAX
 1338 FORMAT('NAMELY--',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1339 CONTINUE
      GOTO9000
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  BOTH VERTICAL   AXIS LIMITS ARE TO BE FIXED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YLIM')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(NUMARG.LE.0)GOTO1410
      IF(IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')GOTO1420
      IF(IHARG(1).EQ.'FROZ')GOTO1430
      IF(IHARG(1).EQ.'FREE')GOTO1430
      GOTO1410
C
 1410 CONTINUE
      IFOUND='YES'
      GY1MIN=CPUMIN
      GY1MAX=CPUMAX
      GY2MIN=CPUMIN
      GY2MAX=CPUMAX
      IY1MIN='FLOA'
      IY1MAX='FLOA'
      IY2MIN='FLOA'
      IY2MAX='FLOA'
 1413 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('THE Y AXIS LIMITS (FOR BOTH VERTICAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)
 1416 FORMAT('FRAME LINES) HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1417)
 1417 FORMAT('SO THAT THEY WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1419 CONTINUE
      GOTO9000
C
 1420 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      A2=ARG(2)
      IF(A1.LT.A2)GOTO1421
      IF(A1.GT.A2)GOTO1422
CCCCC JULY 1996.  ALLOW UPPER AND LOWER LIMIT TO BE SAME.
CCCCC IF(A1.EQ.A2)GOTO1413
      IF(A1.EQ.A2)GOTO1421
 1421 CONTINUE
      GY1MIN=A1
      GY1MAX=A2
      GY2MIN=A1
      GY2MAX=A2
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      IY2MIN='FIXE'
      IY2MAX='FIXE'
      GOTO1423
 1422 CONTINUE
      GY1MIN=A2
      GY1MAX=A1
      GY2MIN=A2
      GY2MAX=A1
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      IY2MIN='FIXE'
      IY2MAX='FIXE'
      GOTO1423
 1423 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('THE Y AXIS LIMITS (FOR BOTH VERTICAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1426)GY1MIN,GY1MAX
 1426 FORMAT('FRAME LINES) HAVE JUST BEEN SET TO ',
     1E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
      GOTO9000
C
 1430 CONTINUE
      IFOUND='YES'
CCCCC NOVEMBER 1997.  FIX FOR TIC OFFSET AND LIMITS
CCCCC GY1MIN=FY1MIN
CCCCC GY1MAX=FY1MAX
CCCCC GY2MIN=FY2MIN
CCCCC GY2MAX=FY2MAX
      GY1MIN=FY1MNZ
      GY1MAX=FY1MXZ
      GY2MIN=FY2MNZ
      GY2MAX=FY2MXZ
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      IY2MIN='FIXE'
      IY2MAX='FIXE'
 1433 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1439
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1435)
 1435 FORMAT('THE Y AXIS LIMITS (FOR BOTH VERTICAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1436)
 1436 FORMAT('FRAME LINES) HAVE JUST BEEN FROZEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1437)
 1437 FORMAT('TO THE VALUES FROM THE PREVIOUS PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1438)GY1MIN,GY1MAX
 1438 FORMAT('NAMELY--',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1439 CONTINUE
      GOTO9000
C
 1499 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  LEFT   VERTICAL   AXIS LIMITS ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'Y1LI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(NUMARG.LE.0)GOTO1510
      IF(IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')GOTO1520
      IF(IHARG(1).EQ.'FROZ')GOTO1530
      IF(IHARG(1).EQ.'FREE')GOTO1530
      GOTO1510
C
 1510 CONTINUE
      IFOUND='YES'
      GY1MIN=CPUMIN
      GY1MAX=CPUMAX
      IY1MIN='FLOA'
      IY1MAX='FLOA'
 1513 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('THE Y AXIS LIMITS (FOR THE LEFT   VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1516)
 1516 FORMAT('FRAME LINE) HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1517)
 1517 FORMAT('SO THAT THEY WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
      GOTO9000
C
 1520 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      A2=ARG(2)
      IF(A1.LT.A2)GOTO1521
      IF(A1.GT.A2)GOTO1522
CCCCC JULY 1996.  ALLOW UPPER AND LOWER LIMIT TO BE SAME.
CCCCC IF(A1.EQ.A2)GOTO1513
      IF(A1.EQ.A2)GOTO1521
 1521 CONTINUE
      GY1MIN=A1
      GY1MAX=A2
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      GOTO1523
 1522 CONTINUE
      GY1MIN=A2
      GY1MAX=A1
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      GOTO1523
 1523 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1529
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)
 1525 FORMAT('THE Y AXIS LIMITS (FOR THE LEFT   VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1526)GY1MIN,GY1MAX
 1526 FORMAT('FRAME LINE) HAVE JUST BEEN SET TO ',
     1E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 1529 CONTINUE
      GOTO9000
C
 1530 CONTINUE
      IFOUND='YES'
CCCCC NOVEMBER 1997.  FIX FOR TIC OFFSET AND LIMITS
CCCCC GY1MIN=FY1MIN
CCCCC GY1MAX=FY1MAX
      GY1MIN=FY1MNZ
      GY1MAX=FY1MXZ
      IY1MIN='FIXE'
      IY1MAX='FIXE'
 1533 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1539
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1535)
 1535 FORMAT('THE Y AXIS LIMITS (FOR THE LEFT VERTICAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1536)
 1536 FORMAT('FRAME LINE) HAVE JUST BEEN FROZEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1537)
 1537 FORMAT('TO THE VALUES FROM THE PREVIOUS PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1538)GY1MIN,GY1MAX
 1538 FORMAT('NAMELY--',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1539 CONTINUE
      GOTO9000
C
 1599 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  RIGHT  VERTICAL   AXIS LIMITS ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'Y2LI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(NUMARG.LE.0)GOTO1610
      IF(IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')GOTO1620
      IF(IHARG(1).EQ.'FROZ')GOTO1630
      IF(IHARG(1).EQ.'FREE')GOTO1630
      GOTO1610
C
 1610 CONTINUE
      IFOUND='YES'
      GY2MIN=CPUMIN
      GY2MAX=CPUMAX
      IY2MIN='FLOA'
      IY2MAX='FLOA'
 1613 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('THE Y AXIS LIMITS (FOR THE RIGHT  VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1616)
 1616 FORMAT('FRAME LINE) HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1617)
 1617 FORMAT('SO THAT THEY WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO9000
C
 1620 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      A2=ARG(2)
      IF(A1.LT.A2)GOTO1621
      IF(A1.GT.A2)GOTO1622
CCCCC JULY 1996.  ALLOW UPPER AND LOWER LIMIT TO BE SAME.
CCCCC IF(A1.EQ.A2)GOTO1613
      IF(A1.EQ.A2)GOTO1621
 1621 CONTINUE
      GY2MIN=A1
      GY2MAX=A2
      IY2MIN='FIXE'
      IY2MAX='FIXE'
      GOTO1623
 1622 CONTINUE
      GY2MIN=A2
      GY2MAX=A1
      IY2MIN='FIXE'
      IY2MAX='FIXE'
      GOTO1623
 1623 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)
 1625 FORMAT('THE Y AXIS LIMITS (FOR THE RIGHT  VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1626)GY2MIN,GY2MAX
 1626 FORMAT('FRAME LINE) HAVE JUST BEEN SET TO ',
     1E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 1629 CONTINUE
      GOTO9000
C
 1630 CONTINUE
      IFOUND='YES'
CCCCC NOVEMBER 1997.  FIX FOR TIC OFFSET AND LIMITS
CCCCC GY2MIN=FY2MIN
CCCCC GY2MAX=FY2MAX
      GY2MIN=FY2MNZ
      GY2MAX=FY2MXZ
      IY2MIN='FIXE'
      IY2MAX='FIXE'
 1633 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1639
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1635)
 1635 FORMAT('THE Y AXIS LIMITS (FOR THE RIGHT VERTICAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1636)
 1636 FORMAT('FRAME LINE) HAVE JUST BEEN FROZEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1637)
 1637 FORMAT('TO THE VALUES FROM THE PREVIOUS PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1638)GY2MIN,GY2MAX
 1638 FORMAT('NAMELY--',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1639 CONTINUE
      GOTO9000
C
 1699 CONTINUE
C
C               ******************************************
C               **  TREAT THE CASE WHEN                 **
C               **  BOTH AXIS LIMITS ARE TO BE FIXED    **
C               ******************************************
C
      IF(ICOM.EQ.'XYLI')GOTO1700
      IF(ICOM.EQ.'YXLI')GOTO1700
      IF(ICOM.EQ.'LIMI')GOTO1700
      IF(ICOM.EQ.'LIM ')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(NUMARG.LE.0)GOTO1710
      IF(IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')GOTO1720
      IF(IHARG(1).EQ.'FROZ')GOTO1730
      IF(IHARG(1).EQ.'FREE')GOTO1730
      GOTO1710
C
 1710 CONTINUE
      IFOUND='YES'
      GX1MIN=CPUMIN
      GX1MAX=CPUMAX
      GY1MIN=CPUMIN
      GY1MAX=CPUMAX
      GX2MIN=CPUMIN
      GX2MAX=CPUMAX
      GY2MIN=CPUMIN
      GY2MAX=CPUMAX
      IX1MIN='FLOA'
      IX1MAX='FLOA'
      IY1MIN='FLOA'
      IY1MAX='FLOA'
      IX2MIN='FLOA'
      IX2MAX='FLOA'
      IY2MIN='FLOA'
      IY2MAX='FLOA'
 1713 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1715)
 1715 FORMAT('THE X AXIS LIMITS (FOR ALL 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1716)
 1716 FORMAT('FRAME LINES) HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1717)
 1717 FORMAT('SO THAT THEY WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1719 CONTINUE
      GOTO9000
C
 1720 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      A2=ARG(2)
      IF(A1.LT.A2)GOTO1721
      IF(A1.GT.A2)GOTO1722
CCCCC JULY 1996.  ALLOW UPPER AND LOWER LIMIT TO BE SAME.
CCCCC IF(A1.EQ.A2)GOTO1713
      IF(A1.EQ.A2)GOTO1721
 1721 CONTINUE
      GX1MIN=A1
      GX1MAX=A2
      GY1MIN=A1
      GY1MAX=A2
      GX2MIN=A1
      GX2MAX=A2
      GY2MIN=A1
      GY2MAX=A2
      IX1MIN='FIXE'
      IX1MAX='FIXE'
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      IX2MIN='FIXE'
      IX2MAX='FIXE'
      IY2MIN='FIXE'
      IY2MAX='FIXE'
      GOTO1723
 1722 CONTINUE
      GX1MIN=A2
      GX1MAX=A1
      GY1MIN=A2
      GY1MAX=A1
      GX2MIN=A2
      GX2MAX=A1
      GY2MIN=A2
      GY2MAX=A1
      IX1MIN='FIXE'
      IX1MAX='FIXE'
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      IX2MIN='FIXE'
      IX2MAX='FIXE'
      IY2MIN='FIXE'
      IY2MAX='FIXE'
      GOTO1723
 1723 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)
 1725 FORMAT('THE AXIS LIMITS (FOR ALL 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1726)GX1MIN,GX1MAX
 1726 FORMAT('FRAME LINES) HAVE JUST BEEN SET TO ',
     1E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 1729 CONTINUE
      GOTO9000
C
 1730 CONTINUE
      IFOUND='YES'
CCCCC NOVEMBER 1997.  FIX FOR TIC OFFSET AND LIMITS
CCCCC GX1MIN=FX1MIN
CCCCC GX1MAX=FX1MAX
CCCCC GX2MIN=FX2MIN
CCCCC GX2MAX=FX2MAX
CCCCC GY1MIN=FY1MIN
CCCCC GY1MAX=FY1MAX
CCCCC GY2MIN=FY2MIN
CCCCC GY2MAX=FY2MAX
      GX1MIN=FX1MNZ
      GX1MAX=FX1MXZ
      GX2MIN=FX2MNZ
      GX2MAX=FX2MXZ
      GY1MIN=FY1MNZ
      GY1MAX=FY1MXZ
      GY2MIN=FY2MNZ
      GY2MAX=FY2MXZ
      IX1MIN='FIXE'
      IX1MAX='FIXE'
      IX2MIN='FIXE'
      IX2MAX='FIXE'
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      IY2MIN='FIXE'
      IY2MAX='FIXE'
 1733 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1739
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1735)
 1735 FORMAT('THE AXIS LIMITS (FOR ALL 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1736)
 1736 FORMAT('FRAME LINES) HAVE JUST BEEN FROZEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1737)
 1737 FORMAT('TO THE VALUES FROM THE PREVIOUS PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1738)GX1MIN,GX1MAX
 1738 FORMAT('NAMELY--',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1739 CONTINUE
      GOTO9000
C
 1799 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)
 8111 FORMAT('THE CURRENT AXIS LIMITS ARE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)GX1MIN,GX1MAX
 8112 FORMAT('            --X1 (BOTTOM HORIZONTAL) = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8113)GX2MIN,GX2MAX
 8113 FORMAT('            --X2 (TOP    HORIZONTAL) = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8114)GY1MIN,GY1MAX
 8114 FORMAT('            --Y1 (LEFT   VERTICAL  ) = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8115)GY2MIN,GY2MAX
 8115 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8116)CPUMAX
 8116 FORMAT('            --THE VALUE ',E15.7,' INDICATES THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8117)
 8117 FORMAT('              LIMITS FLOAT WITH DATA AND ARE NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8121)
 8121 FORMAT('THE DEFAULT AXIS LIMITS ARE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8122)
 8122 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8123)
 8123 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8124)
 8124 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8125)
 8125 FORMAT('            --Y2 (BOTTOM VERTICAL  ) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPLIN2(I,IHARG,IHARG2,ILINP2)
C
C     PURPOSE--SHORTEN 5 TO 8-CHARACTER STRINGS
C              FOR VARIOUS DASHED LINES
C              (E.G., DASH3, DASH12, ETC.)
C              INTO 1 TO 4-CHARACTER STRINGS
C              (E.G., DA3, DA12, ETC.)
C     INPUT  ARGUMENTS--I      THE ELEMENT NUMBER
C                              IN IHARG AND IHARG2 THAT IS
C                              BEING EXAMINED.
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IHARG2 (A  HOLLERITH VECTOR)
C     OUTPUT ARGUMENTS--ILINP2 (A  HOLLERITH VARIABLE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 ILINP2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
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(IHARG(I).EQ.'DASH')GOTO1000
      GOTO9000
C
 1000 CONTINUE
      ILINP2='DASH'
      IF(IHARG2(I).EQ.'1   ')ILINP2='DA1 '
      IF(IHARG2(I).EQ.'2   ')ILINP2='DA2 '
      IF(IHARG2(I).EQ.'3   ')ILINP2='DA3 '
      IF(IHARG2(I).EQ.'4   ')ILINP2='DA4 '
      IF(IHARG2(I).EQ.'5   ')ILINP2='DA5 '
      IF(IHARG2(I).EQ.'6   ')ILINP2='DA6 '
      IF(IHARG2(I).EQ.'7   ')ILINP2='DA7 '
      IF(IHARG2(I).EQ.'8   ')ILINP2='DA8 '
      IF(IHARG2(I).EQ.'9   ')ILINP2='DA9 '
      IF(IHARG2(I).EQ.'10  ')ILINP2='DA10'
      IF(IHARG2(I).EQ.'11  ')ILINP2='DA11'
      IF(IHARG2(I).EQ.'12  ')ILINP2='DA12'
      IF(IHARG2(I).EQ.'13  ')ILINP2='DA13'
      IF(IHARG2(I).EQ.'14  ')ILINP2='DA14'
      IF(IHARG2(I).EQ.'15  ')ILINP2='DA15'
      IF(IHARG2(I).EQ.'16  ')ILINP2='DA16'
      IF(IHARG2(I).EQ.'17  ')ILINP2='DA17'
      IF(IHARG2(I).EQ.'18  ')ILINP2='DA18'
      IF(IHARG2(I).EQ.'19  ')ILINP2='DA19'
      IF(IHARG2(I).EQ.'20  ')ILINP2='DA20'
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPLINE(IHARG,IHARG2,NUMARG,MAXLIN,ILINPA,ILINPO,
     1IFOUND,IERROR)
CCCCC ARGUMENT LIST AUGMENTED FEBRUARY, 1998.
CCCCC SUBROUTINE DPLINE(IHARG,IHARG2,NUMARG,MAXLIN,ILINPA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT LINES FOR USE IN MULTI-TRACE PLOTS.
C              THE LINE FOR THE I-TH TRACE WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ILINPA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IHARG2   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXLIN
C     OUTPUT ARGUMENTS--ILINPA  (A  HOLLERITH VECTOR
C                       WHOSE I-TH ELEMENT IS THE LINE
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JULY      1983.
C     UPDATED         --AUGUST    1987.     TUFTE BOX PLOT
C     UPDATED         --NOVEMBER  1988.     ERROR BAR PLOT
C     UPDATED         --SEPTEMBER 1990.     AUGMENT CONTROL CHART
C     UPDATED         --FEBRUARY  1998.  ADD LINE SAVE/RESTORE FOR
C                                        FRONTEND.
C     UPDATED         --FEBRUARY  2003.  VIOLIN PLOT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 ILINPA
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      CHARACTER*4 ILINPO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ILINP2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
C
      DIMENSION ILINPA(*)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      DIMENSION ILINPO(*)
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
      IFOUND='NO'
      IERROR='NO'
C
 1100 CONTINUE
C
CCCCC ADD FOLLOWING 2 LINES FEBRUARY 1998.
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SAVE')GOTO2160
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'REST')GOTO2165
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BOX'.AND.IHARG(2).EQ.'PLOT')
     1GOTO2110
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'TUFT'.AND.
     1                   IHARG(2).EQ.'BOX'.AND.IHARG(3).EQ.'PLOT')
     1GOTO2140
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ERRO'.AND.
     1                   IHARG(2).EQ.'BAR'.AND.IHARG(3).EQ.'PLOT')
     1GOTO2150
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BOX'.AND.IHARG(3).EQ.'PLOT')
     1GOTO2110
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'I'.AND.IHARG(2).EQ.'PLOT')
     1GOTO2120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'I'.AND.IHARG(3).EQ.'PLOT')
     1GOTO2120
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO2130
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'CONT'.AND.IHARG(3).EQ.'CHAR')
     1GOTO2130
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'VIOL'.AND.IHARG(2).EQ.'PLOT')
     1GOTO2145
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'VIOL'.AND.IHARG(2).EQ.'BOX'
     1.AND.IHARG(3).EQ.'PLOT')GOTO2148
      IF(NUMARG.GE.4.AND.IHARG(1).EQ.'VIOL'.AND.IHARG(2).EQ.'BOX'
     1.AND.IHARG(3).EQ.'TUFT'.AND.IHARG(4).EQ.'PLOT')GOTO2145
C
      IF(NUMARG.LE.0)GOTO1160
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ALL')GOTO1160
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO2199
C
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.1)GOTO1120
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXLIN
      ILINPA(I)='SOLI'
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ILINPA(I)
 1116 FORMAT('ALL LINES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO2190
C
 1120 CONTINUE
      IF(NUMARG.EQ.0)ILINPA(1)='    '
      IF(NUMARG.GE.1)ILINPA(1)=IHARG(1)
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DASH')GOTO1121
      GOTO1125
 1121 CONTINUE
      I=1
      CALL DPLIN2(I,IHARG,IHARG2,ILINP2)
      ILINPA(I)=ILINP2
 1125 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,ILINPA(I)
 1126 FORMAT('LINE ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO2190
C
 1130 CONTINUE
      ILINP2=IHARG(2)
      IF(IHARG(2).EQ.'DASH')GOTO1131
      GOTO1132
 1131 CONTINUE
      I=2
      CALL DPLIN2(I,IHARG,IHARG2,ILINP2)
 1132 CONTINUE
      DO1135I=1,MAXLIN
      ILINPA(I)=ILINP2
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ILINPA(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO2190
C
 1140 CONTINUE
      ILINP2=IHARG(1)
      IF(IHARG(1).EQ.'DASH')GOTO1141
      GOTO1142
 1141 CONTINUE
      I=1
      CALL DPLIN2(I,IHARG,IHARG2,ILINP2)
 1142 CONTINUE
      DO1145I=1,MAXLIN
      ILINPA(I)=ILINP2
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ILINPA(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO2190
C
 1150 CONTINUE
      IMAX=NUMARG
      IF(MAXLIN.LT.IMAX)IMAX=MAXLIN
      DO1155I=1,IMAX
      ILINP2=IHARG(I)
      IF(IHARG(I).EQ.'DASH')GOTO1151
      GOTO1152
 1151 CONTINUE
      CALL DPLIN2(I,IHARG,IHARG2,ILINP2)
 1152 CONTINUE
      ILINPA(I)=ILINP2
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,ILINPA(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO2190
C
 1160 CONTINUE
      DO1165I=1,MAXLIN
      ILINPA(I)='    '
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ILINPA(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO2190
C
 2110 CONTINUE
      IMAX=24
      ILINPA(1)='    '
      ILINPA(2)='    '
      ILINPA(3)='    '
      ILINPA(4)='    '
      ILINPA(5)='    '
      ILINPA(6)='    '
      ILINPA(7)='    '
      ILINPA(8)='SOLI'
      ILINPA(9)='    '
      ILINPA(10)='    '
      ILINPA(11)='    '
      ILINPA(12)='    '
      ILINPA(13)='SOLI'
      ILINPA(14)='SOLI'
      ILINPA(15)='SOLI'
      ILINPA(16)='SOLI'
      ILINPA(17)='    '
      ILINPA(18)='    '
      ILINPA(19)='    '
      ILINPA(20)='SOLI'
      ILINPA(21)='    '
      ILINPA(22)='    '
      ILINPA(23)='    '
      ILINPA(24)='    '
      GOTO2170
C
 2120 CONTINUE
      IMAX=5
      ILINPA(1)='    '
      ILINPA(2)='    '
      ILINPA(3)='    '
      ILINPA(4)='SOLI'
      ILINPA(5)='SOLI'
      GOTO2170
C
 2130 CONTINUE
CCCCC THE FOLLOWING SECTION WAS CHANGED SEPTEMBER 1990
      IMAX=7
      ILINPA(1)='SOLI'
      ILINPA(2)='SOLI'
      ILINPA(3)='SOLI'
      ILINPA(4)='SOLI'
      ILINPA(5)='DOT '
      ILINPA(6)='DOT '
      ILINPA(7)='DOT '
      GOTO2170
C
 2140 CONTINUE
      IMAX=24
      ILINPA(1)='    '
      ILINPA(2)='    '
      ILINPA(3)='    '
      ILINPA(4)='    '
      ILINPA(5)='    '
      ILINPA(6)='    '
      ILINPA(7)='    '
      ILINPA(8)='SOLI'
      ILINPA(9)='    '
      ILINPA(10)='    '
      ILINPA(11)='    '
      ILINPA(12)='    '
      ILINPA(13)='SOLI'
      ILINPA(14)='    '
      ILINPA(15)='    '
      ILINPA(16)='    '
      ILINPA(17)='    '
      ILINPA(18)='    '
      ILINPA(19)='    '
      ILINPA(20)='    '
      ILINPA(21)='    '
      ILINPA(22)='    '
      ILINPA(23)='    '
      ILINPA(24)='    '
      GOTO2170
C
 2145 CONTINUE
      IMAX=25
      ILINPA(1)='SOLI'
      ILINPA(2)='    '
      ILINPA(3)='    '
      ILINPA(4)='    '
      ILINPA(5)='    '
      ILINPA(6)='    '
      ILINPA(7)='    '
      ILINPA(8)='    '
      ILINPA(9)='SOLI'
      ILINPA(10)='    '
      ILINPA(11)='    '
      ILINPA(12)='    '
      ILINPA(13)='    '
      ILINPA(14)='SOLI'
      ILINPA(15)='    '
      ILINPA(16)='    '
      ILINPA(17)='    '
      ILINPA(18)='    '
      ILINPA(19)='    '
      ILINPA(20)='    '
      ILINPA(21)='    '
      ILINPA(22)='    '
      ILINPA(23)='    '
      ILINPA(24)='    '
      ILINPA(25)='    '
      GOTO2170
C
 2148 CONTINUE
      IMAX=25
      ILINPA(1)='SOLI'
      ILINPA(2)='SOLI'
      ILINPA(3)='    '
      ILINPA(4)='    '
      ILINPA(5)='    '
      ILINPA(6)='    '
      ILINPA(7)='    '
      ILINPA(8)='    '
      ILINPA(9)='SOLI'
      ILINPA(10)='    '
      ILINPA(11)='    '
      ILINPA(12)='    '
      ILINPA(13)='    '
      ILINPA(14)='SOLI'
      ILINPA(15)='SOLI'
      ILINPA(16)='SOLI'
      ILINPA(17)='SOLI'
      ILINPA(18)='    '
      ILINPA(19)='    '
      ILINPA(20)='    '
      ILINPA(21)='SOLI'
      ILINPA(22)='    '
      ILINPA(23)='    '
      ILINPA(24)='    '
      ILINPA(25)='    '
      GOTO2170
C
 2150 CONTINUE
      IMAX=7
      ILINPA(1)='    '
      ILINPA(2)='    '
      ILINPA(3)='    '
      ILINPA(4)='    '
      ILINPA(5)='    '
      ILINPA(6)='SOLI'
      ILINPA(7)='SOLI'
      GOTO2170
C
 2160 CONTINUE
CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1998
      DO2163I=1,MAXLIN 
      ILINPO(I)=ILINPA(I)
 2163 CONTINUE
      IF(IFEEDB.EQ.'ON')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2164)
 2164 FORMAT('THE CURRENT LINE PATTERNS HAVE BEEN SAVED.')
      CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO2190
C
 2165 CONTINUE
CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1998
      DO2168I=1,MAXLIN 
      ILINPA(I)=ILINPO(I)
 2168 CONTINUE
      IF(IFEEDB.EQ.'ON')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2169)
 2169 FORMAT('THE SAVED LINE PATTERNS HAVE BEEN RESTORED.')
      CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO2190
C
 2170 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO2179
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO2175I=1,IMAX
      WRITE(ICOUT,2176)I,ILINPA(I)
 2176 FORMAT('LINE ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 2175 CONTINUE
 2179 CONTINUE
      GOTO2180
C
 2180 CONTINUE
      IFOUND='YES'
      GOTO2190
C
 2190 CONTINUE
      IFOUND='YES'
C
 2199 CONTINUE
      RETURN
      END
      SUBROUTINE DPLIST(ICOM,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
     1ICOM3,ICOM4,ICOM5,NUMCOM,NCOM5,
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
CCCCC 5 ARGS ADDED ABOVE FOR MORE/PAUSE   JULY 1989
CCCCC ICOM WAS ADDED TO THE ARGUMENT LIST NOVEMBER 1989
C
C     PURPOSE--LIST (= DISPLAY) A USER-DEFINED FILE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--86/1
C     ORIGINAL VERSION--JULY      1984.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --JANUARY   1987. (TO INCLUDE THE DIRECTORY FILE).
C     UPDATED         --AUGUST    1988. (TO INCLUDE DICTIONARY FILE).
C     UPDATED         --JULY      1989.  MORE/PAUSE
C     UPDATED         --NOVEMBER  1989.  NUMBERED LIST
C     UPDATED         --JULY      1990.  ALLOW MORE... TO STOP LIST
C     UPDATED         --AUGUST    1990.  EXPLICIT SETTING OF NUMLPR=0
C     UPDATED         --SEPTEMBER 1993.  ALLOW ALWAYS-WRITING
C     UPDATED         --NOVEMBER  1993.  PATH + DATASETS.
C     UPDATED         --NOVEMBER  1993.  PATH + DESIGNS.
C     UPDATED         --NOVEMBER  1993.  PATH + DISTRIBUTIONS.
C     UPDATED         --NOVEMBER  1993.  PATH + COMMANDS.
C     UPDATED         --NOVEMBER  1993.  PATH + SYNTAX.
C     UPDATED         --NOVEMBER  1993.  PATH + FUNCTIONS.
C     UPDATED         --NOVEMBER  1993.  PATH + PROGRAMS.
C     UPDATED         --NOVEMBER  1993.  PATH + MACROS.
C     UPDATED         --AUGUST    1994.  SIMPLIFY CODE THROUGHOUT
C     UPDATED         --JUNE      1995.  REMOVE PATH INFO
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1989
      CHARACTER*4 ICOM
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 ICOM3
      CHARACTER*4 ICOM4
      CHARACTER*40 ICOM5
      CHARACTER*4 IBUGS2
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 1989
      CHARACTER*40 ICPREH
      CHARACTER*40 ICPOSH
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1989
      CHARACTER*4 INUMSW
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IFILQ2
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IANSI
      CHARACTER*80 ICANS
      CHARACTER*80 ISTRIN
      CHARACTER*40 ICJUNK
C
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      CHARACTER*4 IRESP
C
      DIMENSION IANSLC(*)
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
C
      DIMENSION ICOM3(*)
      DIMENSION ICOM4(*)
      DIMENSION ICOM5(*)
      DIMENSION NCOM5(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOF2.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-----START POINT-----------------------------------------------------
C
      ISUBN1='DPLI'
      ISUBN2='ST  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IFILQ2=IFILQU
      IFILQU='ON'
C
      MINN2=1
      NCSTRI=(-999)
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1989
      INUMSW='OFF'
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')THEN
         WRITE(ICOUT,999)
  999    FORMAT(1X)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,51)
   51    FORMAT('***** AT THE BEGINNING OF DPLIST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,52)ICOM
   52    FORMAT('ICOM = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53    FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,54)IWIDTH
   54    FORMAT('IWIDTH = ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,55)(IANSLC(I),I=1,IWIDTH)
   55    FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,61)ILISNU
   61    FORMAT('ILISNU = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,62)ILISNA
   62    FORMAT('ILISNA = ',A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,63)ILISST
   63    FORMAT('ILISST = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,64)ILISFO
   64    FORMAT('ILISFO = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,65)ILISAC
   65    FORMAT('ILISAC = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,66)ILISFO
   66    FORMAT('ILISFO = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,67)ILISCS
   67    FORMAT('ILISCS = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,71)ICONNU
   71    FORMAT('ICONNU = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,72)ICONNA
   72    FORMAT('ICONNA = ',A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,73)ICONST
   73    FORMAT('ICONST = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,74)ICONFO
   74    FORMAT('ICONFO = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,75)ICONAC
   75    FORMAT('ICONAC = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,76)ICONFO
   76    FORMAT('ICONFO = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,77)ICONCS
   77    FORMAT('ICONCS = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,81)IDIRNU
   81    FORMAT('IDIRNU = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,82)IDIRNA
   82    FORMAT('IDIRNA = ',A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,83)IDIRST
   83    FORMAT('IDIRST = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,84)IDIRFO
   84    FORMAT('IDIRFO = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,85)IDIRAC
   85    FORMAT('IDIRAC = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,86)IDIRFO
   86    FORMAT('IDIRFO = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,87)IDIRCS
   87    FORMAT('IDIRCS = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,91)IHELMX
   91    FORMAT('IHELMX = ',I8)
         CALL DPWRST('XXX','BUG ')
C
         WRITE(ICOUT,92)NCPREH
   92    FORMAT('NCPREH = ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(NCPREH.GE.1)THEN
            DO93I=1,NCPREH
               WRITE(ICOUT,94)I,ICPREH(I:I)
   94          FORMAT('I,ICPREH(I:I) = ',I8,2X,A1,4X)
               CALL DPWRST('XXX','BUG ')
   93       CONTINUE
         ENDIF
C
         WRITE(ICOUT,96)NCPOSH
   96    FORMAT('NCPOSH = ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(NCPOSH.GE.1)THEN
            DO97I=1,NCPOSH
               WRITE(ICOUT,98)I,ICPOSH(I:I)
   98          FORMAT('I,ICPOSH(I:I) = ',I8,2X,A1,4X)
               CALL DPWRST('XXX','BUG ')
   97       CONTINUE
         ENDIF
C
      ENDIF
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1989
      IF(ICOM.EQ.'NLIS')INUMSW='ON'
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ILISNU
      IFILE=ILISNA
      ISTAT=ILISST
      IFORM=ILISFO
      IACCES=ILISAC
      IPROT=ILISPR
      ICURST=ILISCS
C
      ISUBN0='LIST'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'LIST')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  CHECK TO SEE IF THE LIST FILE MAY EXIST  **
C               ***********************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')THEN
         IERROR='YES'
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1211)
 1211    FORMAT('***** IMPLEMENTATION ERROR IN DPLIST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1212)
 1212    FORMAT('      THE DESIRED LISTING')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1213)
 1213    FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1214)
 1214    FORMAT('      THE INTERNAL VARIABLE    ILISST ')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1215)
 1215    FORMAT('      WHICH ALLOWS SUCH LISTING')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1216)
 1216    FORMAT('      HAS BEEN SET TO    NONE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1217)ISTAT,ILISST
 1217    FORMAT('ISTAT,ILISST = ',A12,2X,A12)
         CALL DPWRST('XXX','BUG ')
         GOTO9000
      ENDIF
C
C               ********************************
C               **  STEP 13--                 **
C               **  EXTRACT THE FILE NAME.    **
C               **  DO THE GENERAL CASE OF    **
C               **  LISTING GENERAL FILES.    **
C               **  DO ALSO THE SPECIAL CASES **
C               **  OF LISTING THE            **
C               **  CONCLUSIONS FILE,         **
C               **  AND LISTING THE           **
C               **  DIRECTORY  FILE.          **
C               ********************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1310I=1,80
         IANSI=IANSLC(I)
         ICANS(I:I)=IANSI(1:1)
 1310 CONTINUE
C
      ISTART=1
      ISTOP=IWIDTH
      IWORD=2
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,IFILE,NCFILE,
     1IBUGS2,ISUBRO,IERROR)
C
      IF(NCFILE.EQ.11.AND.IFILE.EQ.'CONCLUSIONS')GOTO1320
      IF(NCFILE.EQ.10.AND.IFILE.EQ.'CONCLUSION')GOTO1320
      IF(NCFILE.EQ.11.AND.IFILE.EQ.'conclusions')GOTO1320
      IF(NCFILE.EQ.10.AND.IFILE.EQ.'conclusion')GOTO1320
C
      IF(NCFILE.EQ.9.AND.IFILE.EQ.'DIRECTORY')GOTO1330
      IF(NCFILE.EQ.9.AND.IFILE.EQ.'directory')GOTO1330
C
      IF(NCFILE.EQ.6.AND.IFILE.EQ.'MASTER')GOTO1330
      IF(NCFILE.EQ.6.AND.IFILE.EQ.'master')GOTO1330
C
      IF(NCFILE.EQ.10.AND.IFILE.EQ.'DICTIONARY')GOTO1340
      IF(NCFILE.EQ.10.AND.IFILE.EQ.'dictionary')GOTO1340
C
      IF(NCFILE.EQ.11.AND.IFILE.EQ.'DEFINITIONS')GOTO1350
      IF(NCFILE.EQ.10.AND.IFILE.EQ.'DEFINITION')GOTO1350
      IF(NCFILE.EQ.4.AND.IFILE.EQ.'DEFI')GOTO1350
      IF(NCFILE.EQ.3.AND.IFILE.EQ.'DEF')GOTO1350
      IF(NCFILE.EQ.11.AND.IFILE.EQ.'definitions')GOTO1350
      IF(NCFILE.EQ.10.AND.IFILE.EQ.'definition')GOTO1350
      IF(NCFILE.EQ.4.AND.IFILE.EQ.'defi')GOTO1350
      IF(NCFILE.EQ.3.AND.IFILE.EQ.'def')GOTO1350
C
CCCCC THE FOLLOWING 8 SECTIONS WERE ADDED        NOVEMBER 1993
CCCCC THE FOLLOWING 8 SECTIONS WERE MODIFIED     JUNE 1993
      IF(IFILE(1:8).EQ.'DATASETS'.OR.IFILE(1:8).EQ.'datasets')THEN
         ISTART=1
         ISTOP=ISTART+8+1
         IFILE(ISTART:ISTOP)='datasets.'
         GOTO1370
C
      ELSEIF(IFILE(1:7).EQ.'DESIGNS.'.OR.IFILE(1:7).EQ.'designs.')THEN
         ISTART=1
         ISTOP=ISTART+7+1
         IFILE(ISTART:ISTOP)='designs.'
         GOTO1370
C
      ELSEIF(IFILE(1:8).EQ.'DISTRIBU'.OR.IFILE(1:8).EQ.'distribu')THEN
         ISTART=1
         ISTOP=ISTART+8+1
         IFILE(1:20)='                    '
         IFILE(ISTART:ISTOP)='distribu.'
         GOTO1370
C
      ELSEIF(IFILE(1:8).EQ.'COMMANDS'.OR.IFILE(1:8).EQ.'commands')THEN
         ISTART=1
         ISTOP=ISTART+8+1
         IFILE(ISTART:ISTOP)='commands.'
         GOTO1370
C
      ELSEIF(IFILE(1:6).EQ.'SYNTAX'.OR.IFILE(1:6).EQ.'syntax')THEN
         ISTART=1
         ISTOP=ISTART+6+1
         IFILE(ISTART:ISTOP)='syntax.'
         GOTO1370
C
      ELSEIF(IFILE(1:8).EQ.'FUNCTION'.OR.IFILE(1:8).EQ.'function')THEN
         ISTART=1
         ISTOP=ISTART+8+1
         IFILE(ISTART:ISTOP)='function.'
         GOTO1370
C
      ELSEIF(IFILE(1:8).EQ.'PROGRAMS'.OR.IFILE(1:8).EQ.'programs')THEN
         ISTART=1
         ISTOP=ISTART+8+1
         IFILE(ISTART:ISTOP)='programs.'
         GOTO1370
C
      ELSEIF(IFILE(1:6).EQ.'MACROS'.OR.IFILE(1:6).EQ.'macros')THEN
         ISTART=1
         ISTOP=ISTART+6+1
         IFILE(ISTART:ISTOP)='macros.'
         GOTO1370
      ENDIF
C
      GOTO1370
C
 1320 CONTINUE
      IFILE=ICONNA
      GOTO1370
C
 1330 CONTINUE
      IFILE=IDIRNA
      GOTO1370
C
 1340 CONTINUE
      IFILE=IDICNA
      GOTO1370
C
 1350 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1351)
 1351 FORMAT('DEFINITIONS--')
      CALL DPWRST('XXX','BUG ')
C
      IF(NUMCOM.GE.1)THEN
         DO1352I=1,NUMCOM
            ICJUNK=ICOM5(I)
            NCJUNK=NCOM5(I)
            IF(NCJUNK.LE.0)THEN
               WRITE(ICOUT,1353)I,ICOM3(I),ICOM4(I)
 1353          FORMAT(I8,'.  ',A4,A4,'--')
               CALL DPWRST('XXX','BUG ')
            ELSE
               WRITE(ICOUT,1354)I,ICOM3(I),ICOM4(I),
     1         (ICJUNK(J:J),J=1,NCJUNK)
 1354          FORMAT(I8,'.  ',A4,A4,'--',40(A1,1X))
               CALL DPWRST('XXX','BUG ')
            ENDIF
 1352    CONTINUE
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED           NOVEMBER 1993
CCCCC THE FOLLOWING SECTION WAS COMMENTED OUT   JUNE 1995
C1360 CONTINUE
CCCCC IFILE=PATH
CCCCC ISTART=NCPATH+1
CCCCC ISTOP=ISTART+8+1
CCCCC IFILE(ISTART:ISTOP)='distribu.'
CCCCC GOTO1370
C
 1370 CONTINUE
      IF(NCFILE.LE.0)THEN
         IERROR='YES'
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1371)
 1371    FORMAT('***** ERROR IN DPLIST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1372)
 1372    FORMAT('      A USER FILE NAME IS REQUIRED')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1373)
 1373    FORMAT('      IN THE LIST COMMAND')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1374)
 1374    FORMAT('      (FOR EXAMPLE,    LIST PROG7.DP)')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1375)
 1375    FORMAT('      BUT NONE WAS GIVEN HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1376)
 1376    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,1377)(IANSLC(I),I=1,IWIDTH)
 1377       FORMAT('      ',80A1)
            CALL DPWRST('XXX','BUG ')
         ELSE
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
         ENDIF
         GOTO9000
      ENDIF
C
 1390 CONTINUE
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
         J1=J
         IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')THEN
            ICASEQ='SUBS'
            ILOCQ=J1
            GOTO2190
         ELSEIF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')THEN
            ICASEQ='SUBS'
            ILOCQ=J1
            GOTO2190
         ELSEIF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')THEN
            ICASEQ='FOR'
            ILOCQ=J1
            GOTO2190
         ENDIF
 2100 CONTINUE
 2190 CONTINUE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')THEN
         WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191    FORMAT('NUMARG,ILOCQ = ',2I8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *********************************************
C               **  STEP 22--                              **
C               **  BRANCH    TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')THEN
         DO2215I=1,MAXN
            ISUB(I)=1
 2215    CONTINUE
         NQ=MAXN
      ELSEIF(ICASEQ.EQ.'SUBS')THEN
         NIOLD=MAXN
         CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
         NQ=NIOLD
      ELSEIF(ICASEQ.EQ.'FOR')THEN
         NIOLD=MAXN
         CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1   NLOCAL,ILOCS,NS,IBUGQ,IERROR)
         NQ=NFOR
         NMXFOR=IROWN
      ENDIF
C
      IF(NQ.LT.MINN2)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2271)
 2271    FORMAT('***** ERROR IN DPLIST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2272)
 2272    FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1   'EXTRACTED,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2273)
 2273    FORMAT('      THE NUMBER OF SPECIFIED FILE LINES')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2274)
 2274    FORMAT('      TO BE LISTED ')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2276)MINN2
 2276    FORMAT('      MUST BE ',I8,' OR LARGER;')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2277)
 2277    FORMAT('      SUCH WAS NOT THE CASE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2278)
 2278    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,2279)(IANSLC(I),I=1,IWIDTH)
 2279    FORMAT('      ',80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      NS=NQ
C
C               **************************
C               **  STEP 31--           **
C               **  OPEN  THE FILE      **
C               **  (UNLESS ITS THE     **
C               **  CONCLUSIONS FILE).  **
C               **************************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')THEN
         CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
         WRITE(ICOUT,3111)IFILE
 3111    FORMAT('IFILE = ',A80)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IFILE.EQ.ICONNA)GOTO3190
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
 3190 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS UPDATED JULY 1989
CCCCC THE FOLLOWING SECTION WAS UPDATED NOVEMBER 1989
CCCCC THE FOLLOWING SECTION WAS UPDATED JULY 1990
CCCCC THE FOLLOWING SECTION WAS UPDATED SEPTEMBER 1993
C               **********************************
 
C               **  STEP 41--                   **
C               **  READ A GENERAL FILE.        **
C               **  PRINT IT OUT.               **
C               **********************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLPR=0
      IRESP='YES'
      IMAX=1000000
      IF(ICASEQ.EQ.'SUBS')IMAX=MAXN
      IF(ICASEQ.EQ.'FOR')IMAX=IROWN
C
      DO4110I=1,IMAX
C
         READ(IOUNIT,4111,END=4190)(ISTRIN(J:J),J=1,80)
 4111    FORMAT(80A1)
         CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR)
         NCSTRI=JMAX
         IF(NCSTRI.EQ.3.AND.ISTRIN(1:3).EQ.'EOF')GOTO4190
C
         IF(ICASEQ.EQ.'FULL')GOTO4116
         IF(ICASEQ.EQ.'SUBS'.AND.ISUB(I).EQ.1)GOTO4116
         IF(ICASEQ.EQ.'FOR'.AND.ISUB(I).EQ.1)GOTO4116
         GOTO4110
C
 4116    CONTINUE
         IF(NUMLPR.GE.IHELMX)THEN
            CALL DPMORE(NUMLPR,NCPREH,ICPREH,IRESP,IBUGS2,IERROR)
            NUMLPR=0
         ENDIF
C
         IF(IRESP.EQ.'NO')GOTO4150
C
         IF(NCSTRI.GE.1)THEN
            IF(INUMSW.EQ.'OFF')THEN
               WRITE(ICOUT,4117)(ISTRIN(J:J),J=1,NCSTRI)
 4117          FORMAT(80A1)
               CALL DPWRST('XXX','WRIT')
            ELSE
               WRITE(ICOUT,4118)I,(ISTRIN(J:J),J=1,NCSTRI)
 4118          FORMAT(I8,'--',80A1)
               CALL DPWRST('XXX','WRIT')
            ENDIF
C
         ELSEIF(NCSTRI.LE.0)THEN
            IF(INUMSW.EQ.'OFF')THEN
               WRITE(ICOUT,999)
               CALL DPWRST('XXX','WRIT')
            ELSE
               WRITE(ICOUT,4119)I
 4119          FORMAT(I8,'--')
               CALL DPWRST('XXX','WRIT')
            ENDIF
         ENDIF
C
         NUMLPR=NUMLPR+1
 4110 CONTINUE
C
 4150 CONTINUE
C
      IF(NCPOSH.LE.0)GOTO4159
      WRITE(ICOUT,4151)(ICPOSH(J:J),J=1,NCPOSH)
 4151 FORMAT(80A1)
      CALL DPWRST('XXX','WRIT')
 4159 CONTINUE
C
 4190 CONTINUE
C
C               **************************
C               **  STEP 51--           **
C               **  CLOSE THE FILE      **
C               **  (UNLESS ITS THE     **
C               **  CONCLUSIONS FILE).  **
C               **************************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFILE.EQ.ICONNA)GOTO5190
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
 5190 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
C
      IFILQU=IFILQ2
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'LIST')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9011)
 9011    FORMAT('***** AT THE END       OF DPLIST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012    FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9013)ICOM
 9013    FORMAT('ICOM = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9014)INUMSW
 9014    FORMAT('INUMSW = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9021)IOUNIT
 9021    FORMAT('IOUNIT = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9022)IFILE
 9022    FORMAT('IFILE  = ',A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9023)ISTAT
 9023    FORMAT('ISTAT  = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9024)IFORM
 9024    FORMAT('IFORM  = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9025)IACCES
 9025    FORMAT('IACCES = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9026)IPROT
 9026    FORMAT('IPROT  = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9027)ICURST
 9027    FORMAT('ICURST = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9028)IENDFI
 9028    FORMAT('IENDFI = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9029)IREWIN
 9029    FORMAT('IREWIN = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9031)ISUBN0
 9031    FORMAT('ISUBN0 = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9032)IERRFI
 9032    FORMAT('IERRFI = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9041)ICASEQ,NQ,NS
 9041    FORMAT('ICASEQ,NQ,NS = ',A4,I8,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9042)JMAX,NCSTRI
 9042    FORMAT('JMAX,NCSTRI = ',2I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9050)IHELMX
 9050    FORMAT('IHELMX = ',I8)
         CALL DPWRST('XXX','BUG ')
C
         WRITE(ICOUT,9051)NCPREH
 9051    FORMAT('NCPREH = ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(NCPREH.GE.1)THEN
            DO9052I=1,NCPREH
               WRITE(ICOUT,9053)I,ICPREH(I:I)
 9053          FORMAT('I,ICPREH(I:I) = ',I8,2X,A1,4X)
               CALL DPWRST('XXX','BUG ')
 9052       CONTINUE
         ENDIF
C
         WRITE(ICOUT,9056)NCPOSH
 9056    FORMAT('NCPOSH = ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(NCPOSH.GE.1)THEN
            DO9057I=1,NCPOSH
               WRITE(ICOUT,9058)I,ICPOSH(I:I)
 9058          FORMAT('I,ICPOSH(I:I) = ',I8,2X,A1,4X)
               CALL DPWRST('XXX','BUG ')
 9057       CONTINUE
         ENDIF
C
         WRITE(ICOUT,9061)IRESP
 9061    FORMAT('IRESP = ',A4)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPLITH(IHARG,IARGT,ARG,NUMARG,PDEFLT,MAXLIN,PLINTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LINE THICKNESSES.
C              THESE ARE LOCATED IN THE VECTOR PLINTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEFLT
C                     --MAXLIN
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PLINTH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
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--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PLINTH(*)
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
      ISUBN1='DPLI'
      ISUBN2='TH  '
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMLIN=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPLITH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXLIN,NUMLIN
   53 FORMAT('MAXLIN,NUMLIN = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDEFLT
   55 FORMAT('PDEFLT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PLINTH(1)
   70 FORMAT('PLINTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PLINTH(I)
   76 FORMAT('I,PLINTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=PDEFLT
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMLIN=1
      PLINTH(1)=PDEFLT
      GOTO1270
C
 1220 CONTINUE
      NUMLIN=NUMARG-1
      IF(NUMLIN.GT.MAXLIN)NUMLIN=MAXLIN
      DO1225I=1,NUMLIN
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFLT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFLT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFLT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFLT
      PLINTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMLIN
      WRITE(ICOUT,1276)I,PLINTH(I)
 1276 FORMAT('LINE THICKNESS ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLIN=MAXLIN
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFLT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFLT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFLT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFLT
      DO1315I=1,NUMLIN
      PLINTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PLINTH(I)
 1316 FORMAT('ALL LINE THICKNESSES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLITH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXLIN,NUMLIN
 9013 FORMAT('MAXLIN,NUMLIN = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDEFLT
 9015 FORMAT('PDEFLT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PLINTH(1)
 9030 FORMAT('PLINTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PLINTH(I)
 9036 FORMAT('I,PLINTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
