SUBROUTINE DPUOSM(IBUGA3,IBUGQ,IFOUND,IERROR) C C PURPOSE--GENERATE UNIFORM ORDER STATISTIC MEDIANS C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--APRIL 1978. C UPDATED --MAY 1978. C UPDATED --JUNE 1978. C UPDATED --MAY 1978. C UPDATED --NOVEMBER 1978. C UPDATED --JUNE 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --OCTOBER 1981. C UPDATED --MARCH 1982. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGA3 CHARACTER*4 IBUGQ CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 NEWNAM CHARACTER*4 NEWCOL CHARACTER*4 ICASEQ CHARACTER*4 ILEFT CHARACTER*4 ILEFT2 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN 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='DPUO' ISUBN2='SM ' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C IFOUND='NO' IERROR='NO' C IFOUND='YES' C NS2=0 C C *********************************************** C ** TREAT THE UNIFORM ORDER STATISTIC MEDIANS CASE ** C ** 1) FOR A FULL VARIABLE, OR ** C ** 2) FOR PART OF A VARIABLE. ** C *********************************************** C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPUOSM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3,IBUGQ 52 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ********************************** C ** STEP 1-- ** C ** INITIALIZE SOME VARIABLES. ** C ********************************** C ISTEPN='1' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NEWNAM='NO' NEWCOL='NO' C C ******************************************************* C ** STEP 2-- ** C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. ** C ******************************************************* C ISTEPN='2' IF(IBUGA3.EQ.'ON')CALL 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 ** EXAMINE THE LEFT-HAND SIDE-- * C ** IS THE PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN * C ** ALREADY IN THE NAME LIST? * C ** NOTE THAT ILEFT IS THE NAME OF THE VARIABLE * C ** ON THE LEFT. * C ** NOTE THAT ILISTL IS THE LINE IN THE TABLE * C ** OF THE NAME ON THE LEFT. * C ** NOTE THAT ICOLL IS THE DATA COLUMN (1 TO 12) * C ** FOR THE NAME OF THE LEFT. * C **************************************************************** C ISTEPN='3' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC ILEFT=IHOL(2) CCCCC ILEFT2=IHOL2(2) ILEFT=IHARG(1) ILEFT2=IHARG2(1) DO310I=1,NUMNAM I2=I IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO329 IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO380 310 CONTINUE NEWNAM='YES' ILISTL=NUMNAM+1 IF(ILISTL.GT.MAXNAM)GOTO320 GOTO330 C 320 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,321) 321 FORMAT('***** ERROR IN DPUOSM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,322) 322 FORMAT(' THE NUMBER OF VARIABLE AND/OR PARAMETER') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,323)MAXNAM 323 FORMAT(' NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ', 1I8,' .') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,324) 324 FORMAT(' SUGGESTED ACTION--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,325) 325 FORMAT(' ENTER STAT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,326) 326 FORMAT(' TO FIND OUT THE FULL LIST OF USED NAMES,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,327) 327 FORMAT(' AND THEN REDEFINE (REUSE) SOME OF THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,328) 328 FORMAT(' ALREADY-USED NAMES') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 329 CONTINUE ILISTL=I2 GOTO330 C 330 CONTINUE NLEFT=0 ICOLL=NUMCOL+1 IF(ICOLL.GT.MAXCOL)GOTO340 GOTO390 C 340 CONTINUE WRITE(ICOUT,341) 341 FORMAT('***** ERROR IN DPUOSM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,342) 342 FORMAT(' THE NUMBER OF DATA COLUMNS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,343)MAXCOL 343 FORMAT(' HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,' .') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,344) 344 FORMAT(' SUGGESTED ACTION--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,345) 345 FORMAT(' ENTER STAT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,346) 346 FORMAT(' TO FIND OUT THE FULL LIST OF USED COLUMNS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,347) 347 FORMAT(' AND THEN OVERWRITE SOME COLUMNS. EXAMPLE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,348) 348 FORMAT(' IF LET X(I) = 3.14 FAILED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,349) 349 FORMAT(' THEN ONE MIGHT ENTER NAME X 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,350) 350 FORMAT(' (THEREBY EQUATING THE NAME X WITH COLUMN 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,351) 351 FORMAT(' FOLLOWED BY LET X = 3.14') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,352) 352 FORMAT(' (WHICH WILL ACTUALLY OVERWRITE COLUMN 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,353) 353 FORMAT(' WITH THE NUMERIC CONSTANTS 3.14)') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 380 CONTINUE ILISTL=I2 ICOLL=IVALUE(ILISTL) NLEFT=IN(ILISTL) C 390 CONTINUE C C ***************************************** C ** STEP 6-- ** C ** CHECK TO SEE THE TYPE SUBCASE ** C ** (BASED ON THE QUALIFIER) ** C ** 1) UNQUALIFIED (THAT IS, FULL); ** C ** 2) SUBSET/EXCEPT; OR ** C ** 3) FOR. ** C ***************************************** C ISTEPN='6' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASEQ='FULL' ILOCQ=NUMARG+1 IF(NUMARG.LT.1)GOTO670 DO610J=1,NUMARG J1=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ')GOTO620 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ')GOTO620 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ')GOTO630 610 CONTINUE GOTO680 C 620 CONTINUE ICASEQ='SUBS' ILOCQ=J1 GOTO680 C 630 CONTINUE ICASEQ='FOR' ILOCQ=J1 GOTO680 C 670 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,671) 671 FORMAT('***** INTERNAL ERROR IN DPUOSM') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,672) 672 FORMAT(' AT BRANCH POINT 5081--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,673) 673 FORMAT(' NUMARG LESS THAN 1 EVEN THOUGH') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,674) 674 FORMAT(' NUMARG HAD PREVIOUSLY PASSED THIS TEST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,675)NUMARG 675 FORMAT(' ONCE ALREADY. VALUE OF NUMARG = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,676) 676 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,677)(IANS(I),I=1,IWIDTH) 677 FORMAT(80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 680 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO690 WRITE(ICOUT,681)NUMARG,ILOCQ,ICASEQ 681 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4) CALL DPWRST('XXX','BUG ') C 690 CONTINUE C C ****************************************************** C ** STEP 7-- ** C ** BRANCH TO THE APPROPRIATE SUBCASE ** C ** (BASED ON THE QUALIFIER); ** C ** DETERMINE THE NUMBER (= NUOSM) ** C ** OF UNIFORM ORDER STATISTIC MEDIANS TO BE GENERATED. C ** NOTE THAT THE VARIABLE NIISUB ** C ** IS THE LENGTH OF THE RESULTING ** C ** VARIABLE ISUB(.). ** C ** NOTE THAT DPFOR AUTOMATICALLY EXTENDS ** C ** THE INPUT LENGTH OF ISUB(.) IF NECESSARY. ** C ** (HENCE THE REDEFINITION OF NIISUB TO NINEW ** C ** AFTER THE CALL TO DPFOR. ** C ****************************************************** C ISTEPN='7' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASEQ.EQ.'FULL')GOTO710 IF(ICASEQ.EQ.'SUBS')GOTO720 IF(ICASEQ.EQ.'FOR')GOTO730 C 710 CONTINUE IF(NEWNAM.EQ.'NO')NIISUB=NLEFT IF(NEWNAM.EQ.'YES')NIISUB=MAXN DO715I=1,NIISUB ISUB(I)=1 715 CONTINUE NUOSM=NIISUB GOTO750 C 720 CONTINUE NIISUB=MAXN CALL DPSUBS(NIISUB,ILOCS,NS,IBUGQ,IERROR) NUOSM=NS GOTO750 C 730 CONTINUE IF(NEWNAM.EQ.'NO')NIISUB=NLEFT IF(NEWNAM.EQ.'YES')NIISUB=MAXN CALL DPFOR(NIISUB,NINEW,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERROR) NIISUB=NINEW NUOSM=NS GOTO750 C 750 CONTINUE C C ****************************************** C ** STEP 8-- ** C ** GENERATE NUOSM UNIFORM ORDER ** C ** STATISTIC MEDIANS. ** C ** STORE THEM TEMPORARILY IN ** C ** THE VECTOR Y(.). ** C ****************************************** C ISTEPN='8' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL UNIMED(NUOSM,Y) C C *********************************************************** C ** STEP 8-- ** C ** IF CALLED FOR (THAT IS, IF IBUGA3 IS ON), ** C ** PRINT OUT THE INTERMEDIATE VARIABLE Y(.). ** C ** THIS IS USEFUL FOR DIAGNOSTIC PURPOSES ** C ** IN REVIEWING THE OUTPUT FROM THIS SUBROUTINE. ** C *********************************************************** C ISTEPN='9' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGA3.EQ.'OFF')GOTO2090 WRITE(ICOUT,2051) 2051 FORMAT('OUTPUT FROM MIDDLE OF DPUOSM AFTER UNIMED ', 1'HAS BEEN CALLED--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2052)NUOSM 2052 FORMAT('NUOSM = ',I8) CALL DPWRST('XXX','BUG ') IF(NUOSM.LE.0)GOTO2090 DO2054I=1,NUOSM WRITE(ICOUT,2055)I,Y(I) 2055 FORMAT('I,Y(I) = ',I8,F12.5) CALL DPWRST('XXX','BUG ') 2054 CONTINUE C 2090 CONTINUE C C ****************************************************** C ** STEP 9-- ** C ** COPY THE ORDER STATISTIC MEDIANS ** C ** FROM THE INTERMEDIATE VECTOR Y(.) ** C ** TO THE APPROPRIATE COLUMN ** C ** (BASED ON THE QUALIFIER--FULL, SUBSET, OR FOR) ** C ** IN THE INTERNAL DATAPLOT DATA TABLE. ** C ****************************************************** C ISTEPN='10' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NS2=0 DO2100I=1,NIISUB IJ=MAXN*(ICOLL-1)+I IF(ISUB(I).EQ.0)GOTO2100 NS2=NS2+1 IF(ICOLL.LE.MAXCOL)V(IJ)=Y(NS2) IF(ICOLL.EQ.MAXCP1)PRED(I)=Y(NS2) IF(ICOLL.EQ.MAXCP2)RES(I)=Y(NS2) IF(ICOLL.EQ.MAXCP3)YPLOT(I)=Y(NS2) IF(ICOLL.EQ.MAXCP4)XPLOT(I)=Y(NS2) IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=Y(NS2) IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=Y(NS2) IF(NS2.EQ.1)IROW1=I IROWN=I 2100 CONTINUE C C ******************************************* C ** STEP 10-- ** C ** CARRY OUT THE LIST UPDATING AND ** C ** GENERATE THE INFORMATIVE PRINTING. ** C ******************************************* C ISTEPN='11' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO')NINEW=NLEFT IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'YES')NINEW=MAXN IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND. 1NLEFT.GE.IROWN)NINEW=NLEFT IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND. 1NLEFT.LT.IROWN)NINEW=IROWN IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'YES')NINEW=IROWN IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND. 1NLEFT.GE.IROWN)NINEW=NLEFT IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND. 1NLEFT.LT.IROWN)NINEW=IROWN IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'YES')NINEW=IROWN C IHNAME(ILISTL)=ILEFT IHNAM2(ILISTL)=ILEFT2 IUSE(ILISTL)='V' IVALUE(ILISTL)=ICOLL VALUE(ILISTL)=ICOLL IN(ILISTL)=NINEW C CCCCC IUSE(ICOLL)='V' CCCCC IVALUE(ICOLL)=ICOLL CCCCC VALUE(ICOLL)=ICOLL CCCCC IN(ICOLL)=NINEW C IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1 IF(NEWNAM.EQ.'YES')NUMCOL=NUMCOL+1 C DO4100J4=1,NUMNAM IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO4105 GOTO4100 4105 CONTINUE IUSE(J4)='V' IVALUE(J4)=ICOLL VALUE(J4)=ICOLL IN(J4)=NINEW 4100 CONTINUE C IF(IPRINT.EQ.'OFF')GOTO4059 IF(IFEEDB.EQ.'OFF')GOTO4059 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4011)ILEFT,ILEFT2,NS2 4011 FORMAT('THE NUMBER OF VALUES GENERATED FOR ', 1'THE VARIABLE ',A4,A4,' = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') C IJ=MAXN*(ICOLL-1)+IROW1 IF(ICOLL.LE.MAXCOL)THEN WRITE(ICOUT,4021)ILEFT,ILEFT2,V(IJ),IROW1 4021 FORMAT('THE FIRST COMPUTED VALUE OF ', 1 A4,A4,' = ',E15.7,' (ROW ',I6,')') CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP1)THEN WRITE(ICOUT,4021)ILEFT,ILEFT2,PRED(IROW1),IROW1 CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP2)THEN WRITE(ICOUT,4021)ILEFT,ILEFT2,RES(IROW1),IROW1 CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP3)THEN WRITE(ICOUT,4021)ILEFT,ILEFT2,YPLOT(IROW1),IROW1 CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP4)THEN WRITE(ICOUT,4021)ILEFT,ILEFT2,XPLOT(IROW1),IROW1 CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP5)THEN WRITE(ICOUT,4021)ILEFT,ILEFT2,X2PLOT(IROW1),IROW1 CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP6)THEN WRITE(ICOUT,4021)ILEFT,ILEFT2,TAGPLO(IROW1),IROW1 CALL DPWRST('XXX','BUG ') ENDIF C IJ=MAXN*(ICOLL-1)+IROWN IF(NS2.NE.1)THEN IF(ICOLL.LE.MAXCOL)THEN WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,V(IJ),IROWN 4031 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ', 1 A4,A4,' = ',E15.7,' (ROW ',I6,')') CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP1)THEN WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,PRED(IROWN),IROWN CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP2)THEN WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,RES(IROWN),IROWN CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP3)THEN WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,YPLOT(IROWN),IROWN CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP4)THEN WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,XPLOT(IROWN),IROWN CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP5)THEN WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,X2PLOT(IROWN),IROWN CALL DPWRST('XXX','BUG ') ELSE IF(ICOLL.EQ.MAXCP6)THEN WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,TAGPLO(IROWN),IROWN CALL DPWRST('XXX','BUG ') ENDIF ENDIF IF(NS2.NE.1)GOTO4090 WRITE(ICOUT,4041) 4041 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4042) 4042 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.') CALL DPWRST('XXX','BUG ') 4090 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4112)ILEFT,ILEFT2,ICOLL 4112 FORMAT('THE CURRENT COLUMN FOR ', 1'THE VARIABLE ',A4,A4,' = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4113)ILEFT,ILEFT2,NINEW 4113 FORMAT('THE CURRENT LENGTH OF ', 1'THE VARIABLE ',A4,A4,' = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') 4059 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPUOSM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IFOUND,IERROR 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IBUGA3,IBUGQ 9013 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)NS2 9015 FORMAT('NS2 = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)NS,NIISUB,NUOSM 9016 FORMAT('NS,NIISUB,NUOSM = ',I8,I8,I8) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPUPDV(IHNAME,IHNAM2,IUSE,IVALUE,IVALU2,VALUE,IN, CCCCC UPDATE VARIABLE LABELS. JANUARY 2000. 1IVARLB, CCCCC OCTOBER 1993. ADD IVALU2 TO ARGUMENT LIST (DELETE CAUSED CCCCC PROBLEMS WITH MATRICES THAT FOLLOWED ON VARIABLE LIST). CCCCC SUBROUTINE DPUPDV(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN, 1IVSTAR,IVSTOP,MAXNAM,NUMNAM,V,MAXN,MAXCOL,NUMCOL, 1IBUGS2,IERROR) C C PURPOSE--HANDLE THE CASE IN WHICH DATA VARIABLES HAVE C BEEN DELETED AND SO THE ENTIRE DATA ARRAY C MUST BE SHIFTED TO AVOID HOLES IN THE ARRAY. C UPDATE HOUSEKEEPING TABLES ACCORDINGLY. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--DECEMBER 1981. C UPDATED --MAY 1982. C UPDATED --OCTOBER 1993. ADD IVALU2 (FIX MATRICES BUG) C UPDATED --JUNE 1994. BUG FOR PARAMETERS C UPDATED --OCTOBER 1997. RE-INIATILIZE TO ZERO INSTEAD C OF CPUMIN C UPDATED --JANUARY 2000. SUPPORT FOR VARIABLE LABELS C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IHNAME CHARACTER*4 IHNAM2 CHARACTER*4 IUSE CHARACTER*4 IBUGS2 CHARACTER*4 IERROR C CHARACTER*40 IVARLB C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C DIMENSION IHNAME(*) DIMENSION IHNAM2(*) DIMENSION IUSE(*) DIMENSION IVALUE(*) CCCCC OCTOBER 1993. ADD FOLLOWING LINE. DIMENSION IVALU2(*) DIMENSION VALUE(*) DIMENSION IN(*) DIMENSION IVSTAR(*) DIMENSION IVSTOP(*) C DIMENSION IVARLB(*) C DIMENSION V(*) 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='DPUP' ISUBN2='DV ' C IERROR='NO' C IF(IBUGS2.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPUPDV--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGS2,IERROR 52 FORMAT('IBUGS2,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)MAXNAM,NUMNAM 53 FORMAT('MAXNAM,NUMNAM = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)MAXN,MAXCOL,NUMCOL 54 FORMAT('MAXN,MAXCOL,NUMCOL = ',3I8) CALL DPWRST('XXX','BUG ') DO60I=1,NUMNAM WRITE(ICOUT,61)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) 61 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ', 1I8,2X,A4,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) 62 FORMAT('I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) = ', 1I8,2X,A4,A4,6X,I8,I8,I8) CALL DPWRST('XXX','BUG ') 60 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO70J=1,NUMCOL IJ=MAXN*(J-1)+1 WRITE(ICOUT,71)J,MAXN,IJ,V(IJ) 71 FORMAT('J,MAXN,IJ,V(IJ) = ',I8,I8,I8,E15.7) CALL DPWRST('XXX','BUG ') 70 CONTINUE 90 CONTINUE C C ********************************************* C ** STEP 1-- ** C ** UPDATE THE HOUSEKEEPING TABLES. ** C ** ELIMINATE ANY ENTRIES IN THESE TABLES ** C ** WHICH HAVE LENGTH OF VARIABLE = 0; ** C ** THAT IS, WHICH HAVE IN(.) = 0. ** C ********************************************* C ISTEPN='1' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMNAM.LE.0)GOTO1129 J=0 1101 CONTINUE J=J+1 IF(J.GT.NUMNAM)GOTO1129 IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.' ')GOTO1100 IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.' ')GOTO1100 IF(IHNAME(J).EQ.'YPLO'.AND.IHNAM2(J).EQ.'T ')GOTO1100 IF(IHNAME(J).EQ.'XPLO'.AND.IHNAM2(J).EQ.'T ')GOTO1100 IF(IHNAME(J).EQ.'X2PL'.AND.IHNAM2(J).EQ.'OT ')GOTO1100 IF(IHNAME(J).EQ.'TAGP'.AND.IHNAM2(J).EQ.'LOT ')GOTO1100 IF(IUSE(J).EQ.'V'.AND.IN(J).LE.0)GOTO1109 CCCCC OCTOBER 1993. ADD FOLLOWING 2 LINES CCCCC JUNE 1994. FOR PARAMETER, SET TO -1 TO DELETE (SOME INTERNALLY CCCCC SET PARAMETERS DO NOT SET IN(.), WHICH CAUSED BUGS WHEN RETAIN CCCCC OR DELETE ENTERED). CCCCC IF(IUSE(J).EQ.'P'.AND.IN(J).LE.0)GOTO1109 IF(IUSE(J).EQ.'P'.AND.IN(J).LT.0)GOTO1109 IF(IUSE(J).EQ.'M'.AND.IN(J).LE.0)GOTO1109 GOTO1100 1109 CONTINUE C JP1=J+1 IF(JP1.GT.NUMNAM)GOTO1119 DO1110K=JP1,NUMNAM KM1=K-1 IHNAME(KM1)=IHNAME(K) IHNAM2(KM1)=IHNAM2(K) IUSE(KM1)=IUSE(K) IVALUE(KM1)=IVALUE(K) CCCCC OCTOBER 1993. ADD FOLLOWING LINE. IVALU2(KM1)=IVALU2(K) VALUE(KM1)=VALUE(K) IN(KM1)=IN(K) IVSTAR(KM1)=IVSTAR(K) IVSTOP(KM1)=IVSTOP(K) IVARLB(KM1)=IVARLB(K) 1110 CONTINUE 1119 CONTINUE NUMNAM=NUMNAM-1 J=J-1 C 1100 CONTINUE GOTO1101 1129 CONTINUE C C ************************************************ C ** STEP 2-- ** C ** DETERMINE THE LARGEST COLUMN REFERENCED. ** C ************************************************ C ISTEPN='2' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICOLMX=0 IF(NUMNAM.LE.0)GOTO2159 DO2150J=1,NUMNAM IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.' ')GOTO2150 IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.' ')GOTO2150 IF(IHNAME(J).EQ.'YPLO'.AND.IHNAM2(J).EQ.'T ')GOTO2150 IF(IHNAME(J).EQ.'XPLO'.AND.IHNAM2(J).EQ.'T ')GOTO2150 IF(IHNAME(J).EQ.'X2PL'.AND.IHNAM2(J).EQ.'OT ')GOTO2150 IF(IHNAME(J).EQ.'TAGP'.AND.IHNAM2(J).EQ.'LOT ')GOTO2150 IF(IUSE(J).EQ.'V'.AND.IVALUE(J).GT.ICOLMX)ICOLMX=IVALUE(J) CCCCC OCTOBER 1993. ADD FOLLOWING LINE IF(IUSE(J).EQ.'M'.AND.IVALUE(J).GT.ICOLMX)ICOLMX=IVALUE(J) 2150 CONTINUE 2159 CONTINUE C C ******************************************************* C ** STEP 3-- ** C ** TREAT THE CASE WHERE THERE IS AT LEAST ** C ** 1 VARIABLE IN THE DATA ARRAY WHICH MAY ** C ** (AT LEAST POTENTIALLY) BE SHIFTED (COMPRESSED). ** C ******************************************************* C ISTEPN='3' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICODE=0 NUMCO2=NUMCOL IF(ICOLMX.LE.0)GOTO3900 DO3300ICOL=1,ICOLMX C IPASS=0 IF(NUMNAM.LE.0)GOTO3900 DO3400J=1,NUMNAM IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.' ')GOTO3400 IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.' ')GOTO3400 IF(IHNAME(J).EQ.'YPLO'.AND.IHNAM2(J).EQ.'T ')GOTO3400 IF(IHNAME(J).EQ.'XPLO'.AND.IHNAM2(J).EQ.'T ')GOTO3400 IF(IHNAME(J).EQ.'X2PL'.AND.IHNAM2(J).EQ.'OT ')GOTO3400 IF(IHNAME(J).EQ.'TAGP'.AND.IHNAM2(J).EQ.'LOT ')GOTO3400 IF(IUSE(J).EQ.'V'.AND.IVALUE(J).EQ.ICOL)GOTO3450 CCCCC OCTOBER 1993. ADD FOLLOWING LINE IF(IUSE(J).EQ.'M'.AND.IVALUE(J).EQ.ICOL)GOTO3450 GOTO3400 C 3450 CONTINUE IPASS=IPASS+1 IF(IPASS.EQ.1)ICODE=ICODE+1 IF(IPASS.EQ.1)GOTO3460 GOTO3470 C 3460 CONTINUE IF(IVALUE(J).EQ.ICODE)GOTO3490 ICOLOL=IVALUE(J) C IMAX=MAXN DO3461I=1,IMAX IJ=MAXN*(ICODE-1)+I CCCCC OCTOBER 1997. FIX FOLLOWING LINE CCCCC V(IJ)=CPUMIN V(IJ)=0.0 3461 CONTINUE C IMAX=IN(J) DO3462I=1,IMAX IJ=MAXN*(ICODE-1)+I IJOL=MAXN*(ICOLOL-1)+I V(IJ)=V(IJOL) 3462 CONTINUE C IMAX=MAXN DO3463I=1,IMAX IJOL=MAXN*(ICOLOL-1)+I CCCCC OCTOBER 1997. FIX FOLLOWING LINE CCCCC V(IJOL)=CPUMIN V(IJOL)=0.0 3463 CONTINUE C GOTO3470 C 3470 CONTINUE IVALUE(J)=ICODE CCCCC OCTOBER 1993. ADD FOLLOWING LINE IVALU2(J)=IVALU2(J)-(ICOLOL-ICODE) VALUE(J)=IVALUE(J) IVSTAR(J)=MAXN*(ICODE-1)+1 IVSTOP(J)=MAXN*(ICODE-1)+IN(J) C 3490 CONTINUE 3400 CONTINUE 3300 CONTINUE 3900 CONTINUE NUMCOL=ICODE C C ***************************************** C ** STEP 4-- ** C ** TREAT THE CASE WHERE NO VARIABLES ** C ** REMAIN IN THE DATA ARRAY. ** C ***************************************** C ISTEPN='4' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICOLMX.LE.0)GOTO4100 GOTO4900 4100 CONTINUE IF(NUMCO2.LE.0)GOTO4900 DO4200J=1,NUMCO2 DO4300I=1,MAXN IJ=MAXN*(J-1)+I CCCCC OCTOBER 1997. FIX FOLLOWING LINE CCCCC V(IJ)=CPUMIN V(IJ)=0.0 4300 CONTINUE 4200 CONTINUE 4900 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPUPDV--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGS2,IERROR 9012 FORMAT('IBUGS2,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)MAXNAM,NUMNAM 9013 FORMAT('MAXNAM,NUMNAM = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)MAXN,MAXCOL,NUMCOL 9014 FORMAT('MAXN,MAXCOL,NUMCOL = ',3I8) CALL DPWRST('XXX','BUG ') DO9020I=1,NUMNAM WRITE(ICOUT,9021)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) 9021 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ', 1I8,2X,A4,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) 9022 FORMAT('I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) = ', 1I8,2X,A4,A4,6X,I8,I8,I8) CALL DPWRST('XXX','BUG ') 9020 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO9030J=1,NUMCOL IJ=MAXN*(J-1)+1 WRITE(ICOUT,9031)J,MAXN,IJ,V(IJ) 9031 FORMAT('J,MAXN,IJ,V(IJ) = ',I8,I8,I8,E15.7) CALL DPWRST('XXX','BUG ') 9030 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPUPD2(NUMADD,NFIRST,IBUGS2,IERROR) C C PURPOSE--ADD NUMADD BLANK COLUMNS BEFORE COLUMN IDENTIFIED C BY NFIRST. REQUIRED BY THE MATRIX AUGMENT COMMAND. 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-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--93/10 C ORIGINAL VERSION--OCTOBER 1993. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGS2 CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C-----CHARACTER STATEMENTS FOR COMMON VARIABLES------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' 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='DPUP' ISUBN2='D2 ' C IERROR='NO' C IF(IBUGS2.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPUPD2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGS2,IERROR 52 FORMAT('IBUGS2,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)MAXNAM,NUMNAM 53 FORMAT('MAXNAM,NUMNAM = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)MAXN,MAXCOL,NUMCOL 54 FORMAT('MAXN,MAXCOL,NUMCOL = ',3I8) CALL DPWRST('XXX','BUG ') DO60I=1,NUMNAM WRITE(ICOUT,61)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) 61 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ', 1I8,2X,A4,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) 62 FORMAT('I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) = ', 1I8,2X,A4,A4,6X,I8,I8,I8) CALL DPWRST('XXX','BUG ') 60 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO70J=1,NUMCOL IJ=MAXN*(J-1)+1 WRITE(ICOUT,71)J,MAXN,IJ,V(IJ) 71 FORMAT('J,MAXN,IJ,V(IJ) = ',I8,I8,I8,E15.7) CALL DPWRST('XXX','BUG ') 70 CONTINUE WRITE(ICOUT,76)NFIRST,NUMADD 76 FORMAT('NFIRST,NUMADD = ',I8,2X,I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ********************************************* C ** STEP 1-- ** C ** CHECK THAT MAXIMUM NUMBER OF COLUMNS ** C ** WON'T BE EXCEEDED. ** C ********************************************* C ISTEPN='1' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NFIRST+NUMADD.LE.MAXCOL)GOTO199 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,101) 101 FORMAT('***** ERROR FROM DPUPD2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,102) 102 FORMAT(' ADDING ADDITIONAL COLUMNS WILL EXCEED MAXIMUM') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,103) 103 FORMAT(' NUMER OF ALLOWED COLUMNS.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,104)NUMADD 104 FORMAT(' NUMER OF COLUMNS TO ADD = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,105)MAXCOL 105 FORMAT(' MAXIMUM NUMER OF COLUMNS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,106)NUMCOL 106 FORMAT(' CURRENT NUMER OF COLUMNS = ',I8) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9090 199 CONTINUE C DO200I=1,NUMNAM IF(NFIRST.EQ.IVALUE(I))THEN IINDX=I GOTO209 ENDIF 200 CONTINUE 209 CONTINUE C C C ********************************************* C ** STEP 2-- ** C ** UPDATE THE HOUSEKEEPING TABLES. ** C ** ELIMINATE ANY ENTRIES IN THESE TABLES ** C ** WHICH HAVE LENGTH OF VARIABLE = 0; ** C ** THAT IS, WHICH HAVE IN(.) = 0. ** C ********************************************* C ISTEPN='2' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMADD.LE.0)GOTO9090 IF(NFIRST.GE.NUMCOL)GOTO9090 IF(NFIRST.LT.1)GOTO9090 IF(NFIRST.LT.1)GOTO9090 C DO1110K=NUMNAM,IINDX,-1 KM1=K+NUMADD IHNAME(KM1)=IHNAME(K) IHNAM2(KM1)=IHNAM2(K) IUSE(KM1)=IUSE(K) IF(IUSE(K).EQ.'V'.OR.IUSE(K).EQ.'M')THEN IVALUE(KM1)=IVALUE(K)+NUMADD IVALU2(KM1)=IVALU2(K)+NUMADD ELSE IVALUE(KM1)=IVALUE(K) IVALU2(KM1)=IVALU2(K) ENDIF VALUE(KM1)=VALUE(K) IN(KM1)=IN(K) IVSTAR(KM1)=IVSTAR(K) IVSTOP(KM1)=IVSTOP(K) 1110 CONTINUE C NTEMP2=IINDX+NUMADD-1 NTEMP1=IINDX-1 IF(NTEMP1.LT.1)NTEMP1=1 DO1120K=NTEMP1,NTEMP2 IHNAME(K)=' ' IHNAM2(K)=' ' IUSE(K)='UNKN' IVALUE(K)=0 IVALU2(K)=0 VALUE(K)=0.0 IN(K)=0 IVSTAR(K)=0 IVSTOP(K)=0 1120 CONTINUE C IMAX=MAXN IVINC=NUMADD*IMAX NTEMP1=(NFIRST-1)*IMAX+1 IF(NTEMP1.LT.1)NTEMP1=1 NTEMP2=NUMCOL*IMAX DO1130K=NTEMP2,NTEMP1,-1 V(K+IVINC)=V(K) 1130 CONTINUE NTEMP2=NTEMP1-1+NUMADD*IMAX DO1140K=NTEMP1,NTEMP2 V(K)=0.0 1140 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPUPD2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGS2,IERROR 9012 FORMAT('IBUGS2,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IINDX,MAXNAM,NUMNAM 9013 FORMAT('IINDX,MAXNAM,NUMNAM = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)MAXN,MAXCOL,NUMCOL 9014 FORMAT('MAXN,MAXCOL,NUMCOL = ',3I8) CALL DPWRST('XXX','BUG ') DO9020I=1,NUMNAM WRITE(ICOUT,9021)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) 9021 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ', 1I8,2X,A4,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) 9022 FORMAT('I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) = ', 1I8,2X,A4,A4,6X,I8,I8,I8) CALL DPWRST('XXX','BUG ') 9020 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO9030J=1,NUMCOL IJ=MAXN*(J-1)+1 WRITE(ICOUT,9031)J,MAXN,IJ,V(IJ) 9031 FORMAT('J,MAXN,IJ,V(IJ) = ',I8,I8,I8,E15.7) CALL DPWRST('XXX','BUG ') 9030 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPVECT(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1IVCFMT,IVCARR,IANGLU, 1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR) C C PURPOSE--GENERATE A VECTOR PLOT-- C THE VECTOR CAN BE REPRESENTED IN ONE OF 3 WAYS: C 1) YSTART XSTART YSTOP XSTOP C (I.E., START AND END POINT OF VECTOR) C 2) YSTART XSTART ANGLE DIST C (I.E., START POINT, ANGLE OF VECTOR AND LENGTH C OF VECTOR) C 3) YSTART XSTART YDELTA XDELTA C (I.E., START POINT, X AND Y COMPONENTS OF VECTOR) C THE FORMAT IS DETERMINED BY THE COMMAND: C VECTOR FORMAT C THE ARROW HEAD CAN BE EITHER A FIXED SIZE OR A C VARY ACCORDING TO THE VECTOR LENGTH (THE CHAR SIZE C COMMAND WILL SET THE ARROW SIZE FOR THE LARGEST VECTOR). C THIS IS CONTROLLED WITH THE COMMAND: C VECTOR ARROW C EXAMPLE--VECTOR PLOT XSTART XSTOP ANGLE DISTANCE 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-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--92/8 C ORIGINAL VERSION--AUGUST 1992. C UPDATED --SEPTEMBER 1993. BUG FIX C UPDATED --AUGUST 1994. BUG FIX FOR VARIABLE CASE C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASPL CHARACTER*4 IAND1 CHARACTER*4 IAND2 CHARACTER*4 IVCFMT CHARACTER*4 IVCARR CHARACTER*4 IANGLU CHARACTER*4 IBUGG2 CHARACTER*4 IBUGG3 CHARACTER*4 IBUGQ CHARACTER*4 ISUBRO CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 IHRI11 CHARACTER*4 IHRI12 CHARACTER*4 IHRI21 CHARACTER*4 IHRI22 CHARACTER*4 IHRI31 CHARACTER*4 IHRI32 CHARACTER*4 IHRI41 CHARACTER*4 IHRI42 C$ CHARACTER*4 ICASEQ CHARACTER*4 ICTAR1 CHARACTER*4 ICTAR2 C$ 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) DIMENSION Y4(MAXOBV) CCCCC FOLLOWING LINES ADDED JUNE, 1990 INCLUDE 'DPCOZZ.INC' EQUIVALENCE (GARBAG(IGARB1),Y1(1)) EQUIVALENCE (GARBAG(IGARB2),Y2(1)) EQUIVALENCE (GARBAG(IGARB3),Y3(1)) EQUIVALENCE (GARBAG(IGARB4),Y4(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 IERROR='NO' IFOUND='NO' C ISUBN1='DPVE' ISUBN2='CT ' C ICASPL='VECT' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C MAXV2=4 MINN2=1 C ICOLH=0 C C *********************************** C ** TREAT THE VECTOR PLOT CASE ** C *********************************** C IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'VECT')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPVECT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG2,IBUGG3,IBUGQ,ISUBRO 52 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)ICASPL,IAND1,IAND2 53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)MAXN 54 FORMAT('MAXN = ',I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C *************************** C ** STEP 1-- ** C ** EXTRACT THE COMMAND ** C *************************** C ISTEPN='11' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VECT') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO111 GOTO119 C 111 CONTINUE ILASTC=1 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO119 C 119 CONTINUE IFOUND='YES' GOTO190 C 190 CONTINUE C C *********************************************************** C ** STEP 2-- ** C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. ** C ** AT LEAST 4 REQUIRED ** C *********************************************************** C ISTEPN='2' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VECT') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C MINNA=4 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C C C **************************************************************** C ** STEP 3-- * C ** EXAMINE THE RIGHT-HAND SIDE-- * C ** HAS EACH VARIABLE ON THE RIGHT * C ** ALREADY BEEN DEFINED? * C ** NOTE THAT ILISR1, ILISR2, ILISR3, ILISR4 * C ** IS THE LINE IN THE TABLE * C ** OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, * C ** RESPECTIVELY. * C ** NOTE THAT ICOLR1, ICOLR2, ICOLR3, ICOLR4 * C ** IS THE DATA COLUMN (1 TO 10+6) * C ** OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, * C ** RESPECTIVELY. * C **************************************************************** C ISTEPN='3' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VECT') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICTAR1='FIRS' ICTAR2='T ' ILOCR1=1 IHRI11=IHARG(ILOCR1) IHRI12=IHARG2(ILOCR1) DO3010I=1,NUMNAM I2=I IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO3019 IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO3060 3010 CONTINUE GOTO3070 3019 CONTINUE ILISR1=I2 ICOLR1=IVALUE(ILISR1) NIRIG1=IN(ILISR1) C ICTAR1='SECO' ICTAR2='ND ' ILOCR2=2 IHRI21=IHARG(ILOCR2) IHRI22=IHARG2(ILOCR2) DO3020I=1,NUMNAM I2=I IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO3029 IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO3060 3020 CONTINUE GOTO3070 3029 CONTINUE ILISR2=I2 ICOLR2=IVALUE(ILISR2) NIRIG2=IN(ILISR2) C ICTAR1='THIR' ICTAR2='D ' ILOCR3=3 IHRI31=IHARG(ILOCR3) IHRI32=IHARG2(ILOCR3) DO3030I=1,NUMNAM I2=I IF(IHRI31.EQ.IHNAME(I).AND.IHRI32.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO3039 IF(IHRI31.EQ.IHNAME(I).AND.IHRI32.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO3060 3030 CONTINUE GOTO3070 3039 CONTINUE ILISR3=I2 ICOLR3=IVALUE(ILISR3) NIRIG3=IN(ILISR3) C ICTAR1='FOUR' ICTAR2='TH ' ILOCR4=4 IHRI41=IHARG(ILOCR4) IHRI42=IHARG2(ILOCR4) DO3040I=1,NUMNAM I2=I IF(IHRI41.EQ.IHNAME(I).AND.IHRI42.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO3049 IF(IHRI41.EQ.IHNAME(I).AND.IHRI42.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO3060 3040 CONTINUE GOTO3070 3049 CONTINUE ILISR4=I2 ICOLR4=IVALUE(ILISR4) NIRIG4=IN(ILISR4) GOTO3090 C 3060 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3061) 3061 FORMAT('***** ERROR IN DPVECT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3062)ICTAR1,ICTAR2 3062 FORMAT(' THE SPECIFIED ',A4,A4,' ARGUMENT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3065) 3065 FORMAT(' WAS FOUND IN THE INTERNAL NAME LIST,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3066) 3066 FORMAT(' BUT AS A PARAMETER,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3067) 3067 FORMAT(' AND NOT AS A VARIABLE AS IT SHOULD BE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3068) 3068 FORMAT(' THE COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3069)(IANS(I),I=1,IWIDTH) 3069 FORMAT(80A1) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 3070 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3071) 3071 FORMAT('***** ERROR IN DPVECT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3072)ICTAR1,ICTAR2 3072 FORMAT(' THE SPECIFIED ',A4,A4,' ARGUMENT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3075) 3075 FORMAT(' WAS NOT FOUND IN THE INTERNAL NAME LIST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3076) 3076 FORMAT(' OF AVAILABLE VARIABLE NAMES.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IF(ICTAR1.EQ.'FIRS')WRITE(ICOUT,3077)IHRI11,IHRI12 IF(ICTAR1.EQ.'FIRS')CALL DPWRST('XXX','BUG ') IF(ICTAR1.EQ.'SECO')WRITE(ICOUT,3077)IHRI21,IHRI22 IF(ICTAR1.EQ.'SECO')CALL DPWRST('XXX','BUG ') IF(ICTAR1.EQ.'THIR')WRITE(ICOUT,3077)IHRI31,IHRI32 IF(ICTAR1.EQ.'THIR')CALL DPWRST('XXX','BUG ') IF(ICTAR1.EQ.'FOUR')WRITE(ICOUT,3077)IHRI41,IHRI42 3077 FORMAT(' THE VARIABLE IN QUESTION WAS ',A4,A4) IF(ICTAR1.EQ.'FOUR')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3078) 3078 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,3079)(IANS(I),I=1,IWIDTH) 3079 FORMAT(80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 3090 CONTINUE C C ****************************************************** C ** STEP 4-- ** C ** CHECK THAT VARIABLES 1 AND 2 AND 3 AND 4 HAVE ** C ** THE SAME NUMBER OF ELEMENTS. ** C ****************************************************** C 4000 CONTINUE ISTEPN='4' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VECT') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NIRIG1.EQ.NIRIG2.AND.NIRIG2.EQ.NIRIG3.AND.NIRIG3.EQ.NIRIG4) 1 GOTO4090 C 4010 CONTINUE WRITE(ICOUT,4011) 4011 FORMAT('***** ERROR IN DPVECT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4013) 4013 FORMAT(' THE NUMBER OF OBSERVATIONS IN VARIABLES ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4014) 4014 FORMAT(' 1, 2, 3, AND 4 MUST BE THE SAME;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4015) 4015 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4016)IHRI11,IHRI12,NIRIG1 4016 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4017)IHRI21,IHRI22,NIRIG2 4017 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4018)IHRI31,IHRI32,NIRIG3 4018 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4019)IHRI41,IHRI42,NIRIG4 4019 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4020) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4020) 4020 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,4021)(IANS(I),I=1,IWIDTH) 4021 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 4090 CONTINUE C C ****************************************************** C ** STEP 4.1-- ** C ** CHECK THAT VARIABLES HAVE AT LEAST 1 ELEMENT ** C ****************************************************** C 4100 CONTINUE ISTEPN='4.1' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VECT') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NIRIG1.GE.1)GOTO4190 C 4110 CONTINUE WRITE(ICOUT,4111) 4111 FORMAT('***** ERROR IN DPVECT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4113) 4113 FORMAT(' THE NUMBER OF OBSERVATIONS FOR THE VARIABLES') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4114) 4114 FORMAT(' MUST BE AT LEAST 1;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4115) 4115 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4116)IHRI11,IHRI12,NIRIG1 4116 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4120) 4120 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,4121)(IANS(I),I=1,IWIDTH) 4121 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 4190 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'.OR.ISUBRO.EQ.'VECT') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASEQ='FULL' ILOCQ=NUMARG+1 IF(NUMARG.LT.1)GOTO5090 DO5000J=1,NUMARG J1=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ') GOTO5010 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ') GOTO5010 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ') GOTO5020 5000 CONTINUE GOTO5090 5010 CONTINUE ICASEQ='SUBS' ILOCQ=J1 GOTO5090 5020 CONTINUE ICASEQ='FOR' ILOCQ=J1 GOTO5090 5090 CONTINUE IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'VECT')GOTO5095 WRITE(ICOUT,5091)NUMARG,ILOCQ 5091 FORMAT('NUMARG,ILOCQ = ',2I8) CALL DPWRST('XXX','BUG ') 5095 CONTINUE C ************************************************* C ** STEP 6-- ** C ** FORM THE VECTOR ISUB(.) ** C ** DEPENDING ON THE TYPE OF CASE ** C ** FOR THE QUALIFIER. ** C ** BRANCH TO THE PROPER CASE. ** C ************************************************* C ISTEPN='6' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VECT') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NLOCAL=NIRIG1 C IF(ICASEQ.EQ.'FULL')GOTO6010 IF(ICASEQ.EQ.'SUBS')GOTO6020 IF(ICASEQ.EQ.'FOR')GOTO6030 C 6010 CONTINUE DO6015I=1,NLOCAL ISUB(I)=1 6015 CONTINUE NQ=NLOCAL GOTO6090 C 6020 CONTINUE NIOLD=NLOCAL CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR) NQ=NIOLD GOTO6090 C 6030 CONTINUE CCCCC SEPTEMBER 1993. CCCCC NIOLD=NRIGHT NIOLD=NIRIG1 CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERROR) NQ=NFOR GOTO6090 C 6090 CONTINUE C 6150 CONTINUE IF(NQ.GE.MINN2)GOTO6190 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6151) 6151 FORMAT('***** ERROR IN DPVECT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6152) 6152 FORMAT(' AFTER THE APPROPRIATE SUBSET HAS BEEN ', 1'EXTRACTED,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6153)IHRI11,IHRI12 6153 FORMAT(' THE NUMBER OF OBSERVATIONS REMAINING', 1'FROM VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6154) 6154 FORMAT(' (FOR WHICH A VECTOR PLOT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6155) 6155 FORMAT(' IS TO BE FORMED)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6156)MINN2 6156 FORMAT(' MUST BE ',I8,' OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6157)NQ 6157 FORMAT(' SUCH WAS NOT THE CASE HERE (NQ = ',I8,')') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6158) 6158 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,6159)(IANS(I),I=1,IWIDTH) 6159 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 6190 CONTINUE C C ********************************************** C ** STEP 7-- ** C ** FORM THE SUBSETTED VARIABLES ** C ** Y1(.) ** C ** Y2(.) ** C ** Y3(.) ** C ** Y4(.) ** C ** CONTAINING ** C ** THE STARTING X ** C ** THE ENDING X ** C ** THE ANGLE (OR ENDING X OR DELTA X) ** C ** THE DIRECTION (OR ENDING Y OR DELTA** C ** Y. ** C ** RESPECTIVELY. ** C ********************************************** C ISTEPN='7' IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'VECT')GOTO7099 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) WRITE(ICOUT,7001)ICOLR1,ICOLR2,ICOLR3,ICOLR4 7001 FORMAT('ICOLR1,ICOLR2,ICOLR3,ICOLR4 = ',4(1X,I4)) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7002)MAXN,NQ 7002 FORMAT('MAXN,NQ = ',I8,1X,I4) CALL DPWRST('XXX','BUG ') 7099 CONTINUE C J=0 IMAX=NIRIG1 IF(NQ.LT.NIRIG1)IMAX=NQ DO7000I=1,IMAX IF(ISUB(I).EQ.0)GOTO7000 J=J+1 C IF(J.LE.MAXPOP)GOTO7019 WRITE(ICOUT,7011) 7011 FORMAT('****** PLOT FORMATION ERROR IN DPVECT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7012) 7012 FORMAT(' THE NUMBER OF PLOT POINTS') CALL DPWRST('XXX','BUG ') CCCCC SEPTEMBER 1993. FIX TYPO CCCCC WRITE(ICOUT,7013)MAXNPP WRITE(ICOUT,7013)MAXPOP 7013 FORMAT(' HAS JUST EXCEEDED ',I8,' *****') CALL DPWRST('XXX','BUG ') IERROR='YES' 7019 CONTINUE C IJ=MAXN*(ICOLR1-1)+I IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ) IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I) IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I) IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I) IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I) IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I) IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I) C IJ=MAXN*(ICOLR2-1)+I IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ) IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I) IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I) IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I) IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I) IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I) IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I) C IJ=MAXN*(ICOLR3-1)+I IF(ICOLR3.LE.MAXCOL)Y3(J)=V(IJ) IF(ICOLR3.EQ.MAXCP1)Y3(J)=PRED(I) IF(ICOLR3.EQ.MAXCP2)Y3(J)=RES(I) IF(ICOLR3.EQ.MAXCP3)Y3(J)=YPLOT(I) IF(ICOLR3.EQ.MAXCP4)Y3(J)=XPLOT(I) IF(ICOLR3.EQ.MAXCP5)Y3(J)=X2PLOT(I) IF(ICOLR3.EQ.MAXCP6)Y3(J)=TAGPLO(I) C IJ=MAXN*(ICOLR4-1)+I IF(ICOLR4.LE.MAXCOL)Y4(J)=V(IJ) IF(ICOLR4.EQ.MAXCP1)Y4(J)=PRED(I) IF(ICOLR4.EQ.MAXCP2)Y4(J)=RES(I) IF(ICOLR4.EQ.MAXCP3)Y4(J)=YPLOT(I) IF(ICOLR4.EQ.MAXCP4)Y4(J)=XPLOT(I) IF(ICOLR4.EQ.MAXCP5)Y4(J)=X2PLOT(I) IF(ICOLR4.EQ.MAXCP6)Y4(J)=TAGPLO(I) C C 7000 CONTINUE C 7090 CONTINUE NS=J C C C ************************************************************* C ** STEP 8-- ** C ** FORM THE VERTICAL AND HORIZONTAL AXIS ** C ** VALUES Y(.) AND X(.) FOR THE PLOT. ** C ** DEFINE THE VECTOR D(.) TO CREATE PAIRS OF POINTS ** C ** (EACH ROW WILL DEFINE A SINGLE VECTOR WITH A UNIQUE ** C ** D IDENTIFIER. ** C ** DEFINE THE NUMBER OF PLOT POINTS (NPLOTP). ** C ** DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV). ** C ************************************************************* C ISTEPN='8' IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'VECT')GOTO8999 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) WRITE(ICOUT,8901)NS,ICASPL,IVCFMT,IVCARR,IANGLU 8901 FORMAT('NS,ICASPL,IVCFMT,IVCARR,IANGLU=',I5,4(1X,A4)) CALL DPWRST('XXX','BUG ') 8999 CONTINUE C CALL DPVEC2(Y1,Y2,Y3,Y4,NS,ICASPL, 1IVCFMT,IVCARR,IANGLU, 1Y,X,D,DSIZE,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR) C C ***************** C ** STEP 9-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'VECT')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPVECT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGG2,IBUGG3,IBUGQ,ISUBRO 9012 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IFOUND,IERROR 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 9014 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ', 1I8,I8,I8,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9041)NS 9041 FORMAT('NS = ',I8) CALL DPWRST('XXX','BUG ') IF(NS.LE.0)GOTO9044 DO9042I=1,NS WRITE(ICOUT,9043)I,Y1(I),Y2(I),Y3(I),Y4(I) 9043 FORMAT('I,Y1(I),Y2(I),Y3(I),Y4(I) = ',I8,4E15.7) CALL DPWRST('XXX','BUG ') 9042 CONTINUE 9044 CONTINUE WRITE(ICOUT,9051)NPLOTP 9051 FORMAT('NPLOTP = ',I8) CALL DPWRST('XXX','BUG ') IF(NPLOTP.LE.0)GOTO9054 DO9052I=1,NPLOTP WRITE(ICOUT,9053)I,Y(I),X(I),D(I) 9053 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5) CALL DPWRST('XXX','BUG ') 9052 CONTINUE 9054 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPVEC2(Y1,Y2,Y3,Y4,NZ,ICASPL, 1IVCFMT,IVCARR,IANGLU, 1Y,X,D,DSIZE,N2,NPLOTV,IBUGG3,ISUBRO,IERROR) C C PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS C THAT WILL DEFINE C A VECTOR PLOT 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-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--92/8 C ORIGINAL VERSION--AUGUST 1992. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASPL CHARACTER*4 IBUGG3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 C CHARACTER*4 IVCFMT CHARACTER*4 IVCARR CHARACTER*4 IANGLU C C--------------------------------------------------------------------- C DIMENSION Y1(*) DIMENSION Y2(*) DIMENSION Y3(*) DIMENSION Y4(*) C DIMENSION Y(*) DIMENSION X(*) DIMENSION D(*) DIMENSION DSIZE(*) 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='DPVE' ISUBN2='C2 ' C IERROR='NO' C PI=3.1415926 C C ******************************************** C ** STEP 1-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C IF(NZ.GE.1)GOTO39 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,31) 31 FORMAT('***** ERROR IN DPVEC2--') 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)NZ 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(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'VEC2')GOTO90 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71) 71 FORMAT('***** AT THE BEGINNING OF DPVEC2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,72)ICASPL,NZ,N2,NPLOTV 72 FORMAT('ICASPL,NZ,N2,NPLOTV = ',A4,2X,3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,73)IVCFMT,IVCARR,IANGLU 73 FORMAT('IVCFMT,IVCARR,IANGLU=',A4,1X,A4,1X,A4) CALL DPWRST('XXX','BUG ') IF(NZ.LE.0)GOTO83 DO81I=1,NZ WRITE(ICOUT,82)I,Y1(I),Y2(I),Y3(I),Y4(I) 82 FORMAT('I,Y1(I),Y2(I),Y3(I),Y4(I) = ',I8,4E12.5) CALL DPWRST('XXX','BUG ') 81 CONTINUE 83 CONTINUE 90 CONTINUE C C **************************************** C ** STEP 11-- ** C ** DETERMINE PLOT COORDINATES ** C ** HANDLE 3 CASES OF VECTOR FORMAT ** C ** SEPARATELY. ** C ** IVCFMT = POINT ** C ** Y1, Y2 = (X,Y) START POINT* C ** Y3, Y4 = (X,Y) STOP POINT** C ** = ANGLE ** C ** Y1, Y2 = (X,Y) START POINT* C ** Y3 = ANGLE ** C ** Y4 = LENGTH ** C ** = DELTA ** C ** Y1, Y2 = (X,Y) START POINT* C ** Y3 = X DISTANCE ** C ** Y4 = Y DISTANCE ** C **************************************** C ANZ=NZ C AMXDST=-1.0 IF(IVCFMT.EQ.'POIN')THEN J=0 K=0 DO1100I=1,NZ J=J+1 K=K+1 X(J)=Y2(I) Y(J)=Y1(I) D(J)=REAL(K) J=J+1 X(J)=Y4(I) Y(J)=Y3(I) D(J)=REAL(K) DIST=(Y2(I)-Y4(I))**2 + (Y1(I)-Y3(I))**2 IF(DIST.GT.AMXDST)AMXDST=DIST 1100 CONTINUE ELSEIF(IVCFMT.EQ.'DELT')THEN J=0 K=0 DO1200I=1,NZ J=J+1 K=K+1 X(J)=Y2(I) Y(J)=Y1(I) D(J)=REAL(K) J=J+1 X(J)=Y2(I)+Y4(I) Y(J)=Y1(I)+Y3(I) D(J)=REAL(K) DIST=Y4(I)*Y4(I)+Y3(I)*Y3(I) IF(DIST.GT.AMXDST)AMXDST=DIST 1200 CONTINUE ELSE J=0 K=0 DO1300I=1,NZ J=J+1 K=K+1 X(J)=Y2(I) Y(J)=Y1(I) D(J)=REAL(K) J=J+1 THETA=Y3(I) DIST=Y4(I) IF(DIST.GT.AMXDST)AMXDST=DIST IF(IANGLU.EQ.'DEGR')THETA=THETA*(PI/180.0) X(J)=Y2(I)+DIST*COS(THETA) Y(J)=Y1(I)+DIST*SIN(THETA) D(J)=REAL(K) 1300 CONTINUE ENDIF C N2=J NPLOTV=3 C C *************************************** C ** HANDLE FIXED OR VARIABLE SIZE ** C ** ARROWS. ** C *************************************** C IF(IVCARR.EQ.'FIXE')THEN DO2100I=1,N2 DSIZE(I)=1.0 2100 CONTINUE ELSE ICASPL='VVAR' CCCCC AUGUST, 1994. BASE ON X AND Y ARRAYS, TREATED SAME CCCCC FOR ALL CASES. J1=0 DO2200I=1,N2,2 CCCCC I1=I CCCCC I2=I+1 CCCCC J=MOD(I1,2)+1 CCCCC IF(IVCFMT.EQ.'POIN')THEN CCCCC DIST=(Y2(J)-Y4(J))**2 + (Y1(J)-Y3(J))**2 CCCCC ELSEIF(IVCFMT.EQ.'DELT')THEN CCCCC DIST=Y4(J)*Y4(J)+Y3(J)*Y3(J) CCCCC ELSE CCCCC DIST=Y4(J) CCCCC ENDIF DIST=(X(I)-X(I+1))**2 + (Y(I)-Y(I+1))**2 ASIZE=DIST/AMXDST IF(ASIZE.GT.1.0)ASIZE=1.0 IF(ASIZE.LE.0.05)ASIZE=0.05 CCCCC DSIZE(I1)=ASIZE CCCCC DSIZE(I2)=ASIZE DSIZE(I)=ASIZE DSIZE(I+1)=ASIZE 2200 CONTINUE ENDIF C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'VEC2')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPVEC2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASPL,NZ,N2,IERROR 9012 FORMAT('ICASPL,NZ,N2,IERROR = ',A4,2I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)N2,J,K 9013 FORMAT('N2,J,K = ',3I8) CALL DPWRST('XXX','BUG ') IF(NZ.LE.0)GOTO9023 DO9021I=1,NZ WRITE(ICOUT,9022)I,Y1(I),Y2(I),Y3(I),Y4(I) 9022 FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,4E12.5) CALL DPWRST('XXX','BUG ') 9021 CONTINUE 9023 CONTINUE WRITE(ICOUT,9031)N2,NPLOTV 9031 FORMAT('N2,NPLOTV = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9032)AMXDST 9032 FORMAT('AMXDST = ',E15.7) CALL DPWRST('XXX','BUG ') DO9035I=1,N2 WRITE(ICOUT,9036)I,Y(I),X(I),D(I),DSIZE(I) 9036 FORMAT('I,Y(I),X(I),D(I) = ',I8,2E15.7,F9.2,F5.2) CALL DPWRST('XXX','BUG ') 9035 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPVCFM(IHARG,NUMARG, 1IDEFVF, 1IVCFMT, 1IBUGS2,IFOUND,IERROR) C C PURPOSE--DEFINE THE VECTOR FORMAT C CAN BE (DEFAULT IS ANGLE) C THIS SWITCH CONTROLS HOW THE 4 ARGUMENTS TO THE C VECTOR PLOT COMMAND ARE INTERPERTED (2 POINTS, C 1 POINT WITH ANGLE AND DISTANCE, 1 POINT WITH C X DISTANCE AND Y DISTANCE) C C INPUT ARGUMENTS--IHARG (A CHARACTER VECTOR) C --NUMARG (AN INTEGER VARIABLE) C --IDEFVF (A CHARACTER VARIABLE) C --IBUGS2 (A CHARACTER VARIABLE) C OUTPUT ARGUMENTS--IVCFMT (A CHARACTER VARIABLE) C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) 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-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--82/7 C ORIGINAL VERSION--AUGUST 1992. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IHARG CHARACTER*4 IDEFVF CHARACTER*4 IVCFMT CHARACTER*4 IBUGS2 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 IF(IBUGS2.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPVCFM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IDEFVF 53 FORMAT('IDEFVF = ',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 IFOUND='NO' IERROR='NO' C IF(NUMARG.LE.1)GOTO1150 IF(NUMARG.GT.2)GOTO9000 C 1120 CONTINUE IF(IHARG(2).EQ.'AUTO')GOTO1150 IF(IHARG(2).EQ.'DEFA')GOTO1150 GOTO1160 C 1150 CONTINUE IHOLD=IDEFVF GOTO1180 C 1160 CONTINUE IHOLD=IHARG(2) GOTO1180 C 1180 CONTINUE IFOUND='YES' IVCFMT=IHOLD C IF(IFEEDB.EQ.'OFF')GOTO1189 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1181)IVCFMT 1181 FORMAT('THE VECTOR FORMAT SWITCH HAS JUST BEEN SET TO ', 1A4) CALL DPWRST('XXX','BUG ') 1189 CONTINUE GOTO9000 C 9000 CONTINUE IF(IBUGS2.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPVCFM') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IDEFVF,IVCFMT 9013 FORMAT('IDEFVF,IVCFMT = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPVCAR(IHARG,NUMARG, CCCCC1IDEFAR,IDEFVO, 1IDEFVA,IDEFVO, 1IVCARR,IVCOPN, 1IBUGS2,IFOUND,IERROR) C C PURPOSE--VECTOR ARROW C VECTOR ARROW C CONTROLS WHETHER THE ARROWS ON C THE VECTOR PLOT COMMAND ARE DRAWN AS FIXED LENGTH C OR SIZE SCALED RELATIVE TO THE LENGTH OF THE VECTOR. C CONTROLS WHETHER THE ARROW IS DRAWN C LIKE A TRIANGLE (CLOSED, THE DEFAULT) OR WITH THE C BASE OF THE TRIANGLE LEFT OFF (OPEN). C C INPUT ARGUMENTS--IHARG (A CHARACTER VECTOR) C --NUMARG (AN INTEGER VARIABLE) C --IDEFVA (A CHARACTER VARIABLE) C --IDEFVO (A CHARACTER VARIABLE) C --IBUGS2 (A CHARACTER VARIABLE) C OUTPUT ARGUMENTS--IVCARR (A CHARACTER VARIABLE) C --IVCOPN (A CHARACTER VARIABLE) C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) 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-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--82/7 C ORIGINAL VERSION--AUGUST 1992. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IHARG CHARACTER*4 IDEFVA CHARACTER*4 IVCARR CCCCC OCTOBER 1993. ADD FOLLOWING 2 LINES CHARACTER*4 IVCOPN CHARACTER*4 IDEFVO CHARACTER*4 IBUGS2 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 IF(IBUGS2.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPVCAR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IDEFVA,IDEFVO 53 FORMAT('IDEFVA,IDEFVO = ',A4,1X,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 IFOUND='NO' IERROR='NO' C IF(NUMARG.NE.2)GOTO9000 C 1120 CONTINUE IF(IHARG(2).EQ.'AUTO')GOTO1150 IF(IHARG(2).EQ.'DEFA')GOTO1150 IF(IHARG(2).EQ.'FIXE')GOTO1160 IF(IHARG(2).EQ.'VARI')GOTO1170 IF(IHARG(2).EQ.'OPEN')GOTO1180 IF(IHARG(2).EQ.'CLOS')GOTO1190 GOTO1150 C 1150 CONTINUE IVCARR=IDEFVA IVCOPN=IDEFVO GOTO2000 C 1160 CONTINUE IVCARR='FIXE' GOTO2000 C 1170 CONTINUE IVCARR='VARI' GOTO2000 C 1180 CONTINUE IVCOPN='OPEN' GOTO2000 C 1190 CONTINUE IVCOPN='CLOS' GOTO2000 C 2000 CONTINUE IFOUND='YES' C IF(IFEEDB.EQ.'OFF')GOTO2089 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2051)IVCARR 2051 FORMAT('THE VECTOR ARROW SIZE WILL BE ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2052)IVCOPN 2052 FORMAT('THE VECTOR ARROW HEAD WILL BE ',A4) CALL DPWRST('XXX','BUG ') 2089 CONTINUE GOTO9000 C 9000 CONTINUE IF(IBUGS2.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPVCAR-') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IDEFVA,IVCARR 9013 FORMAT('IDEFVA,IVCARR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IDEFVO,IVCOPN 9014 FORMAT('IDEFVO,IVCOPN = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPVERT(IHARG,IARGT,ARG,NUMARG, 1PDEFVG, 1PTEXVG, 1IBUGD2,ISUBRO,IFOUND,IERROR) C C PURPOSE--DEFINE THE VERTICAL GAP FOR TEXT CHARACTERS. C THE VERTICAL GAP FOR TEXT CHARACTERS WILL BE PLACED C IN THE FLOATING POINT VARIABLE PTEXVG. C NOTE--THE VERTICAL GAP IS IN STANDARDIZED UNITS (0.0 TO 100.0). C NOTE--THE VERTICAL GAP IS THE BETWEEN-LINE SPACING (DISTANCE) C FROM THE BOTTOM OF A CHARACTER ON ONE LINE C TO THE TOP OF A CHARACTER ON THE NEXT LINE. C INPUT ARGUMENTS--IHARG (A CHARACTER VECTOR) C --IARGT C --ARG C --NUMARG C --PDEFVG C --IBUGD2 C OUTPUT ARGUMENTS--PTEXVG C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 IARGT CHARACTER*4 IBUGD2 CHARACTER*4 ISUBRO 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(IBUGD2.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPVERT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)PDEFVG 53 FORMAT('PDEFVG = ',E15.7) 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),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 90 CONTINUE C C *********************************** C ** TREAT THE VERTICAL GAP CASE ** C *********************************** C 1110 CONTINUE IF(NUMARG.LE.0)GOTO1150 IF(NUMARG.EQ.1.AND.IHARG(NUMARG).EQ.'GAP')GOTO1150 IF(NUMARG.EQ.1.AND.IHARG(NUMARG).EQ.'SPAC')GOTO1150 IF(NUMARG.EQ.1.AND.IHARG(NUMARG).EQ.'DIST')GOTO1150 IF(NUMARG.EQ.1.AND.IHARG(NUMARG).EQ.'LENG')GOTO1150 IF(IHARG(NUMARG).EQ.'ON')GOTO1150 IF(IHARG(NUMARG).EQ.'OFF')GOTO1150 IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150 IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150 C IF(NUMARG.GE.1.AND.IARGT(NUMARG).EQ.'NUMB') 1GOTO1160 C 1120 CONTINUE IERROR='YES' WRITE(ICOUT,1121) 1121 FORMAT('***** ERROR IN DPVERT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1122) 1122 FORMAT(' ILLEGAL FORM FOR VERTICAL GAP ', 1'COMMAND.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1124) 1124 FORMAT(' TEST EXAMPLE TO DEMONSTRATE THE ', 1'PROPER FORM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1125) 1125 FORMAT(' SUPPOSE IT IS DESIRED THAT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1126) 1126 FORMAT(' THE TEXT CHARACTERS HAVE A VERTICAL SPACING ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1127) 1127 FORMAT(' OF 2 (WHERE THE VERTICAL SCREEN UNITS RANGE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1128) 1128 FORMAT(' FROM 0 TO 100,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1130) 1130 FORMAT(' THEN THE ALLOWABLE FORM IS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1131) 1131 FORMAT(' VERTICAL SPACING 5 ') CALL DPWRST('XXX','BUG ') GOTO9000 C 1150 CONTINUE PTEXVG=PDEFVG GOTO1180 C 1160 CONTINUE PTEXVG=ARG(NUMARG) GOTO1180 C 1180 CONTINUE IFOUND='YES' C IF(IFEEDB.EQ.'OFF')GOTO1189 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1181) 1181 FORMAT('THE VERTICAL SPACING (FOR TEXT CHARACTERS) ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1182)PTEXVG 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7) 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 DPVERT--') 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)PTEXVG 9013 FORMAT('PTEXVG = ',E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPVIOL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1ICONT,IFENCE,IKDETY,IKDENP,PKDEWI, 1ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR) C C PURPOSE--GENERATE A VIOLIN PLOT C A VIOLIN PLOT GENERATES A BOX PLOT. IT THEN ADDS C A VERTICAL DENSITY PLOT TO EACH SIDE OF THE BOX C PLOT. 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-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/2 C ORIGINAL VERSION--FEBRUARY 2003. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASPL CHARACTER*4 IAND1 CHARACTER*4 IAND2 CHARACTER*4 ICONT CHARACTER*4 IFENCE CHARACTER*4 IKDETY CHARACTER*4 ISUBRO CHARACTER*4 IBUGG2 CHARACTER*4 IBUGG3 CHARACTER*4 IBUGQ CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 IHLEFT CHARACTER*4 IHLEF2 CHARACTER*4 IHHOR CHARACTER*4 IHHOR2 CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CHARACTER*4 ICASEQ C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOZZ.INC' INCLUDE 'DPCOZD.INC' C DIMENSION Y1(MAXOBV) DIMENSION X1(MAXOBV) C DIMENSION XIDTEM(MAXOBV) DIMENSION TEMP(MAXOBV) DIMENSION TEMP2(MAXOBV) DOUBLE PRECISION DTEMP1(MAXOBV) DOUBLE PRECISION DTEMP2(MAXOBV) DOUBLE PRECISION DTEMP3(MAXOBV) EQUIVALENCE (GARBAG(IGARB1),Y1(1)) EQUIVALENCE (GARBAG(IGARB2),X1(1)) EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1)) EQUIVALENCE (GARBAG(IGARB4),TEMP(1)) EQUIVALENCE (GARBAG(IGARB5),TEMP2(1)) EQUIVALENCE (DGARBG(IDGAR1),DTEMP1(1)) EQUIVALENCE (DGARBG(IDGAR2),DTEMP2(1)) EQUIVALENCE (DGARBG(IDGAR3),DTEMP3(1)) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.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 IERROR='NO' C ISUBN1='DPVI' ISUBN2='OL ' 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 ICOLH=0 C C ********************************** C ** TREAT THE VIOLIN PLOT CASE ** C ********************************** C IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'VIOL')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPVIOL--') 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)ICONT,IBUGG2,IBUGG3,IBUGQ 53 FORMAT('ICONT,IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IFENCE,IKDETY,IKDENP,PKDEWI 54 FORMAT('IFENCE,IKDETY,IDENP,PKDEWI = ',A4,A4,I8,G15.7) CALL DPWRST('XXX','BUG ') ENDIF C C *************************** C ** STEP 1-- ** C ** EXTRACT THE COMMAND ** C *************************** C ISTEPN='1' IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C C ********************************** C ** STEP 1.1-- ** C ** SEARCH FOR VIOLIN PLOT ** C ********************************** C ICASPL='VIPL' C IF(NUMARG.GE.1.AND.ICOM.EQ.'VIOL'.AND.IHARG(1).EQ.'PLOT')THEN ILASTC=1 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) IFOUND='YES' ELSE IFOUND='NO' GOTO9000 ENDIF C C C ******************************************************* C ** STEP 1-- ** C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. ** C ******************************************************* C ISTEPN='1' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VIOL') 1CALL 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 ** STEP 2-- ** C ** CHECK THE VALIDITY OF ARGUMENT 1 ** C ** (THIS WILL BE THE RESPONSE VARIABLE) ** C ******************************************** C ISTEPN='2' 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) IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VIOL')THEN WRITE(ICOUT,211)IHLEFT,ICOLL,NLEFT 211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8) CALL DPWRST('XXX','BUG ') ENDIF C C ******************************************************* C ** STEP 3-- ** C ** CHECK THAT THE INPUT NUMBER OF OBSERVATIONS ** C ** (NLEFT) FOR THE RESPONSE VARIABLE IS 2 OR LARGER.** C ******************************************************* C ISTEPN='3' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VIOL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NLEFT.LT.MINN2)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,311) 311 FORMAT('***** ERROR IN DPVIOL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,312) 312 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,314) 314 FORMAT(' VIOLIN PLOT WAS TO HAVE BEEN FORMED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,315)MINN2 315 FORMAT(' MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE ', 1 '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)THEN WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH)) 318 FORMAT(' ',80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C C ***************************************** C ** STEP 4-- ** C ** CHECK TO SEE THE TYPE SUBCASE ** C ** (BASED ON THE QUALIFIER)-- ** C ** 1) UNQUALIFIED (THAT IS, FULL); ** C ** 2) SUBSET/EXCEPT; OR ** C ** 3) FOR. ** C ***************************************** C ISTEPN='4' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VIOL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASEQ='FULL' ILOCQ=NUMARG+1 IF(NUMARG.LT.1)GOTO480 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 C 480 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,481) 481 FORMAT('***** INTERNAL ERROR IN DPVIOL') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,482) 482 FORMAT(' AT BRANCH POINT 481--NUMARG LESS THAN 1 EVEN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,484) 484 FORMAT(' THOUGH NUMARG HAD PREVIOUSLY PASSED THIS TEST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,485)NUMARG 485 FORMAT(' ONCE ALREADY. VALUE OF NUMARG = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,486) 486 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,487)(IANS(I),I=1,MIN(IWIDTH,80)) 487 FORMAT(' ',80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 C 490 CONTINUE IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'VIOL')THEN WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ 491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4) CALL DPWRST('XXX','BUG ') ENDIF C C **************************************************** C ** STEP 5-- ** C ** IF A SECOND ARGUMENT EXISTS, THEN THIS ** C ** INDICATES THAT THE VALUES IN THE ** C ** FIRST VARIABLE ARE TO BE GROUPED ** C ** BASED ON VALUES OF THE SECOND VARIABLE; ** C ** THAT IS, THE SECOND VARAIBLE DEFINES THE ** C ** GROUP NUMBERS WITHIN WHICH THE MEANS, ** C ** STANDARD DEVIATIONS, RANGES, AND ** C ** CUMULATIVE SUMS ARE TO BE COMPUTED. ** C ** THE VALUES IN THE SECOND VARIABLE ** C ** ARE THE X VALUES FOR EACH MEAN, SD, ** C ** ETC. IN THE RESULTING VIOLIN PLOT. ** C ** THE VALUES IN THE SECOND VARIABLE ** C ** NEED NOT HAVE BEEN PREVIOUSLY ** C ** SORTED OR HAVE COMMON VALUES ADJACENT. ** C ** IF WE HAVE THE 2-VARIABLE CASE, ** C ** CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.** C **************************************************** C ISTEPN='5' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VIOL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMV2=ILOCQ-1 IF(NUMV2.EQ.1)GOTO590 IF(NUMV2.EQ.2)GOTO530 GOTO510 C 510 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,511) 511 FORMAT('***** ERROR IN DPVIOL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,512) 512 FORMAT(' FOR A VIOLIN PLOT, THE NUMBER OF VARIABLES MUST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,519) 519 FORMAT(' BE EITHER 1 OR 2; SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,522)NUMV2 522 FORMAT(' THE SPECIFIED NUMBER OF VARIABLES WAS ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,523) 523 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,524)(IANS(I),I=1,MIN(IWIDTH,80)) 524 FORMAT(' ',80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 C 530 CONTINUE IHHOR=IHARG(2) IHHOR2=IHARG2(2) IHWUSE='V' MESSAG='YES' CALL CHECKN(IHHOR,IHHOR2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ICOLH=IVALUE(ILOCV) NHOR=IN(ILOCV) IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VIOL')THEN WRITE(ICOUT,531)IHHOR,ICOLH,NHOR 531 FORMAT('IHHOR,ICOLH,NHOR = ',A4,I8,I8) CALL DPWRST('XXX','BUG ') ENDIF C IF(NHOR.NE.NLEFT)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,571) 571 FORMAT('***** ERROR IN DPVIOL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,572) 572 FORMAT(' FOR A VIOLIN PLOT, WHEN TWO VARIABLES ARE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,579) 579 FORMAT(' SPECIFIED, THE NUMBER OF ELEMENTS FOR THE TWO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,581) 581 FORMAT(' VARIABLES MUST BE THE SAME; ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,582) 582 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,583) 583 FORMAT(' THE FIRST VARIABLE (RESPONSE VALUES)--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,584)IHLEFT,IHLEF2,NLEFT 584 FORMAT(' ',A4,A4,' HAS ',I8,' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,585) 585 FORMAT(' THE SECOND VARIABLE (HORIZONTAL AXIS VALUES)--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,586)IHHOR,IHHOR2,NHOR 586 FORMAT(' ',A4,A4,' HAS ',I8,' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,587) 587 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,588)(IANS(I),I=1,MIN(IWIDTH,80)) 588 FORMAT(' ',80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C 590 CONTINUE C C ************************************************* C ** STEP 6-- ** C ** BRANCH TO THE APPROPRIATE SUBCASE; ** C ** (BASED ON THE QUALIFIER) ** C ** THEN FORM THE RESPONSE VARIABLE ** C ** AND THE SECOND VARIABLE (IF EXISTENT) ** C ************************************************* C ISTEPN='6' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VIOL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASEQ.EQ.'FULL')GOTO610 IF(ICASEQ.EQ.'SUBS')GOTO620 IF(ICASEQ.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 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) IF(NUMV2.LE.1)GOTO660 C IJ=MAXN*(ICOLH-1)+I IF(ICOLH.LE.MAXCOL)X1(J)=V(IJ) IF(ICOLH.EQ.MAXCP1)X1(J)=PRED(I) IF(ICOLH.EQ.MAXCP2)X1(J)=RES(I) IF(ICOLH.EQ.MAXCP3)X1(J)=YPLOT(I) IF(ICOLH.EQ.MAXCP4)X1(J)=XPLOT(I) IF(ICOLH.EQ.MAXCP5)X1(J)=X2PLOT(I) IF(ICOLH.EQ.MAXCP6)X1(J)=TAGPLO(I) C 660 CONTINUE NLOCAL=J C C ***************************************************** C ** STEP 8-- ** C ** GENERATE THE VIOLIN PLOT-- ** C ** FORM THE VERTICAL AND HORIZONTAL AXIS ** C ** VALUES Y(.) AND X(.) FOR THE PLOT. ** C ** DEFINE THE NUMBER OF PLOT POINTS (NPLOTP). ** C ** DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV). ** C ***************************************************** C ISTEPN='8' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'VIOL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL DPVIO2(Y1,X1,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,MAXOBV, 1IFENCE,IBXPWI,IKDETY,IKDENP,PKDEWI, 1XIDTEM,TEMP,TEMP2,DTEMP1,DTEMP2,DTEMP3, 1Y,X,D,NPLOTP,NPLOTV,ISUBRO,IBUGG3,IERROR) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'VIOL')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPVIOL--') 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 = ', 1 I8,I8,I8,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IFENCE,ISIZE 9014 FORMAT('IFENCE,ISIZE = ',A4,I8) CALL DPWRST('XXX','BUG ') IF(NPLOTP.GT.0)THEN 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 ENDIF ENDIF C RETURN END SUBROUTINE DPVIO2(Y,X,N,NUMV2,ICASPL,ISIZE,ICONT,MAXOBV, 1IFENCE,IBXPWI,IKDETY,IKDENP,PKDEWI, 1XIDTEM,TEMP,TEMP2,DY,FT,SMOOTH, 1Y2,X2,D2,N2,NPLOTV,ISUBRO,IBUGG3,IERROR) C C PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS C THAT WILL DEFINE A VIOLIN PLOT. 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-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/2 C ORIGINAL VERSION--FEBRUARY 2003. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASPL CHARACTER*4 ICONT CHARACTER*4 IFENCE CHARACTER*4 IBXPWI CHARACTER*4 IKDETY CHARACTER*4 ISUBRO CHARACTER*4 IBUGG3 CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C DIMENSION Y(*) DIMENSION X(*) DIMENSION Y2(*) DIMENSION X2(*) DIMENSION D2(*) C DIMENSION XIDTEM(*) DIMENSION TEMP(*) DIMENSION TEMP2(*) DOUBLE PRECISION DY(*) DOUBLE PRECISION FT(*) DOUBLE PRECISION SMOOTH(*) C DOUBLE PRECISION DH DOUBLE PRECISION DHI DOUBLE PRECISION DLO DOUBLE PRECISION DN DOUBLE PRECISION DSUM DOUBLE PRECISION DX DOUBLE PRECISION DMEAN DOUBLE PRECISION DVAR DOUBLE PRECISION DSD DOUBLE PRECISION DYMX 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='DPVI' ISUBN2='O2 ' C I2=0 ISIZE2=0 C AN=0.0 SIZE=0.0 SIZE2=0.0 XWIDTH=0.0 XWIDT2=0.0 YBARI=0.0 SDI=0.0 YMED=0.0 C H=0.0 STEP=0.0 AINNFU=0.0 AOUTFU=0.0 IREV=0 AINNFL=0.0 AOUTFL=0.0 C DO 10 I=1,MAXOBV X2(I)=0.0 Y2(I)=0.0 D2(I)=0.0 10 CONTINUE C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LE.1)THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,31) 31 FORMAT('***** ERROR IN DPVIO2--') 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 ENDIF C HOLD=Y(1) DO60I=1,N IF(Y(I).NE.HOLD)GOTO69 60 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61) 61 FORMAT('***** ERROR IN DPVIO2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62) 62 FORMAT(' ALL RESPONSE VARIABLE ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)HOLD 63 FORMAT(' ARE IDENTICALLY EQUAL TO ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 69 CONTINUE C IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'VIO2')THEN WRITE(ICOUT,70) 70 FORMAT('AT THE BEGINNING OF DPVIO2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71)N,ICASPL,NUMV2,ISIZE,ICONT 71 FORMAT('N,ICASPL,NUMV2,ISIZE,ICONT = ',I8,2X,A4,I8,I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,72)IFENCE 72 FORMAT('IFENCE = ',A4) CALL DPWRST('XXX','BUG ') DO75I=1,N WRITE(ICOUT,76)I,Y(I),X(I) 76 FORMAT('I, Y(I), X(I) = ',I8,2F15.7) CALL DPWRST('XXX','BUG ') 75 CONTINUE ENDIF C C ****************************************************** C ** STEP 1-- ** C ** DETERMINE THE NUMBER OF DISTINCT VALUES ** C ** FOR VARIABLE 2 (THE GROUP VARIABLE). ** C ** IF ALL VALUES ARE DISTINCT, THEN THIS ** C ** IMPLIES WE HAVE THE NO REPLICATION CASE ** C ** WHICH IS AN ERROR CONDITION FOR A VIOLIN PLOT. ** C ****************************************************** C ISTEPN='1' IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMV2.EQ.1)THEN DO120I=1,N X(I)=1.0 120 CONTINUE NUMSET=1 XIDTEM(1)=X(1) ELSEIF(NUMV2.EQ.2)THEN NUMSET=0 DO160I=1,N IF(NUMSET.EQ.0)GOTO165 DO170J=1,NUMSET IF(X(I).EQ.XIDTEM(J))GOTO160 170 CONTINUE 165 CONTINUE NUMSET=NUMSET+1 XIDTEM(NUMSET)=X(I) 160 CONTINUE CALL SORT(XIDTEM,NUMSET,XIDTEM) XID1=XIDTEM(1) XID2=XIDTEM(NUMSET) ENDIF C IF(NUMSET.EQ.0)THEN WRITE(ICOUT,191) 191 FORMAT('ERROR IN DPVIO2 SUBROUTINE--NUMSET = 0') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF C IF(NUMSET.EQ.N)THEN WRITE(ICOUT,192) 192 FORMAT('ERROR IN DPVIO2 SUBROUTINE--NUMSET = N') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF C C ********************************** C ** STEP 2-- ** C ** IF NECESSARY, ** C ** COMPUTE AVERAGE CLASS SIZE ** C ********************************** C ISTEPN='2' IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C AN=N ANUMSE=NUMSET C SIZE=ISIZE SIZE2=SIZE SIZE2=AN/ANUMSE ISIZE2=SIZE2+0.5 C C *********************************** C ** STEP 3-- ** C ** COMPUTE MINIMUM CLASS WIDTH ** C *********************************** C ISTEPN='3' IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'VIO2') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMSET.EQ.1)THEN XWIDTH=0.10*XIDTEM(1) ELSE XWIDTH=CPUMAX IMAX=NUMSET-1 DO300I=1,IMAX IP1=I+1 XWIDT2=XIDTEM(IP1)-XIDTEM(I) IF(XWIDT2.LT.XWIDTH)XWIDTH=XWIDT2 300 CONTINUE ENDIF C C ************************************** C ** STEP 4-- ** C ** COMPUTE MAXIMUM SUBSAMPLE SIZE ** C ************************************** C ISTEPN='4' IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'VIO2') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NIMAX=0 DO400ISET=1,NUMSET C K=0 DO420I=1,N IF(X(I).EQ.XIDTEM(ISET))THEN K=K+1 TEMP(K)=Y(I) ENDIF 420 CONTINUE NI=K IF(NI.GT.NIMAX)NIMAX=NI C 400 CONTINUE ANIMAX=NIMAX C C *************************************************** C ** STEP 5-- ** C ** DETERMINE PLOT COORDINATES ** C *************************************************** C 1100 CONTINUE C ISTEPN='5' IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'VIO2') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMCPL=11 J=0 JD=0 DO1110ISET=1,NUMSET C K=0 DO1120I=1,N IF(X(I).EQ.XIDTEM(ISET))THEN K=K+1 TEMP(K)=Y(I) ENDIF 1120 CONTINUE NI=K ANI=NI C IF(NI.LE.0)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1121) 1121 FORMAT('***** INTERNAL ERROR IN DPVIO2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1122) 1122 FORMAT('NI FOR SOME CLASS = 0') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1123)ISET,XIDTEM(ISET),NI 1123 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF CALL SORT(TEMP,NI,TEMP) C XMID=XIDTEM(ISET) C IF(IBXPWI.EQ.'FIXE')THEN FACTOR=1.0 ELSE FACTOR=SQRT(ANI/ANIMAX) ENDIF XLEFT=XMID-(XWIDTH/4.0)*FACTOR XRIGHT=XMID+(XWIDTH/4.0)*FACTOR XLEF2=XMID-(XWIDTH/2.5) XRIGH2=XMID+(XWIDTH/2.5) C C ********************************************** C ** STEP 5.05-- ** C ** CALL DENEST ROUTINE TO COMPUTE THE ** C ** KERNEL DENSITY ESTIMATE. ** C ********************************************** C DO1010I=1,NI DY(I)=DBLE(TEMP(I)) 1010 CONTINUE C IERROR='NO' ICAL=0 KFLAG=1 CALL DSORT(DY,DY,NI,KFLAG,IERROR) DH=DBLE(PKDEWI) IF(PKDEWI.LE.0)THEN DN=DBLE(NI) DSUM=0.0D0 DO1020I=1,NI DX=DY(I) DSUM=DSUM+DX 1020 CONTINUE DMEAN=DSUM/DN DSUM=0.0D0 DO1030I=1,NI DX=DY(I) DSUM=DSUM+(DX-DMEAN)**2 1030 CONTINUE DVAR=DSUM/(DN-1.0D0) DSD=0.0D0 IF(DVAR.GT.0.0D0)DSD=DSQRT(DVAR) C P=0.25 AN=REAL(NI) ANI=P*(AN+1.0) NI2=ANI A2NI=NI REM=ANI-A2NI NIP1=NI2+1 IF(NI2.LE.1)NI2=1 IF(NI2.GE.NI)NI2=NI IF(NIP1.LE.1)NIP1=1 IF(NIP1.GE.NI)NIP1=NI XPERC1=(1.0-REM)*TEMP(NI2)+REM*TEMP(NIP1) C P=0.75 ANI=P*(AN+1.0) NI2=ANI A2NI=NI2 REM=ANI-A2NI NIP1=NI2+1 IF(NI2.LE.1)NI2=1 IF(NI2.GE.NI)NI2=NI IF(NIP1.LE.1)NIP1=1 IF(NIP1.GE.NI)NIP1=NI XPERC2=(1.0-REM)*TEMP(NI2)+REM*Y(NIP1) AIQ=(XPERC2-XPERC1)/1.34 C DH=0.9D0*MIN(DSD,DBLE(AIQ))*DN**(-1.0D0/5.0D0) ENDIF DLO=DY(1) - 3.0D0*DH DHI=DY(NI) + 3.0D0*DH C CALL DENEST(DY,NI,DLO,DHI,DH,FT,SMOOTH,IKDENP,ICAL,IERROR) C IF(IERROR.EQ.'YES')THEN WRITE(ICOUT,1041) 1041 FORMAT('**** ERROR IN VIOLIN PLOT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1043)ISET 1043 FORMAT(' UNABLE TO COMPUTE DENSITY FUNCTION FOR ', 1 'SET ',I8) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C DYMX=0.0D0 DO1050I=1,IKDENP IF(SMOOTH(I).GT.DYMX)DYMX=SMOOTH(I) 1050 CONTINUE C JD=JD+1 XINC=XRIGH2-XMID DO1060I=1,IKDENP J=J+1 X2(J)=XMID + (XINC*REAL(SMOOTH(I))/REAL(DYMX)) Y2(J)=REAL(DLO + (DBLE(I) - 0.5D0)*(DHI-DLO)/DBLE(IKDENP)) D2(J)=REAL(JD) 1060 CONTINUE DO1065I=IKDENP-1,1,-1 J=J+1 X2(J)=XMID - (XINC*REAL(SMOOTH(I))/REAL(DYMX)) Y2(J)=REAL(DLO + (DBLE(I) - 0.5D0)*(DHI-DLO)/DBLE(IKDENP)) D2(J)=REAL(JD) 1065 CONTINUE J=J+1 X2(J)=XMID + (XINC*REAL(SMOOTH(1))/REAL(DYMX)) Y2(J)=REAL(DLO + (DBLE(1) - 0.5D0)*(DHI-DLO)/DBLE(IKDENP)) D2(J)=REAL(JD) C C C *************************** C ** STEP 5.1-- ** C ** COMPUTE THE MAXIMUM ** C *************************** C YMAX=TEMP(NI) C C *********************************************** C ** STEP 5.2-- ** C ** COMPUTE THE POINT AT THE TOP OF THE BOX ** C ** (THE UPPER HINGE FOR A MEDIAN BOX PLOT) ** C *********************************************** C NI2=(NI+1)/2 IARG1=(NI2+1)/2 IARG2=(NI2+1)-IARG1 IARG1R=NI-IARG1+1 IARG2R=NI-IARG2+1 Y75=(TEMP(IARG1R)+TEMP(IARG2R))/2.0 C C *************************************** C ** STEP 5.3-- ** C ** COMPUTE UPPER CONFIDENCE LIMITS ** C ** FOR THE MEAN ** C *************************************** C YUCL=Y75 C C ********************************* C ** STEP 5.4-- ** C ** COMPUTE THE TYPICAL VALUE ** C ** (MEDIAN) ** C ********************************* C N50=NI/2 N50P1=N50+1 IEVODD=NI-2*(NI/2) IF(IEVODD.EQ.0)YMED=(TEMP(N50)+TEMP(N50P1))/2.0 IF(IEVODD.EQ.1)YMED=TEMP(N50P1) Y50=YMED C C **************************************************** C ** STEP 5.5-- ** C ** COMPUTE LOWER CONFIDENCE LIMITS FOR THE MEAN ** C **************************************************** C YLCL=Y50 C C **************************************************** C ** STEP 5.6-- ** C ** COMPUTE THE POINT AT THE BOTTOM OF THE BOX ** C ** (THE LOWER HINGE FOR A BOX VIOLIN PLOT) ** C **************************************************** C NI2=(NI+1)/2 IARG1=(NI2+1)/2 IARG2=(NI2+1)-IARG1 Y25=(TEMP(IARG1)+TEMP(IARG2))/2.0 C C *************************** C ** STEP 5.7-- ** C ** COMPUTE THE MINIMUM ** C *************************** C YMIN=TEMP(1) C C ************************************************** C ** STEP 5.7A-- ** C ** FOR THE UPPER HALF OF THE DATA-- ** C ** COMPUTE THE OUTER FENCE, THE INNER FENCE, ** C ** AND THE ADJACENT VALUE ** C ************************************************** C H=Y75-Y25 STEP=1.5*H C AINNFU=Y75+STEP AOUTFU=Y75+2.0*STEP YADJU=Y75 DO1155I=1,NI IREV=NI-I+1 IF(TEMP(IREV).LE.AINNFU)GOTO1156 1155 CONTINUE GOTO1159 1156 CONTINUE YADJU=TEMP(IREV) 1159 CONTINUE IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'VIO2')THEN WRITE(ICOUT,1157)Y75,YADJU,TEMP(IREV),IREV 1157 FORMAT('Y75,YADJU,TEMP(IREV),IREV = ',3E15.7,I8) CALL DPWRST('XXX','BUG ') ENDIF C C *************************************************** C ** STEP 5.7B-- ** C ** FOR THE LOWER HALF OF THE DATA-- ** C ** COMPUTE THE OUTER FENCE, THE INNER FENCE, ** C ** AND THE ADJACENT VALUE ** C *************************************************** C AINNFL=Y25-STEP AOUTFL=Y25-2.0*STEP YADJL=Y25 DO1165I=1,NI I2=I IF(TEMP(I2).GE.AINNFL)GOTO1166 1165 CONTINUE GOTO1169 1166 CONTINUE YADJL=TEMP(I2) 1169 CONTINUE C 1170 CONTINUE C C ******************************************* C ** STEP 6.1-- ** C ** IF IFENCE IS OFF, THEN ** C ** DEFINE THE CHARACTER AT THE MAXIMUM. ** C ** IF IFENCE IS ON, THEN ** C ** DEFINE THE CHARACTER AT THE UPPER ** C ** ADJACENT VALUE; ** C ******************************************* C IF(IFENCE.EQ.'OFF') 1 CALL DPCHLI(ICONT,NUMCPL,YMAX,YMAX,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) IF(IFENCE.EQ.'ON') 1 CALL DPCHLI(ICONT,NUMCPL,YADJU,YADJU,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C **************************************** C ** STEP 6.2-- ** C ** DEFINE THE CHARACTER AT THE TOP ** C ** OF THE BOX ** C ** (UPPER HINGE CHARACTER, IF ANY). ** C **************************************** C CALL DPCHLI(ICONT,NUMCPL,Y75,Y75,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C *************************************************** C ** STEP 6.3-- ** C ** DEFINE THE CHARACTER IN THE BOX ** C ** BUT TOWARDS THE TOP OF THE BOX ** C *************************************************** C CALL DPCHLI(ICONT,NUMCPL,YUCL,YUCL,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C *************************************** C ** STEP 6.4-- ** C ** DEFINE THE CHARACTER IN THE BOX ** C ** NEAR THE MIDDLE ** C ** (SUCH AS THE MEDIAN OR MEAN) ** C *************************************** C CALL DPCHLI(ICONT,NUMCPL,Y50,Y50,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C ***************************************************** C ** STEP 6.5-- ** C ** DEFINE THE CHARACTER IN THE BOX ** C ** BUT TOWARDS THE BOX OF THE BOX ** C ** (SUCH AS A LOWER CONFIDENCE LIMIT FOR THE MEAN,** C ** IF ANY) ** C ***************************************************** C CALL DPCHLI(ICONT,NUMCPL,YLCL,YLCL,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C ****************************************** C ** STEP 6.6-- ** C ** DEFINE THE CHARACTER AT THE BOTTOM ** C ** OF THE BOX ** C ** (LOWER HINGE CHARACTER, IF ANY). ** C ****************************************** C CALL DPCHLI(ICONT,NUMCPL,Y25,Y25,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C ******************************************* C ** STEP 6.7-- ** C ** IF IFENCE IS OFF, THEN ** C ** DEFINE THE CHARACTER AT THE MINIMUM. ** C ** IF IFENCE IS ON, THEN ** C ** DEFINE THE CHARACTER AT THE LOWER ** C ** ADJACENT VALUE; ** C ******************************************* C IF(IFENCE.EQ.'OFF') 1 CALL DPCHLI(ICONT,NUMCPL,YMIN,YMIN,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) IF(IFENCE.EQ.'ON') 1 CALL DPCHLI(ICONT,NUMCPL,YADJL,YADJL,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C *********************************************** C ** STEP 6.8-- ** C ** IF IFENCE IS OFF, THEN ** C ** DEFINE THE VERTICAL LINE FROM ** C ** THE MAXIMUM VALUE TO THE TOP OF THE BOX ** C ** IF IFENCE IS ON, THEN ** C ** DEFINE THE VERTICAL LINE FROM ** C ** THE UPPER ADJACENT VALUE TO THE TOP OF ** C ** THE BOX ** C *********************************************** C IF(IFENCE.EQ.'OFF') 1 CALL DPCHLI(ICONT,NUMCPL,YMAX,Y75,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) IF(IFENCE.EQ.'ON') 1 CALL DPCHLI(ICONT,NUMCPL,YADJU,Y75,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C ******************************************************* C ** STEP 6.9-- ** C ** DEFINE THE VERTICAL LINE ** C ** FROM THE TOP OF THE BOX (THE UPPER HINGE POINT) ** C ** TO THE POINT IN THE BOX TOWARD THE TOP ** C ** (SUCH AS THE UPPER CONFIDENCE LIMIT POINT) ** C ******************************************************* C CALL DPCHLI(ICONT,NUMCPL,Y75,YUCL,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C ************************************************** C ** STEP 6.10-- ** C ** DEFINE THE VERTICAL LINE ** C ** FROM THE POINT IN THE BOX TOWARD THE TOP ** C ** (SUCH AS THE UPPER CONFIDENCE LIMIT POINT) ** C ** TO THE POINT IN THE BOX ** C ** IN THE MIDDLE ** C ** (SUCH AS THE MEDIAN OR MEAN) ** C ************************************************** C CALL DPCHLI(ICONT,NUMCPL,YUCL,Y50,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C ************************************************** C ** STEP 6.11-- ** C ** DEFINE THE VERTICAL LINE ** C ** FROM THE POINT IN THE BOX ** C ** IN THE MIDDLE ** C ** (SUCH AS THE MEDIAN OR MEAN) ** C ** TO THE POINT IN THE BOX TOWARD THE BOTTOM ** C ** (SUCH AS THE LOWER CONFIDENCE LIMIT POINT) ** C ************************************************** C CALL DPCHLI(ICONT,NUMCPL,Y50,YLCL,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C ******************************************************* C ** STEP 6.12-- ** C ** DEFINE THE VERTICAL LINE ** C ** FROM THE POINT IN THE BOX TOWARD THE BOTTOM ** C ** (SUCH AS THE LOWER CONFIDENCE LIMIT POINT) ** C ** TO THE BOTTOM OF THE BOX (THE LOWER HINGE POINT) ** C ******************************************************* C CALL DPCHLI(ICONT,NUMCPL,YLCL,Y25,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C ********************************** C ** STEP 6.13-- ** C ** IF IFENCE IS OFF, THEN ** C ** DEFINE THE VERTICAL LINE ** C ** FROM THE BOTTOM OF THE BOX ** C ** TO THE MINIMUM VALUE ** C ** IF IFENCE IS ON, THEN ** C ** DEFINE THE VERTICAL LINE ** C ** FROM THE BOTTOM OF THE BOX ** C ** TO THE LOWER ADJACENT VALUE ** C ********************************** C IF(IFENCE.EQ.'OFF') 1 CALL DPCHLI(ICONT,NUMCPL,Y25,YMIN,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) IF(IFENCE.EQ.'ON') 1 CALL DPCHLI(ICONT,NUMCPL,Y25,YADJL,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) C C ********************************************* C ** STEP 6.14-- ** C ** DEFINE THE VERTICAL LINE ** C ** CONSTITUTING THE LEFT SIDE OF THE BOX ** C ** WHICH GOES FROM THE TOP OF THE BOX ** C ** TO THE BOTTOM OF THE BOX ** C ********************************************* C CALL DPCHLI(ICONT,NUMCPL,Y75,Y25,XLEFT,XLEFT,J,JD,Y2,X2,D2, 1 IERROR) C C ********************************************** C ** STEP 6.15-- ** C ** DEFINE THE VERTICAL LINE ** C ** CONSTITUTING THE RIGHT SIDE OF THE BOX ** C ** WHICH GOES FROM THE TOP OF THE BOX ** C ** TO THE BOTTOM OF THE BOX ** C ********************************************** C CALL DPCHLI(ICONT,NUMCPL,Y75,Y25,XRIGHT,XRIGHT,J,JD,Y2,X2,D2, 1 IERROR) C C *********************************************** C ** STEP 6.16-- ** C ** DEFINE THE HORIZONTAL LINE ** C ** AT THE TOP OF THE BOX ** C ** (RUNNING THROUGH THE UPPER HINGE POINT) ** C *********************************************** C CALL DPCHLI(ICONT,NUMCPL,Y75,Y75,XLEFT,XRIGHT,J,JD,Y2,X2,D2, 1 IERROR) C C **************************************************** C ** STEP 6.17-- ** C ** DEFINE THE HORIZONTAL LINE ** C ** IN THE BOX ** C ** (RUNNING THROUGH THE UPPER CONFIDENCE LIMIT) ** C **************************************************** C CALL DPCHLI(ICONT,NUMCPL,YUCL,YUCL,XLEFT,XRIGHT,J,JD,Y2,X2,D2, 1 IERROR) C C ********************************************* C ** STEP 6.18-- ** C ** DEFINE THE HORIZONTAL LINE ** C ** IN THE BOX ** C ** (RUNNING THROUGHT THE MEDIAN OR MEAN) ** C ********************************************* C CALL DPCHLI(ICONT,NUMCPL,Y50,Y50,XLEFT,XRIGHT,J,JD,Y2,X2,D2, 1 IERROR) C C **************************************************** C ** STEP 6.19-- ** C ** DEFINE THE HORIZONTAL LINE ** C ** IN THE BOX ** C ** (RUNNING THROUGH THE LOWER CONFIDENCE LIMIT) ** C **************************************************** C CALL DPCHLI(ICONT,NUMCPL,YLCL,YLCL,XLEFT,XRIGHT,J,JD,Y2,X2,D2, 1 IERROR) C C *********************************************** C ** STEP 6.20-- ** C ** DEFINE THE HORIZONTAL LINE ** C ** AT THE BOTTOM OF THE BOX ** C ** (RUNNING THROUGH THE LOWER HINGE POINT) ** C *********************************************** C CALL DPCHLI(ICONT,NUMCPL,Y25,Y25,XLEFT,XRIGHT,J,JD,Y2,X2,D2, 1 IERROR) C C ******************************************************* C ** STEP 6.20B-- ** C ** IF A VIOLIN PLOT WITH NO FENCES HAS BEEN CALLED ** C ** FOR THEN SKIP PAST THE FINAL 4 SPECIFICATIONS. ** C ******************************************************* C IF(IFENCE.EQ.'OFF')GOTO1110 C C ************************************************* C ** STEP 6.21-- ** C ** DEFINE THE CHARACTER FOR THE UPPER FAR OUT ** C ** VALUES (BEYOND THE UPPER OUTER FENCE) ** C ************************************************* C YTEMP=Y25 CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) JD=JD-1 C IPASS=0 DO1215I=1,NI IREV=NI-I+1 YTEMP=TEMP(IREV) IF(YTEMP.LE.AOUTFU)GOTO1219 IPASS=IPASS+1 IF(IPASS.EQ.1)J=J-1 CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) JD=JD-1 1215 CONTINUE 1219 CONTINUE JD=JD+1 C C ******************************************************* C ** STEP 6.22-- ** C ** DEFINE THE CHARACTER FOR THE UPPER NEAR OUT ** C ** VALUES (BETWEEN THE UPPER INNER AND OUTER FENCES)** C ******************************************************* C YTEMP=Y25 CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) JD=JD-1 C IPASS=0 DO1225I=1,NI IREV=NI-I+1 YTEMP=TEMP(IREV) IF(YTEMP.GE.AOUTFU)GOTO1225 IF(YTEMP.LE.AINNFU)GOTO1229 IPASS=IPASS+1 IF(IPASS.EQ.1)J=J-1 CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) JD=JD-1 1225 CONTINUE 1229 CONTINUE JD=JD+1 C C ******************************************************* C ** STEP 6.23-- ** C ** DEFINE THE CHARACTER FOR THE LOWER NEAR OUT ** C ** VALUES (BETWEEN THE LOWER INNER AND OUTER FENCES)** C ******************************************************* C YTEMP=Y25 CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) JD=JD-1 C IPASS=0 DO1235I=1,NI I2=I YTEMP=TEMP(I2) IF(YTEMP.LE.AOUTFL)GOTO1235 IF(YTEMP.GE.AINNFL)GOTO1239 IPASS=IPASS+1 IF(IPASS.EQ.1)J=J-1 CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) JD=JD-1 1235 CONTINUE 1239 CONTINUE JD=JD+1 C C ************************************************* C ** STEP 6.24-- ** C ** DEFINE THE CHARACTER FOR THE LOWER FAR OUT ** C ** VALUES (BEYOND THE LOWER OUTER FENCE) ** C ************************************************* C YTEMP=Y25 CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) JD=JD-1 C IPASS=0 DO1245I=1,NI I2=I YTEMP=TEMP(I2) IF(YTEMP.GE.AOUTFL)GOTO1249 IPASS=IPASS+1 IF(IPASS.EQ.1)J=J-1 CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2, 1 IERROR) JD=JD-1 1245 CONTINUE 1249 CONTINUE JD=JD+1 C IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'VIO2')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1251) 1251 FORMAT('***** FROM THE MIDDLE OF DPVIO2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1252)ANI,J,JD,XMID 1252 FORMAT('ANI,J,JD,XMID = ',E15.7,I8,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1253)YMAX,Y75,Y50,Y25,YMIN 1253 FORMAT('YMAX,Y75,Y50,Y25,YMIN = ',5E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1254)H,STEP,Y75,YADJU,AINNFU,AOUTFU 1254 FORMAT('H,STEP,Y75,YADJU,AINNFU,AOUTFU = ',6E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1255)H,STEP,Y25,YADJL,AINNFL,AOUTFL 1255 FORMAT('H,STEP,Y25,YADJL,AINNFL,AOUTFL = ',6E15.7) CALL DPWRST('XXX','BUG ') ENDIF C 1110 CONTINUE C N2=J NPLOTV=3 GOTO9000 C C ****************** C ** STEP 90-- ** C ** EXIT ** C ****************** C 9000 CONTINUE IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'VIO2')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPVIO2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASPL,N,NUMSET,N2,IERROR 9012 FORMAT('ICASPL,N,NUMSET,N2,IERROR = ',A4,3I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IFENCE 9013 FORMAT('IFENCE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NUMV2,ISIZE,SIZE,SIZE2,ISIZE2 9014 FORMAT('NUMV2,ISIZE,SIZE,SIZE2,ISIZE2 = ',2I8,2E15.7,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)AN,XWIDT2,XWIDTH 9015 FORMAT('AN,XWIDT2,XWIDTH = ',3E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)YMAX,Y75,Y50,Y25,YMIN 9021 FORMAT('YMAX,Y75,Y50,Y25,YMIN = ',5E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)H,STEP,Y75,YADJU,AINNFU,AOUTFU 9022 FORMAT('H,STEP,Y75,YADJU,AINNFU,AOUTFU = ',6E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)H,STEP,Y25,YADJL,AINNFL,AOUTFL 9023 FORMAT('H,STEP,Y25,YADJL,AINNFL,AOUTFL = ',6E15.7) CALL DPWRST('XXX','BUG ') DO9035I=1,N2 WRITE(ICOUT,9036)I,Y2(I),X2(I),D2(I) 9036 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2) CALL DPWRST('XXX','BUG ') 9035 CONTINUE ENDIF C RETURN END SUBROUTINE DPVIS(IHARG,NUMARG,IVISSW,IFOUND,IERROR) C C PURPOSE--DEFINE THE VISIBLE SWITCH IVISSW. C INPUT ARGUMENTS--IHARG (A HOLLERITH VECTOR) C --NUMARG C OUTPUT ARGUMENTS--IVISSW ('ON' OR 'OFF') C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISSWION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--NOVEMBER 1978. C UPDATED --SEPTEMBER 1980. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IHARG CHARACTER*4 IVISSW 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(NUMARG.EQ.0)GOTO1150 IF(NUMARG.GE.1)GOTO1110 GOTO1199 C 1110 CONTINUE IF(IHARG(NUMARG).EQ.'ON')GOTO1150 IF(IHARG(NUMARG).EQ.'OFF')GOTO1160 IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150 IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160 GOTO1199 C 1150 CONTINUE IVISSW='ON' GOTO1180 C 1160 CONTINUE IVISSW='OFF' GOTO1180 C 1180 CONTINUE IFOUND='YES' C IF(IFEEDB.EQ.'OFF')GOTO1189 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1181) 1181 FORMAT('THE VISIBLE SWITCH (AFFECTING BACKGROUND LINES ', 1'IN 3-D PLOTS)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1182)IVISSW 1182 FORMAT(' HAS JUST BEEN TURNED ',A4) CALL DPWRST('XXX','BUG ') 1189 CONTINUE GOTO1199 C 1199 CONTINUE RETURN END SUBROUTINE DPVLAB(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG, 1IHNAME,IHNAM2,IUSE,IN,IVSTAR,IVSTOP,IVALUE,VALUE,NUMNAM,MAXNAM, 1IVARLB, 1NUMCOL,MAXCOL,MAXN,IANS,IANSLC,IWIDTH,IBUGS2,IFOUND,IERROR) C C PURPOSE--DEFINE A VARIABLE LABEL FOR A VARIABLE. C THIS CAN BE USED IN SOME PLOTS (AND ITS USE WILL C PROBABLY BE EXTENDED IN THE FUTURE). C EXAMPLE--VARIABLE LABEL X1 PRESSURE 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-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--99/11 C ORIGINAL VERSION--NOVEMBER 1999. 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 IANSLC CHARACTER*40 IVARLB CHARACTER*4 IBUGS2 CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 ILEFT CHARACTER*4 ILEFT2 CHARACTER*4 IHWUSE CHARACTER*4 MESSAG C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C DIMENSION IHARG(*) DIMENSION IHARG2(*) DIMENSION IARGT(*) DIMENSION IARG(*) DIMENSION ARG(*) C DIMENSION IHNAME(*) DIMENSION IHNAM2(*) DIMENSION IUSE(*) DIMENSION IN(*) DIMENSION IVSTAR(*) DIMENSION IVSTOP(*) DIMENSION IVALUE(*) DIMENSION VALUE(*) C DIMENSION IANS(*) DIMENSION IANSLC(*) DIMENSION IVARLB(*) 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='DPVL' ISUBN2='AB ' C ICOLL=0 ILISTR=0 ILISTL=0 C ILEFT='UNKN' ILEFT2='UNKN' C C ************************************* C ** TREAT THE VARIABLE LABEL CASE ** C ************************************* C C ********************************** C ** STEP 1-- ** C ** INITIALIZE VARIABLES. ** C ********************************** C ISTEPN='1' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IFOUND='YES' IERROR='NO' C C ******************************************************* C ** STEP 2-- ** C ** CHECK THAT THE FIRST ARGUMENT IS LABEL. ** C ** THEN THE NEXT ARGUMENT SHOULD BE THE VARIABLE ** C ** NAME. ** C ******************************************************* C ISTEPN='2' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C MINNA=2 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2, 1IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IF(IHARG(1).NE.'LABE')THEN IFOUND='NO' GOTO9000 CCCCC ELSE CCCCC ISHIFT=1 CCCCC CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, CCCCC1 IBUGS2,IERROR) ENDIF C IF(NUMARG.LE.1)GOTO110 IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ON')GOTO110 IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'OFF')GOTO110 IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'AUTO')GOTO110 IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'DEFA')GOTO110 GOTO150 C 110 CONTINUE DO120I=1,MAXNAM IVARLB(I)=' ' 120 CONTINUE ICOLL=-1 GOTO8000 C 150 CONTINUE ILEFT=IHARG(2) ILEFT2=IHARG2(2) ICOLL=IARG(2) IHWUSE='V' MESSAG='YES' CALL CHECKN(ILEFT,ILEFT2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ICOLL=IVALUE(ILOCV) C IF(NUMARG.EQ.3.AND.IHARG(3).EQ.'ON')GOTO157 IF(NUMARG.EQ.3.AND.IHARG(3).EQ.'OFF')GOTO157 IF(NUMARG.EQ.3.AND.IHARG(3).EQ.'AUTO')GOTO157 IF(NUMARG.EQ.3.AND.IHARG(3).EQ.'DEFA')GOTO157 IF(NUMARG.EQ.2)GOTO157 GOTO159 157 CONTINUE IVARLB(ICOLL)=' ' GOTO8000 159 CONTINUE C C ***************************************************** C ** STEP 3-- ** C ** DETERMINE THE LOCATION OF THE WORD LABEL . ** C ***************************************************** C DO160I=1,IWIDTH I2=I IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IF(IP4.GT.IWIDTH)GOTO169 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'.OR.IANS(IP4).EQ.' ')) 1GOTO180 160 CONTINUE 169 CONTINUE C WRITE(ICOUT,171) 171 FORMAT('***** ERROR IN DPVLAB--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,172) 172 FORMAT(' THE WORD LABEL NOT FOUND.') CALL DPWRST('XXX','BUG ') GOTO9000 C 180 CONTINUE ISTOPL=IP4+1 C C ***************************************************** C ** STEP 4-- ** C ** SKIP THE NEXT WORD (THE VARIABLE NAME) ** C ** AND THEN FIND NEXT NON-BLANK CHARACTER ** C ** (THIS CHARACTER TILL END OF LINE EQUAL ** C ** = VARIABLE LABEL) ** C ***************************************************** C ISTART=ISTOPL DO190I=ISTART,IWIDTH ISTOPL=I IF(IANSLC(I).EQ.' ')GOTO190 GOTO191 190 CONTINUE ISTOPL=IWIDTH+1 191 CONTINUE IF(ISTOPL.GT.IWIDTH)THEN IVARLB(ICOLL)=' ' GOTO8000 ENDIF ISTART=ISTOPL DO195I=ISTART,IWIDTH ISTOPL=I IF(IANSLC(I).EQ.' ')GOTO196 195 CONTINUE ISTOPL=IWIDTH+1 196 CONTINUE IF(ISTOPL.GT.IWIDTH)THEN IVARLB(ICOLL)=' ' GOTO8000 ENDIF ISTART=ISTOPL DO198I=ISTART,IWIDTH IF(IANSLC(I).NE.' ')THEN ISTARS=I GOTO199 ENDIF 198 CONTINUE ISTARS=IWIDTH+1 199 CONTINUE IF(ISTARS.GT.IWIDTH)THEN IVARLB(ICOLL)=' ' GOTO8000 ENDIF C NCHAR=IWIDTH-ISTARS+1 IF(NCHAR.GT.40)NCHAR=40 IVARLB(ICOLL)=' ' J=0 DO250I=ISTARS,ISTARS+NCHAR-1 J=J+1 IVARLB(ICOLL)(J:J)=IANSLC(I)(1:1) 250 CONTINUE GOTO8000 C C ********************************************** C ** STEP 5-- ** C ** PRINT OUT A BRIEF MESSAGE ** C ** INDICATING THAT THE VARIABLE LABEL ** C ** HAS BEEN CARRIED OUT. ** C ********************************************** C 8000 CONTINUE ISTEPN='5' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IFEEDB.EQ.'OFF')GOTO619 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IF(ICOLL.GE.1)THEN WRITE(ICOUT,611)ILEFT,ILEFT2 611 FORMAT('VARIABLE ',A4,A4,' LABEL HAS JUST BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,613)IVARLB(ICOLL) 613 FORMAT(A40) CALL DPWRST('XXX','BUG ') ELSE WRITE(ICOUT,621) 621 FORMAT('ALL VARIABLE LABELS HAVE JUST BEEN SET TO THERE ', 1 'DEFAULT VALUES.') CALL DPWRST('XXX','BUG ') ENDIF 619 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE C IF(IBUGS2.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPVLAB--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ILEFT,ILEFT2 9012 FORMAT('ILEFT,ILEFT2 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)ICOLL 9016 FORMAT('ICOLL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO9030I=1,NUMNAM WRITE(ICOUT,9031)I,IUSE(I),IVALUE(I),IN(I) 9031 FORMAT('I,IUSE(I),IVALUE(I),IN(I) = ',I8,2X,A4,I8,I8) CALL DPWRST('XXX','BUG ') 9030 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPVRML(NPTS,NLAB, 1X,T,W,N, 1XMLS,S2BMLS,SEML,SEMLK1,SEMLK2, 1DLOWML,DHIGML,STXMU,STS2B, 1IWRITE, 1ICAPSW,ICAPTY,IOUNI5, 1ISUBRO,IBUGA3,IERROR) C C PURPOSE--IMPLEMENT VANGEL-RUKHIN APPROACH TO CONSENSUS MEANS C WRITTEN BY--CODE FOR VANGEL-RUKHIN PROVIDED BY MARK VANGEL. C PRINTING--YES C SUBROUTINES NEEDED--MPSUB C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C Gaithersburg, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--2006/3 C ORIGINAL VERSION--MARCH 2006. EXTRACTED FROM DPMAN2 ROUTINE C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------- C IMPLICIT DOUBLE PRECISION (A-H, O-Z) C CHARACTER*4 ICAPSW CHARACTER*4 ICAPTY CHARACTER*4 ISUBRO CHARACTER*4 ISUBN0 CHARACTER*4 IBUGA3 CHARACTER*4 IERROR C CHARACTER*4 IWRITE C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*1 IBASLC C CHARACTER*20 IMETH C REAL APPF REAL XML REAL XMLS REAL S2BML REAL S2BMLS REAL SEML REAL SEMLK1 REAL SEMLK2 C C---------------------------------------------------------------- C INTEGER N(*) C DOUBLE PRECISION X(*) DOUBLE PRECISION T(*) DOUBLE PRECISION W(*) C COMMON /MPCOM/ T0, T1 C INCLUDE 'DPCOST.INC' C PARAMETER (MAXHED=50) INTEGER IWIDTH(MAXHED) INTEGER NUMDI2(MAXHED) CHARACTER*8 ALIGN(MAXHED) CHARACTER*8 VALIGN(MAXHED) COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN CHARACTER*45 IVALUE(MAXHED) INTEGER NCHAR(MAXHED) REAL AVALUE(MAXHED) C LOGICAL IFLAG1 LOGICAL IFLAG2 LOGICAL IFLAG3 C CHARACTER*132 ITTEMP CHARACTER*132 IHEAD C CHARACTER*4 IRTFMD COMMON/COMRTF/IRTFMD C REAL CPUMIN REAL CPUMAX 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='DPVR' ISUBN2='ML ' C IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'VRML')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPVRML--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)NPTS,NLAB,STS2B,STXMU 52 FORMAT('NPTS,NLAB,STS2B,STXMU = ',2I8,2G15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)T0,T1 55 FORMAT('T0,T1 = ',2G15.7) CALL DPWRST('XXX','BUG ') DO65I=1,NLAB WRITE(ICOUT,66)I,T(I),X(I),N(I) 66 FORMAT('I,T(I),X(I),N(I) = ',I8,2G15.7,I8) CALL DPWRST('XXX','BUG ') 65 CONTINUE ENDIF C IF (STS2B .GT. 0.D0) THEN DO 501 I=1,NLAB W(I) = STS2B/(STS2B +T(I)) 501 CONTINUE ELSE DO 507 I=1,NLAB W(I) = 1.0D0/T(I) 507 CONTINUE END IF C MAXIT = 1000 DXML = STXMU DS2BML = STS2B CALL MPINTL(NLAB,N,X,T,DXML,DS2BML,W,MAXIT,DLIK,IBUGA3,IERROR) IF(IERROR.EQ.'YES')GOTO9000 XML=REAL(DXML) S2BML=REAL(DS2BML) XMLS=REAL((T1-T0)*XML + T0) S2BMLS=REAL(((T1-T0)**2)*S2BML) C IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'VRML')THEN WRITE(ICOUT,520)XML,XMLS,S2BML,S2BMLS 520 FORMAT('XML,XMLS,S2BML,S2BMLS = ',4E15.7) CALL DPWRST('XXX','BUG ') DO522I=1,NLAB WRITE(ICOUT,526)I,T(I),W(I) 526 FORMAT('I,T(I),W(I) = ',I8,2G15.7) CALL DPWRST('XXX','BUG ') 522 CONTINUE ENDIF C DSUM1=0.0D0 DSUM2=0.0D0 DO509J=1,NLAB TAU =S2BML/W(J) - S2BML TAU=(T1-T0)**2*TAU + DBLE(S2BMLS) XJ=(T1-T0)*X(J) + T0 DSUM1=DSUM1 + (XJ-DBLE(XMLS))**2/(TAU**2) DSUM2=DSUM2 + 1.0D0/TAU CCCCC WRITE(IOUNI5,508)W(J),TAU 509 CONTINUE 508 FORMAT(E15.7,1X,E15.7) C STDERR=SQRT(DSUM1)/DSUM2 SEML=REAL(STDERR) SEMLK1=SEML SEMLK2=2.0*SEML CALL NORPPF(0.975,APPF) DLOWML=XMLS - DBLE(APPF)*STDERR DHIGML=XMLS + DBLE(APPF)*STDERR C IF(IPRINT.EQ.'ON')THEN IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN C WRITE(ICOUT,5107) 5107 FORMAT('
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5111) 5111 FORMAT('') CALL DPWRST('XXX','WRIT') C 5121 FORMAT(' ') 5123 FORMAT(' ') 5126 FORMAT(' ') 5151 FORMAT(' ',I8) 5152 FORMAT(' ',F15.7) 5155 FORMAT('  ') 5191 FORMAT('
    ') 5127 FORMAT(' ') 5128 FORMAT('
    ') 5193 FORMAT('
') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5170) 5170 FORMAT(' 3. Method: Vangel-Rukhin Maximum ', 1 'Likelihood:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5155) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5171) 5171 FORMAT('      ', 1 'Estimate of (unscaled) Consensus Mean:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)XMLS CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5172) 5172 FORMAT('      ', 1 'Estimate of (scaled) Consensus Mean:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)REAL(XML) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5173) 5173 FORMAT('      ', 1 'Between Lab Variance (unscaled):') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)S2BMLS CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5174) 5174 FORMAT('      ', 1 'Between Lab SD (unscaled):') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)SQRT(S2BMLS) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5175) 5175 FORMAT('      ', 1 'Between Lab Variance (scaled):') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)S2BML CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5176) 5176 FORMAT('      ', 1 'Standard Deviation of Consensus Mean:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)SEML CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5177) 5177 FORMAT('      ', 1 'Standard Uncertainty (k = 1):') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)SEML CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5178) 5178 FORMAT('      ', 1 'Expanded Uncertainty (k = 2):') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)2.0*SEML CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5179)APPF 5179 FORMAT('      ', 1 'Expanded Uncertainty (k = ',F10.7,'):') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)APPF*SEML CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5180) 5180 FORMAT('      ', 1 'Normal ppf of 0.975:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)APPF CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5181) 5181 FORMAT('      ', 1 'Lower 95% (normal) Confidence Limit:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)REAL(DLOWML) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5182) 5182 FORMAT('      ', 1 'Upper 95% (normal) Confidence Limit:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)REAL(DHIGML) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5183) 5183 FORMAT('      ', 1 'Note: Vangel-Rukhin ML Best Usage:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5155) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5184) 5184 FORMAT('      ', 1 '         ', 1 '6 or More Labs') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5155) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5191) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5193) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN C CALL DPCONA(92,IBASLC) C 8002 FORMAT(A1,'begin{table}') 8005 FORMAT(A1,'begin{center}') 8006 FORMAT(5X,A1,'begin{tabular} {lr}') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8002)IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8005)IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8006)IBASLC CALL DPWRST('XXX','WRIT') C 8011 FORMAT(5X,'{',A1,'bf 3. Method: Vangel-Rukhin ', 1 'Maximum Likelihood:} & ',2X,A1,A1) 8012 FORMAT(5X,'Estimate of (unscaled) Consensus Mean: & ', 1 F15.7,2X,A1,A1) 8013 FORMAT(5X,'Estimate of (scaled) Consensus Mean: & ', 1 F15.7,2X,A1,A1) C WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8012)XMLS,IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8013)REAL(XML),IBASLC,IBASLC CALL DPWRST('XXX','WRIT') C 8016 FORMAT(5X,'Between Lab Variance (unscaled): & ', 1 F15.7,2X,A1,A1) 8017 FORMAT(5X,'Between Lab SD (unscaled): & ', 1 F15.7,2X,A1,A1) 8018 FORMAT(5X,'Between Lab Variance (scaled): & ', 1 F15.7,2X,A1,A1) 8019 FORMAT(5X,'Standard Deviation of Consensus Mean: & ', 1 F15.7,2X,A1,A1) 8020 FORMAT(5X,'Standard Uncertainty (k = 1): & ', 1 F15.7,2X,A1,A1) 8021 FORMAT(5X,'Expanded Uncertainty (k = 2): & ', 1 F15.7,2X,A1,A1) 8022 FORMAT(5X,'Expanded Uncertainty (k = ',F10.7,'): & ', 1 F15.7,2X,A1,A1) WRITE(ICOUT,8016)S2BMLS,IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8017)SQRT(S2BMLS),IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8018)REAL(S2BML),IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8019)SEML,IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8020)SEML,IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8021)2.0*SEML,IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8022)APPF,APPF*SEML,IBASLC,IBASLC CALL DPWRST('XXX','WRIT') C 8025 FORMAT(5X,'Normal PPF of 0.975: & ', 1 F10.7,2X,A1,A1) 8026 FORMAT(5X,'Lower 95',A1,'% (normal) Confidence Interval: & ', 1 F15.7,2X,A1,A1) 8027 FORMAT(5X,'Upper 95',A1,'% (normal) Confidence Interval: & ', 1 F15.7,2X,A1,A1) 8028 FORMAT(5X,'Note: Vangel-Rukhin Maximum Likelihood ', 1 'Best Usage: & ',2X,A1,A1) 8029 FORMAT(5X,' 6 or More Labs & ', 1 2X,A1,A1) WRITE(ICOUT,8025)APPF,IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8026)IBASLC,REAL(DLOWML),IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8027)IBASLC,REAL(DHIGML),IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8028)IBASLC,IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8029)IBASLC,IBASLC CALL DPWRST('XXX','WRIT') C 8030 FORMAT(A1,'end{tabular}') 8031 FORMAT(A1,'end{center}') 8032 FORMAT(A1,'end{table}') WRITE(ICOUT,8030)IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8031)IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,8032)IBASLC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN C CALL DPCONA(92,IBASLC) C 6191 FORMAT(A1,'f',I1) IF(IRTFFF.EQ.'Courier New')THEN ITEMP=1 ELSEIF(IRTFFF.EQ.'Lucida Console')THEN ITEMP=8 ELSE ITEMP=1 ENDIF WRITE(ICOUT,6191)IBASLC,ITEMP CALL DPWRST(ICOUT,'WRIT') C NCOL=4 IDEFPS=20 IFRST=IRTFPS*5500/IDEFPS IINC1=IRTFPS*1540/IDEFPS C DO6105ISET1=1,NCOL VALIGN(ISET1)='b' ALIGN(ISET1)='r' IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7 6105 CONTINUE ALIGN(1)='l' NUMDI2(1)=0 NUMDI2(2)=7 C IWIDTH(1)=IFRST IWIDTH(2)=IWIDTH(1) + IINC1 C ITTEMP=' ' NCTEMP=0 NHEAD=0 C CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD) C NHEAD=2 IFLAG1=.FALSE. IFLAG2=.FALSE. C IVALUE(1)=' b 3. Method: Vangel-Rukhin ML' IVALUE(1)(1:1)=IBASLC NCHAR(1)=30 IVALUE(2)=' ' NCHAR(2)=0 CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2) C IFLAG1=.FALSE. NHEAD=1 C NCHAR(1)=41 IVALUE(1)=' Estimate of (unscaled) Consensus Mean:' AVALUE(2)=XMLS CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=39 IVALUE(1)=' Estimate of (scaled) Consensus Mean:' AVALUE(2)=XML CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=35 IVALUE(1)=' Between Lab Variance (unscaled):' AVALUE(2)=S2BMLS CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=29 IVALUE(1)=' Between Lab SD (unscaled):' AVALUE(2)=SQRT(S2BMLS) CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=33 IVALUE(1)=' Between Lab Variance (scaled):' AVALUE(2)=S2BML CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=40 IVALUE(1)=' Standard Deviation of Consensus Mean:' AVALUE(2)=SEML CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=32 IVALUE(1)=' Standard Uncertainty (k = 1):' AVALUE(2)=SEML CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=32 IVALUE(1)=' Expanded Uncertainty (k = 2):' AVALUE(2)=2.0*SEML CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=41 IVALUE(1)(1:29)=' Expanded Uncertainty (k = ' WRITE(IVALUE(1)(30:39),'(F10.7)')APPF IVALUE(1)(40:41)='):' AVALUE(2)=APPF*SEML CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=23 IVALUE(1)=' Normal PPF of 0.975:' AVALUE(2)=APPF CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=39 IVALUE(1)=' Lower 95% (normal) Confidence Limit:' AVALUE(2)=REAL(DLOWML) CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C NCHAR(1)=39 IVALUE(1)=' Upper 95% (normal) Confidence Limit:' AVALUE(2)=REAL(DHIGML) CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1) C IVALUE(1)=' Note: Vangel-Rukhin ML Best Usage:' NCHAR(1)=37 IVALUE(2)=' ' NCHAR(2)=0 CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2) C IVALUE(1)=' 6 or More Labs:' NCHAR(1)=24 IVALUE(2)=' ' NCHAR(2)=0 CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2) C CALL DPRTF6(NHEAD) IFLAG1=.TRUE. IFLAG2=.FALSE. C ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN ELSE C WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4001) 4001 FORMAT('3. Method: Vangel-Rukhin Maximum Likelihood') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,4002)XMLS 4002 FORMAT(' Estimate of (unscaled) Consensus Mean: ', 1 F15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4003)REAL(XML) 4003 FORMAT(' Estimate of (scaled) Consensus Mean: ', 1 F15.7) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,4006)S2BMLS 4006 FORMAT(' Between Lab Variance (unscaled): ', 1 F15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4007)SQRT(S2BMLS) 4007 FORMAT(' Between Lab SD (unscaled): ', 1 F15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4008)REAL(S2BML) 4008 FORMAT(' Between Lab Variance (scaled): ', 1 F15.7) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,4011)SEML 4011 FORMAT(' Standard Deviation of Consensus Mean: ', 1 F15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4012)SEML 4012 FORMAT(' Standard Uncertainty (k = 1): ', 1 F15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4013)2.0*SEML 4013 FORMAT(' Expanded Uncertainty (k = 2): ', 1 F15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4014)APPF,APPF*SEML 4014 FORMAT(' Expanded Uncertainty (k = ',F10.7,'): ', 1 F15.7) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,4021)APPF 4021 FORMAT(' Normal PPF of 0.975: ', 1 F15.7) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,4022)REAL(DLOWML) 4022 FORMAT(' Lower 95% (normal) Confidence Limit: ', 1 F15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4023)REAL(DHIGML) 4023 FORMAT(' Upper 95% (normal) Confidence Limit: ', 1 F15.7) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,4031) 4031 FORMAT(' Note: Vangel-Rukhin Maximum Likelihood ', 1 'Best Usage:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4032) 4032 FORMAT(' 6 or More Labs') CALL DPWRST('XXX','WRIT') C ENDIF ENDIF C CCCCC FOLLOWING CODE IS STILL EXPERIMENTAL BY MARK VANGEL. CCCCC WE PRINT COPY OF TAU (CAN BE COMPARED TO T(I), BUT RES CCCCC IS STILL UNDER DEVELOPMENT. CCCCC DO320I=1,NLAB CCCCC A =S2BML/(X(I) -XML)**2 CCCCC B =T(I)/(X(I)-XML)**2 CCCCC D =(X(I)-XML)**2 CCCCC TAU =S2BML/W(I) - S2BML CCCCC RES = (DBLE(N(I)-1)/TAU) *(1.0D0 - T(I)/TAU) CCCCC WRITE TO IOUNI2? CCCCC WRITE (IOUNI1,322) X(I),T(I),TAU,(X(I)-XML)/(S2BML+TAU),RES C322 FORMAT(5G15.7) C320 CONTINUE C C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'VRML')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPVRML--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IERROR 9012 FORMAT('IERROR = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)NPTS,NLAB 9013 FORMAT('NPTS,NLAB = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)XMLS,S2BMLS,SEML 9014 FORMAT('XMLS,S2BMLS,SEML = ',3G15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)DLOWML,DHIGML 9015 FORMAT('DLOWML,DHIGML = ',2G15.7) CALL DPWRST('XXX','BUG ') ENDIF C RETURN END SUBROUTINE DPVWAE(YTEMP,XTEMP,MAXNXT, 1ICAPSW, 1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR) C C PURPOSE--CARRY OUT VAN DER WAERDEN TEST C NON-PARAMETRIC ONE-WAY ANOVA C EXAMPLE--VAN DER WAERDEN TEST Y X C REFERENCE--W. J, CONOVER, "PRACTICAL NONPARAMETRIC STATISTICS", C THIRD EDITION, WILEY, 1999, PP. 396-406. 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-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--2004/10 C ORIGINAL VERSION--OCTOBER 2004. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICAPSW CHARACTER*4 IBUGA2 CHARACTER*4 IBUGA3 CHARACTER*4 IBUGQ CHARACTER*4 ISUBRO CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CHARACTER*4 ICASEQ C CHARACTER*4 IH11 CHARACTER*4 IH12 CHARACTER*4 IH21 CHARACTER*4 IH22 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*4 IUSE1 CHARACTER*4 IUSE2 C CHARACTER*4 IH CHARACTER*4 IH2 CHARACTER*4 IHOST1 CHARACTER*4 ISUBN0 C C--------------------------------------------------------------------- C DIMENSION YTEMP(*) DIMENSION XTEMP(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOST.INC' INCLUDE 'DPCOPA.INC' C DIMENSION DTAG(MAXOBV) DIMENSION ARANK(MAXOBV) DIMENSION ANORM(MAXOBV) DIMENSION NRANK(MAXOBV) C INCLUDE 'DPCOZZ.INC' EQUIVALENCE(GARBAG(IGARB1),DTAG(1)) EQUIVALENCE(GARBAG(IGARB2),ARANK(1)) EQUIVALENCE(GARBAG(IGARB3),ANORM(1)) C INCLUDE 'DPCOZI.INC' EQUIVALENCE(IGARBG(IIGAR1),NRANK(1)) C INCLUDE 'DPCOHK.INC' INCLUDE 'DPCOSU.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='DPVW' ISUBN2='AE ' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C IFOUND='NO' IERROR='NO' C N1=(-999) N2=(-999) C NS1=(-999) NS2=(-999) C IUSE1='-999' IUSE2='-999' C ILOCV=(-999) C VALUE1=(-999.0) VALUE2=(-999.0) C ICOL1=(-999) ICOL2=(-999) C MINN2=4 C IFOUND='YES' C NLEFT=0 C ICASEQ='UNKN' C C ****************************************** C ** TREAT THE VAN DER WAERDEN TEST CASE ** C ****************************************** C IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'VWAE')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPVWAE--') 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 ') WRITE(ICOUT,55)MAXNXT 55 FORMAT('MAXNXT = ',I8) CALL DPWRST('XXX','BUG ') ENDIF C C ******************************************************* C ** STEP 2-- ** C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. ** C ******************************************************* C ISTEPN='2' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'VWAE') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C MINNA=2 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2, 1IERROR) IF(IERROR.EQ.'YES')GOTO9000 C C **************************************** C ** STEP 11-- ** C ** CHECK THE VALIDITY OF ARGUMENT 1 ** C ** (THIS SHULD BE A VARIABLE.) ** C **************************************** C ISTEPN='11' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IH11=IHARG(1) IH12=IHARG2(1) IHWUSE='V' MESSAG='YES' CALL CHECKN(IH11,IH12,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) C IF(IERROR.EQ.'YES')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1141) 1141 FORMAT('***** ERROR IN VAN DER WAERDEN TEST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1142) 1142 FORMAT(' FOR VAN DER WAERDEN TEST,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1145) 1145 FORMAT(' BOTH ARGUMENTS MUST BE A VARIABLE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1146) 1146 FORMAT(' (AS OPPOSED TO A PARAMETER OR FUNCTION).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1147) 1147 FORMAT(' ARGUMENT 1 WAS NOT A VARIABLE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1148) 1148 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,1150)(IANS(I),I=1,MIN(80,IWIDTH)) 1150 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C IUSE1=IUSE(ILOCV) ICOL1=IVALUE(ILOCV) N1=IN(ILOCV) 1190 CONTINUE C C ******************************************************* C ** STEP 12-- ** C ** IF ARGUMENT 1 IS A VARIABLE, ** C ** CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) ** C ** FOR ARGUMENT 1 IS 2 OR MORE. ** C ******************************************************* C ISTEPN='12' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'VWAE') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IUSE1.EQ.'V' .AND. N1 .LT.MINN2)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1211) 1211 FORMAT('***** ERROR IN VAN DER WAERDEN TEST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1212) 1212 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS FOR WHICH THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1213) 1213 FORMAT(' VAN DER WAERDEN TEST WAS TO HAVE BEEN PERFORMED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1215)MINN2 1215 FORMAT(' MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE ', 1 'CASE HERE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1217)IH11,IH12,N1 1217 FORMAT(' FOR VARIABLE ',A4,A4,' WHICH HAD ',I8, 1 'OBSERVATIONS.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1219) 1219 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,1220)(IANS(I),I=1,MIN(80,IWIDTH)) 1220 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C C **************************************** C ** STEP 21-- ** C ** CHECK THE VALIDITY OF ARGUMENT 2 ** C ** (THIS SHOULD ALSO BE A VARIABLE) ** C **************************************** C ISTEPN='21' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'VWAE') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IH21=IHARG(2) IH22=IHARG2(2) IHWUSE='V' MESSAG='YES' CALL CHECKN(IH21,IH22,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) C IF(IERROR.EQ.'YES')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2141) 2141 FORMAT('***** ERROR IN VAN DER WAERDEN TEST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2142) 2142 FORMAT(' FOR VAN DER WAERDEN TEST, BOTH ARGUMENTS MUST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2146) 2146 FORMAT(' BE A VARIABLE (AS OPPOSED TO A PARAMETER OR ', 1 'FUNCTION).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2147) 2147 FORMAT(' ARGUMENT 2 WAS NOT A VARIABLE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2148) 2148 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,2150)(IANS(I),I=1,MIN(80,IWIDTH)) 2150 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C IUSE2=IUSE(ILOCV) ICOL2=IVALUE(ILOCV) N2=IN(ILOCV) 2190 CONTINUE C C ******************************************************* C ** STEP 22-- ** C ** IF ARGUMENT 2 IS A VARIABLE, ** C ** CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2) ** C ** FOR ARGUMENT 2 IS THE SAME AS ARGUMENT 1. ** C ******************************************************* C ISTEPN='22' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'VWAE') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IUSE2.EQ.'V' .AND. N2.NE.N1)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2211) 2211 FORMAT('***** ERROR IN VAN DER WAERDEN TEST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2212) 2212 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS FOR VARIABLE 2') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2213) 2213 FORMAT(' OF THE VAN DER WAERDEN TEST MUST BE THE SAME AS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2215) 2215 FORMAT(' VARIABLE 1; SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2216)N1,N2 2216 FORMAT(' N1 = ',I8,' N2 = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2219) 2219 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,2220)(IANS(I),I=1,MIN(80,IWIDTH)) 2220 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C C ***************************************** C ** STEP 40-- ** C ** CHECK TO SEE THE TYPE CASE-- ** C ** 1) UNQUALIFIED (THAT IS, FULL); ** C ** 2) SUBSET/EXCEPT; OR ** C ** 3) FOR. ** C ***************************************** C ISTEPN='40' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'VWAE') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASEQ='FULL' ILOCQ=NUMARG+1 IF(NUMARG.LT.1)GOTO4090 DO4000J=1,NUMARG J1=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ') GOTO4010 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ') GOTO4010 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ') GOTO4020 4000 CONTINUE GOTO4090 4010 CONTINUE ICASEQ='SUBS' ILOCQ=J1 GOTO4090 4020 CONTINUE ICASEQ='FOR' ILOCQ=J1 GOTO4090 4090 CONTINUE IF(IBUGA2.EQ.'ON')THEN WRITE(ICOUT,4091)NUMARG,ILOCQ 4091 FORMAT('NUMARG,ILOCQ = ',2I8) CALL DPWRST('XXX','BUG ') ENDIF C C *********************************************** C ** STEP 41-- ** C ** TEMPORARILY FORM THE VARIABLE Y(.) ** C ** WHICH WILL HOLD THE DATA FROM SAMPLE 1. ** C ** FORM THIS VARIABLE BY ** C ** BRANCHING TO THE APPROPRIATE SUBCASE ** C ** (FULL, SUBSET, OR FOR). ** C *********************************************** C IF(IUSE1.NE.'V')GOTO4190 C ISTEPN='41' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'VWAE') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASEQ.EQ.'FULL')GOTO4110 IF(ICASEQ.EQ.'SUBS')GOTO4120 IF(ICASEQ.EQ.'FOR')GOTO4130 C 4110 CONTINUE DO4115I=1,N1 ISUB(I)=1 4115 CONTINUE NQ=N1 GOTO4150 C 4120 CONTINUE NIOLD=N1 CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR) NQ=NIOLD GOTO4150 C 4130 CONTINUE NIOLD=N1 CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERROR) NQ=NFOR GOTO4150 C 4150 CONTINUE IF(NQ.LT.MINN2)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4151) 4151 FORMAT('***** ERROR IN VAN DER WAERDEN TEST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4152) 4152 FORMAT(' AFTER THE APPROPRIATE SUBSET HAS BEEN ', 1 'EXTRACTED,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4153)IH11,IH12 4153 FORMAT(' THE NUMBER OF OBSERVATIONS REMAINING FROM ', 1 'VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4156)MINN2 4156 FORMAT(' MUST BE ',I8,' OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4157)NQ 4157 FORMAT(' SUCH WAS NOT THE CASE HERE. (N = ',I8,')') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4158) 4158 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,4159)(IANS(I),I=1,MIN(80,IWIDTH)) 4159 FORMAT(' ',80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C J=0 IMAX=N1 IF(NQ.LT.N1)IMAX=NQ DO4170I=1,IMAX IF(ISUB(I).EQ.0)GOTO4170 J=J+1 C IJ=MAXN*(ICOL1-1)+I IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ) IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I) IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I) IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I) IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I) IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I) IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I) C 4170 CONTINUE NS1=J C 4190 CONTINUE C C *********************************************** C ** STEP 42-- ** C ** TEMPORARILY FORM THE VARIABLE X(.) ** C ** WHICH WILL HOLD THE DATAN FROM SAMPLE 2. ** C ** FORM THIS VARIABLE BY ** C ** BRANCHING TO THE APPROPRIATE SUBCASE ** C ** (FULL, SUBSET, OR FOR). ** C *********************************************** C IF(IUSE2.NE.'V')GOTO4290 C ISTEPN='42' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'VWAE') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASEQ.EQ.'FULL')GOTO4210 IF(ICASEQ.EQ.'SUBS')GOTO4220 IF(ICASEQ.EQ.'FOR')GOTO4230 C 4210 CONTINUE DO4215I=1,N2 ISUB(I)=1 4215 CONTINUE NQ=N2 GOTO4250 C 4220 CONTINUE NIOLD=N2 CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR) NQ=NIOLD GOTO4250 C 4230 CONTINUE NIOLD=N2 CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERROR) NQ=NFOR GOTO4250 C 4250 CONTINUE IF(NQ.LT.MINN2)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4251) 4251 FORMAT('***** ERROR IN VAN DER WAERDEN TEST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4252) 4252 FORMAT(' AFTER THE APPROPRIATE SUBSET HAS BEEN ', 1 'EXTRACTED,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4253)IH21,IH22 4253 FORMAT(' THE NUMBER OF OBSERVATIONS REMAINING', 1 'FROM VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4256)MINN2 4256 FORMAT(' MUST BE ',I8,' OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4257)NQ 4257 FORMAT(' SUCH WAS NOT THE CASE HERE. (N = ',I8,')') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4258) 4258 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,4259)(IANS(I),I=1,MIN(80,IWIDTH)) 4259 FORMAT(' ',80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C J=0 IMAX=N2 IF(NQ.LT.N2)IMAX=NQ DO4270I=1,IMAX IF(ISUB(I).EQ.0)GOTO4270 J=J+1 C IJ=MAXN*(ICOL2-1)+I IF(ICOL2.LE.MAXCOL)X(J)=V(IJ) IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I) IF(ICOL2.EQ.MAXCP2)X(J)=RES(I) IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I) IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I) IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I) IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I) C 4270 CONTINUE NS2=J C 4290 CONTINUE C C ********************************* C ** STEP 52-- ** C ** DO VAN DER WAERDEN TEST ** C ********************************* C ISTEPN='52' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'VWAE') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'VWAE')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5211) 5211 FORMAT('***** FROM DPVWAE, AS WE ARE ABOUT TO CALL DPVWA2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8) CALL DPWRST('XXX','BUG ') DO5215I=1,NS1 WRITE(ICOUT,5216)I,Y(I) 5216 FORMAT('I,Y(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') 5215 CONTINUE DO5217I=1,NS1 WRITE(ICOUT,5218)I,Y(I) 5218 FORMAT('I,Y(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') 5217 CONTINUE WRITE(ICOUT,5231)IBUGA3 5231 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') ENDIF C CALL DPVWA2(Y,X,NS1, 1YTEMP,DTAG,XTEMP,ANORM,ARANK,NRANK,MAXNXT, 1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999, 1ICAPSW,ICAPTY, 1IBUGA3,ISUBRO,IERROR) C C *************************************** C ** STEP 61-- ** C ** UPDATE INTERNAL DATAPLOT TABLES ** C *************************************** C ISTEPN='61' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'VWAE') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ISUBN0='DPVW' C IH='STAT' IH2='VAL ' VALUE0=STATVA CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='STAT' IH2='CDF ' VALUE0=STATCD CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF0 ' VALUE0=CUT0 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF50' VALUE0=CUT50 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF75' VALUE0=CUT75 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF90' VALUE0=CUT90 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF95' VALUE0=CUT95 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF99' VALUE0=CUT99 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='F999' VALUE0=CUT99 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'VWAE')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPVWAE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGA2,IBUGA3 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IBUGQ 9013 FORMAT('IBUGQ = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NLEFT,NS 9014 FORMAT('NLEFT,NS = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)ICASEQ 9015 FORMAT('ICASEQ = ',A4) 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 DPVWA2(Y,TAG,N, 1YTEMP,DTAG,AMEAN,ANORM,ARANK,NRANK,MAXNXT, 1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUTL99,CUTU99, 1ICAPSW,ICAPTY, 1IBUGA3,ISUBRO,IERROR) C C PURPOSE--THIS ROUTINE CARRIES OUT VAN DER WAERDEN (NORMAL SCORE C TEST) FOR SEVERAL INDEPENDENT VARIABLES, I.E., C A NON-PARAMETRIC ONE-WAY ANOVA C EXAMPLE--VAN DER WAERDEN TEST Y TAG C REFERENCE--W. J. CONOVER, "PRACTICAL NONPARAMETRIC C STATISTICS", THIRD EDITION, 1999, WILEY, C PP. 396-405. 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-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--2004/10 C ORIGINAL VERSION--OCTOBER 2004. C UPDATED --OCTOBER 2006. CALL LIST TO TPPF C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICAPSW CHARACTER*4 ICAPTY CHARACTER*4 IBUGA3 CHARACTER*4 IBASLC CHARACTER*4 IERROR C CHARACTER*4 IWRITE C CHARACTER*3 IATEMP C CHARACTER*6 ICONC1 CHARACTER*6 ICONC2 CHARACTER*6 ICONC3 C CHARACTER*4 ISUBRO CHARACTER*4 ISUBN0 CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN 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 DOUBLE PRECISION DSUM1 C C--------------------------------------------------------------------- C DIMENSION Y(*) DIMENSION TAG(*) DIMENSION DTAG(*) DIMENSION ANORM(*) DIMENSION YTEMP(*) DIMENSION AMEAN(*) DIMENSION ARANK(*) DIMENSION NRANK(*) 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='DPVW' ISUBN2='A2 ' ISUBN0=' ' C IERROR='NO' C IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'VWA2')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,51) 51 FORMAT('**** AT THE BEGINNING OF DPVWA2--') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,55)N 55 FORMAT('N = ',I8) CALL DPWRST('XXX','WRIT') DO56I=1,N WRITE(ICOUT,57)I,Y(I),TAG(I) 57 FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7) CALL DPWRST('XXX','WRIT') 56 CONTINUE WRITE(ICOUT,65)N 65 FORMAT('N = ',I8) CALL DPWRST('XXX','WRIT') DO66I=1,N WRITE(ICOUT,67)I,TAG(I) 67 FORMAT('I,TAG(I) = ',I8,E15.7) CALL DPWRST('XXX','WRIT') 66 CONTINUE ENDIF C C ******************************************** C ** STEP 11-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C ISTEPN='11' IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'VWA2') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(N.LT.4)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,111) 111 FORMAT('***** ERROR IN VAN DER WAERDEN TEST--') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,112) 112 FORMAT(' THE NUMBER OF OBSERVATIONS IS LESS THAN 4.') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,113)N 113 FORMAT('SAMPLE SIZE = ',I8) CALL DPWRST('XXX','WRIT') IERROR='YES' GOTO9000 ENDIF C HOLD=Y(1) DO135I=2,N IF(Y(I).NE.HOLD)GOTO139 135 CONTINUE 130 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,111) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,131)HOLD 131 FORMAT(' VARIABLE 1 HAS ALL ELEMENTS = ',E15.7) CALL DPWRST('XXX','WRIT') GOTO9000 139 CONTINUE C HOLD=TAG(1) DO235I=2,N IF(TAG(I).NE.HOLD)GOTO239 235 CONTINUE 230 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,111) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,231)HOLD 231 FORMAT(' VARIABLE 2 HAS ALL ELEMENTS = ',E15.7) CALL DPWRST('XXX','WRIT') GOTO9000 239 CONTINUE C C ******************************* C ** STEP 41-- ** C ** CARRY OUT CALCULATIONS ** C ** FOR VAN DER WAERDEN TEST ** C ******************************* C 410 CONTINUE C ISTEPN='41' IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'VWA2') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IWRITE='OFF' C CCCCC THE ALGORITHM FOR VAN DER WAERDEN TEST IS: CCCCC CCCCC 1) RANK ALL OBSERVATIONS (R) CCCCC 2) COMPUTE: A = NORPPF(RANK/(N+1)) CCCCC 3) COMPUTE MEAN OF A FOR EACH GROUP (Abar(i)) CCCCC 4) COMPUTE VARIACE FOR FULL SAMPLE (S**2) CCCCC 5) TEST STATISTIC IS: CCCCC CCCCC T = (1/S**2)*SUM[i=1 to k][N(i)*(Abar(i)**2] CCCCC CCCCC THE CRITICAL VALUE IS A CHI-SQUARED DISTRIBUTION WITH CCCCC (K-1) DEGREES OF FREEDOM CCCCC C CALL DISTIN(TAG,N,IWRITE,DTAG,NUMDIS,IBUGA3,IERROR) IF(IERROR.EQ.'YES')GOTO9000 CCCCC CALL SORTC(TAG,Y,N,TAG,Y) CALL RANK(Y,N,IWRITE,ARANK,IBUGA3,IERROR) IF(IERROR.EQ.'YES')GOTO9000 DO420I=1,N ATEMP=ARANK(I)/REAL(N+1) CALL NORPPF(ATEMP,ANORM(I)) 420 CONTINUE CALL VAR(ANORM,N,IWRITE,S2,IBUGA3,IERROR) C AN=REAL(N) C DSUM1=0.0D0 DO460IDIS=1,NUMDIS J=0 DO470I=1,N IF(TAG(I).EQ.DTAG(IDIS))THEN J=J+1 YTEMP(J)=ANORM(I) ENDIF 470 CONTINUE NRANK(IDIS)=J ANR=REAL(NRANK(IDIS)) CALL MEAN(YTEMP,NRANK(IDIS),IWRITE,YMEAN,IBUGA3,IERROR) AMEAN(IDIS)=YMEAN DSUM1=DSUM1 + DBLE(NRANK(IDIS))*DBLE(YMEAN)**2 460 CONTINUE C STATVA=REAL(DSUM1/DBLE(S2)) NUMDF=NUMDIS-1 CALL CHSCDF(STATVA,NUMDF,STATCD) C CUT0=0.0 CALL CHSPPF(.50,NUMDF,CUT50) CALL CHSPPF(.75,NUMDF,CUT75) CALL CHSPPF(.90,NUMDF,CUT90) CALL CHSPPF(.95,NUMDF,CUT95) CALL CHSPPF(.99,NUMDF,CUT99) CALL CHSPPF(.999,NUMDF,CUT999) C ICONC1='REJECT' ICONC2='REJECT' ICONC3='REJECT' C IF(STATVA.LE.CUT95)ICONC2='ACCEPT' C IOUNI1=IST1NU IFILE1=IST1NA ISTAT1=IST1ST IFORM1=IST1FO IACCE1=IST1AC IPROT1=IST1PR ICURS1=IST1CS ISUBN0='FRI2' 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 WRITE(IOUNI1,501) 501 FORMAT(' I J ', 1 '|Abar(i) - Abar(j)| ', 1 '90% CV ', 1 '95% CV ', 1 '99% CV ') C IDF=N-NUMDIS ALPHA=0.05 CALL TPPF(1.0-ALPHA/2.0,REAL(IDF),AT95) ALPHA=0.10 CALL TPPF(1.0-ALPHA/2.0,REAL(IDF),AT90) ALPHA=0.01 CALL TPPF(1.0-ALPHA/2.0,REAL(IDF),AT99) AFACT2=SQRT(S2*(AN-1.0-STATVA)/REAL(N-NUMDIS)) C DO530I=1,NUMDIS DO539J=1,NUMDIS IF(I.LT.J)THEN ANI=REAL(NRANK(I)) ANJ=REAL(NRANK(J)) ADIFF=ABS(AMEAN(I) - AMEAN(J)) AFACT3=SQRT((1.0/ANI) + (1.0/ANJ)) ACV90=AT90*AFACT2*AFACT3 ACV95=AT95*AFACT2*AFACT3 ACV99=AT99*AFACT2*AFACT3 IATEMP=' ' IF(ADIFF.GE.ACV90)IATEMP(1:1)='*' IF(ADIFF.GE.ACV95)IATEMP(2:2)='*' IF(ADIFF.GE.ACV99)IATEMP(3:3)='*' WRITE(IOUNI1,537)I,J,ADIFF,ACV90,ACV95,ACV99,IATEMP 537 FORMAT(I6,2X,I6,2X,4E15.7,A3) ENDIF 539 CONTINUE 530 CONTINUE 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 IOUNI2=IST2NU IFILE2=IST2NA ISTAT2=IST2ST IFORM2=IST2FO IACCE2=IST2AC IPROT2=IST2PR ICURS2=IST2CS ISUBN0='FRI2' 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 DO590I=1,N WRITE(IOUNI2,597)I,Y(I),ARANK(I),ANORM(I),AMEAN(I),NRANK(I) 597 FORMAT(I8,5E15.7) 590 CONTINUE 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 C ******************************** C ** STEP 42-- ** C ** WRITE OUT EVERYTHING ** C ** FOR VAN DER WAERDEN TEST ** C ******************************** C ISTEPN='42' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IPRINT.EQ.'ON')THEN IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN C C STEP 1: WRITE HEADER C WRITE(ICOUT,5001) 5001 FORMAT('') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5002) 5002 FORMAT('
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5003)NUMDIS 5003 FORMAT('VAN DER WAERDEN (NORMAL SCORES) TEST THAT THE ', 1 I8) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,55003) 55003 FORMAT(' GROUPS COME FROM IDENTICAL DISTRIBUTIONS') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5004) 5004 FORMAT('


') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C C STEP 2: START LIST C WRITE(ICOUT,5005) 5005 FORMAT('
    ') CALL DPWRST('XXX','WRIT') C C STEP 2A: LIST ITEM 1 C WRITE(ICOUT,5006) 5006 FORMAT('
  1. Statistics:') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5007) 5007 FORMAT('

    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5011) 5011 FORMAT(' ') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) 5021 FORMAT(' ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) 5023 FORMAT(' ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) 5026 FORMAT(' ') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5041) 5041 FORMAT(' Number of Groups:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5029)NUMDIS CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5042) 5042 FORMAT(' Variance of Normal Scores of the ', 1 'Ranks:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)S2 5051 FORMAT(' ',G15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) 5043 FORMAT(' Van Der Waerden Test Statstic:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)STATVA CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5091) 5091 FORMAT('
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5025) 5025 FORMAT(' Number of Observations:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) 5027 FORMAT(' ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5029)N 5029 FORMAT(' ',I8) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) 5028 FORMAT('
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5007) CALL DPWRST('XXX','WRIT') C C STEP 2B: LIST ITEM 2 C WRITE(ICOUT,5066) 5066 FORMAT('

  2. Percent Points of the Chi-Square Reference ', 1 'Distribution
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5067) 5067 FORMAT(' for Van Der Waerden Test Statistic:') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5007) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5011) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5071) 5071 FORMAT(' 0 Percent Point:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT0 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5072) 5072 FORMAT(' 50 Percent Point:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT50 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5073) 5073 FORMAT(' 75 Percent Point:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT75 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5074) 5074 FORMAT(' 90 Percent Point:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT90 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5075) 5075 FORMAT(' 95 Percent Point:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT95 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5076) 5076 FORMAT(' 99 Percent Point:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT99 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5077) 5077 FORMAT(' 99.5 Percent Point:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT999 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5078)100.0*STATCD 5078 FORMAT('
    ',G15.7,' Percent Point:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5052)STATVA 5052 FORMAT('
    ',G15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5091) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5007) CALL DPWRST('XXX','WRIT') C C STEP 2C: LIST ITEM 3 C WRITE(ICOUT,5081) 5081 FORMAT('
  3. Conclusion (at the 5% level):') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5007) CALL DPWRST('XXX','WRIT') IF(STATVA.LE.CUT95)THEN WRITE(ICOUT,5087)NUMDIS 5087 FORMAT(' The ',I8,' groups come from identical ', 1 'populations.') ELSE WRITE(ICOUT,5088)NUMDIS 5088 FORMAT(' The ',I8,' groups do not come from ', 1 'identical populations.') ENDIF CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5093) 5093 FORMAT('
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5095) 5095 FORMAT('
')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
 8001   FORMAT('{',A1,'bf VAN DER WAERDEN (NORMAL SCORES) TEST THAT')
88001   FORMAT('THE ',I8,'GROUPS COME FROM IDENTICAL DISTRIBUTIONS}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8004   FORMAT(A1,'begin{center}')
 8005   FORMAT(A1,'end{center}')
 8006   FORMAT(A1,'end{verbatim}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
 8011   FORMAT(A1,'begin{enumerate}')
 8012   FORMAT(A1,'end{enumerate}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,88001)NUMDIS
        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,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8020   FORMAT(11X,A1,'newline')
 8021   FORMAT(5X,A1,'item Statistics:')
 8022   FORMAT(5X,A1,'item Percent Points of the Chi-Square ',
     1         'Reference Distribution:')
 8023   FORMAT(5X,A1,'item Conclusion (at the 5',A1,'% level):')
 8030   FORMAT(11X,A1,'begin{tabular} {lr}')
 8031   FORMAT(11X,'Number of Observations: & ',I8,2X,A1,A1)
 8032   FORMAT(11X,'Number of Groups: & ',I8,2X,A1,A1)
 8033   FORMAT(11X,'Variance of Normal Scores of the Ranks: & ',
     1         G15.7,2X,A1,A1)
 8034   FORMAT(11X,'Van Der Waerden Test Statistic: & ',G15.7,
     1         2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8041   FORMAT(11X,G15.7,' Percent Point: & ',G15.7,2X,A1,A1)
 8042   FORMAT(11X,'The ',I8,' groups come from identical ',
     1         'populations.',2X,A1,A1)
 8043   FORMAT(11X,'The ',I8,' groups do not come from identical ',
     1         'populations.',2X,A1,A1)
 8044   FORMAT(11X,'0      Percent Point: & ',G15.7,2X,A1,A1)
 8045   FORMAT(11X,'50     Percent Point: & ',G15.7,2X,A1,A1)
 8046   FORMAT(11X,'90     Percent Point: & ',G15.7,2X,A1,A1)
 8047   FORMAT(11X,'95     Percent Point: & ',G15.7,2X,A1,A1)
 8048   FORMAT(11X,'99     Percent Point: & ',G15.7,2X,A1,A1)
 8049   FORMAT(11X,'99.5   Percent Point: & ',G15.7,2X,A1,A1)
C
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)NUMDIS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)S2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8022)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)CUT0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)CUT50,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)CUT90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8047)CUT95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8048)CUT99,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)CUT999,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)100.*STATCD,STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,8042)NUMDIS,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8043)NUMDIS,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8051   FORMAT(A1,'end{enumerate}')
 8052   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8051)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8052)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7211)
 7211   FORMAT('              VAN DER WAERDEN (NORMAL SCORES) TEST')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7212)
 7212   FORMAT('              THAT THE GROUPS COME FROM IDENTICAL ',
     1         'POPULATIONS.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7222)
 7222   FORMAT('1. STATISTICS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7224)N
 7224   FORMAT(6X,'NUMBER OF OBSERVATIONS               = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7226)NUMDIS
 7226   FORMAT(6X,'NUMBER OF GROUPS                     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7227)S2
 7227   FORMAT(6X,'VARIANCE OF NORMAL SCORES OF RANKS   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7228)STATVA
 7228   FORMAT(6X,'VAN DER WAERDEN TEST STATISTIC       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
 7240   FORMAT('2. PERCENT POINTS OF THE CHI-SQUARE REFERENCE ',
     1         'DISTRIBUTION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7241)
 7241   FORMAT('   FOR VAN DER WAERDEN TEST STATISTIC')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7345)CUT0
 7345   FORMAT(6X,'0          % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7346)CUT50
 7346   FORMAT(6X,'50         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7347)CUT75
 7347   FORMAT(6X,'75         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7348)CUT90
 7348   FORMAT(6X,'90         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7349)CUT95
 7349   FORMAT(6X,'95         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7350)CUT99
 7350   FORMAT(6X,'99         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7351)CUT999
 7351   FORMAT(6X,'99.9       % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7247)100.*STATCD,STATVA
 7247   FORMAT(6X,G15.7,'   % Point:  ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7261)
 7261   FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,7262)NUMDIS
 7262     FORMAT(6X,'THE ',I8,' SAMPLES COME FROM IDENTICAL ',
     1           'POPULATIONS.')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,7272)NUMDIS
 7272     FORMAT(6X,'THE ',I8,' SAMPLES DO NOT COME FROM IDENTICAL ',
     1           'POPULATIONS.')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
 7290   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7401)
 7401   FORMAT('PAIRWISE MULTIPLE COMPARISONS WRITTEN TO FILE ',
     1         'dpst1f.dat.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7403)
 7403   FORMAT('INDEX, DATA, RANKS, NORMAL SCORE OF RANKS, GROUP ',
     1         'AVERAGE OF')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7405)
 7405   FORMAT('NORMAL SCORES, GROUP SIZE WRITTEN TO FILE dpst2f.dat.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'VWA2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPVWA2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO9016I=1,N
          WRITE(ICOUT,9017)I,Y(I),TAG(I),ARANK(I),ANORM(I)
 9017     FORMAT('I,TAG(I),ARANK(I),ANORM(I) = ',I8,4G15.7)
          CALL DPWRST('XXX','WRIT')
 9016   CONTINUE
        DO9026I=1,NUMDIS
          WRITE(ICOUT,9027)I,AMEAN(I),NRANK(I)
 9027     FORMAT('I,AMEAN(I),NRANK(I) = ',I8,G15.7,I8)
          CALL DPWRST('XXX','WRIT')
 9026   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPWCCP(ICASPL,
     1YLOWER,YUPPER,IOUT,KMAXM1,PEROUT,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--WRITE CONCLUSIONS
C              FROM CORRELATION PLOT COMMANDS--
C                 1) AUTOCORRELATION PLOT
C                 2) CROSS-CORRELATION PLOT
C                 3) PARTIAL AUTOCORRELATION PLOT
C              OUT TO A FILE.
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 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      1982.
C     UPDATED         --FEBRUARY  1989.  FORMATS DUE TO 2X NOS LOWER CASE CHAR
C     UPDATED         --NOVEMBER  1989.  FIX IOUNIT=0 BUG (NELSON)
C     UPDATED         --FEBRUARY  1993.  PARTIAL AUTOCORRELATION PLOT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGS2
      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
CCCCC CHARACTER*4 IENDFI
CCCCC CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C-----COMMON----------------------------------------------------------
C
CCCCC INCLUDE 'DPCOHK.INC'
CCCCC INCLUDE 'DPCOFO.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='DPWC'
      ISUBN2='CP  '
C
      IERROR='NO'
C
CCCCC THE FOLLOWING LINE WAS FIXED NOVEMBER 1989
CCCCC IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WCCP')GOTO1199
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WCCP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWCCP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL
   52 FORMAT('ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)YLOWER,YUPPER
   53 FORMAT('YLOWER,YUPPER = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IOUT,KMAXM1,PEROUT
   54 FORMAT('IOUT,KMAXM1,PEROUT = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGS2,IFOUND,IERROR
   59 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICONNU
   61 FORMAT('ICONNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)ICONNA
   62 FORMAT('ICONNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ICONST
   63 FORMAT('ICONST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ICONFO
   64 FORMAT('ICONFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)ICONAC
   65 FORMAT('ICONAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICONFO
   66 FORMAT('ICONFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICONCS
   67 FORMAT('ICONCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ICONNU
      IFILE=ICONNA
      ISTAT=ICONST
      IFORM=ICONFO
      IACCES=ICONAC
      IPROT=ICONPR
      ICURST=ICONCS
C
      ISUBN0='WCCP'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WCCP')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 CONCLUSIONS FILE MAY EXIST  **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPWCCP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE CONCLUSIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE SENT TO FILE BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES SUCH CONCLUSIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,ICONST
 1217 FORMAT('ISTAT,ICONST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               ******************************************
C               **  STEP 30--                           **
C               **  BRANCH TO THE APPROPRIATE CASE      **
C               **  AND WRITE OUT          CONCLUSIONS  **
C               ******************************************
C
      ISTEPN='30'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'AUCO')GOTO3100
      IF(ICASPL.EQ.'CRCO')GOTO4100
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993
      IF(ICASPL.EQ.'PACO')GOTO5100
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3011)
 3011 FORMAT('***** INTERNAL ERROR IN DPWCCP ',
     1'AT BRANCH POINT 3011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3012)
 3012 FORMAT('      ICASPL SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3013)
 3013 FORMAT('      AUCO, CRCO, OR PACO, BUT IS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3014)ICASPL
 3014 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *********************************************
C               **  STEP 31--                            **
C               **  WRITE OUT          CONCLUSIONS       **
C               **  FOR AUTOCORRELATION PLOT ANALYSIS    **
C               *******************************************
C
 3100 CONTINUE
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,3101)ICONNU
 3101 FORMAT('ICONNU = ',I8)
      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3111)
 3111 FORMAT(
     *'Conclusion from autocorrelation',
     *' plot')
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3112)
 3112 FORMAT(
     *'      Under the null hypothesis',
     *' of white noise')
      WRITE(IOUNIT,3113)
 3113 FORMAT(
     *'      (and normality), a ',
     *'2-sided 95% confidence')
      WRITE(IOUNIT,3114)
 3114 FORMAT(
     *  '      interval for the ',
     *  'autocorrelation coefficient')
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3115)YLOWER,YUPPER
 3115 FORMAT('      ',F10.2,'      to ',F10.2)
C
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3116)
 3116 FORMAT(
     *'      Under this null hypothesis,',
     *' only 5')
      WRITE(IOUNIT,3117)
 3117 FORMAT(
     *'      average) of the ',
     *'computed autocorelations')
      WRITE(IOUNIT,3118)
 3118 FORMAT(
     *'      should fall outside ',
     *'of this interval')
C
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3121)
 3121 FORMAT(
     *'      For this data set, ',
     *'it is observed')
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3122)IOUT,KMAXM1,PEROUT
 3122 FORMAT('      ',I8,
     *'     out of the ',I8,' (= ',F7.2,'%)')
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3123)
 3123 FORMAT(
     *'      of the computed ',
     *'autocorrelation coefficients ',
     *'fall')
      WRITE(IOUNIT,3124)
 3124 FORMAT('      outside of this interval.')
C
      IF(PEROUT.LE.5.0)GOTO3130
      GOTO3140
C
 3130 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3131)
 3131 FORMAT(
     *'Conclusion--based on this ',
     *'autocorrelation')
      WRITE(IOUNIT,3132)
 3132 FORMAT(
     *'            plot test, ',
     *'there is no evidence from')
      WRITE(IOUNIT,3133)
 3133 FORMAT(
     *'            this data to reject',
     *' the hypothesis')
      WRITE(IOUNIT,3134)
 3134 FORMAT('            of randomness.')
      WRITE(IOUNIT,999)
      GOTO3190
C
 3140 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3141)
 3141 FORMAT(
     *'Conclusion--based ',
     *'on this autocorrelation')
      WRITE(IOUNIT,3142)
 3142 FORMAT(
     *'            plot test, ',
     *  'there is evidence from')
      WRITE(IOUNIT,3143)
 3143 FORMAT(
     *'            this data that ',
     *'the hypothesis')
      WRITE(IOUNIT,3144)
 3144 FORMAT('            of randomness should be')
      WRITE(IOUNIT,3145)
 3145 FORMAT('            rejected.')
      WRITE(IOUNIT,999)
      GOTO3190
C
 3190 CONTINUE
      GOTO9000
C
C               *******************************************
C               **  STEP 41--                            **
C               **  WRITE OUT          CONCLUSIONS       **
C               **  FOR CROSS-CORRELATION PLOT ANALYSIS  **
C               *******************************************
C
 4100 CONTINUE
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993
C               *******************************************
C               **  STEP 51--                            **
C               **  WRITE OUT          CONCLUSIONS       **
C               **  FOR PARTIAL AUTOCORRELATION PLOT ANALYSIS  **
C               *******************************************
C
 5100 CONTINUE
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WCCP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWCCP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL
 9012 FORMAT('ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)YLOWER,YUPPER
 9013 FORMAT('YLOWER,YUPPER = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IOUT,KMAXM1,PEROUT
 9014 FORMAT('IOUT,KMAXM1,PEROUT = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGS2,IFOUND,IERROR
 9019 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,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 ')
CCCCC WRITE(ICOUT,9028)IENDFI
C9028 FORMAT('IENDFI = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9029)IREWIN
C9029 FORMAT('IREWIN = ',A4)
CCCCC 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 ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWCPP(Y1,X1,N1,ICASPL,IDATSW,
     1CORR,DISPAR,NUMDIS,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--WRITE CONCLUSIONS
C              BASED ON ANALYSIS OF
C              PPCC PLOT (PROBABILITY PLOT CORRELATION
C              COEFFICIENT PLOT)
C              OUT TO A FILE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--JUNE      1982.
C     UPDATED         --JANUARY   1986.
C     UPDATED         --FEBRUARY  1989.  FORMATS DUE TO 2X NOS LOWER CASE CHAR
C     UPDATED         --MAY       1990.  EXIT FOR IG, WALD, RIG, FL
C     UPDATED         --DECEMBER  1993.  EXIT FOR POISSON, CHIS, GEOM,
C                                        GAMMA, EV, AND GP
C     UPDATED         --APRIL     1995.  EXIT FOR LOGNORMAL, POWER
C                                        NORMAL, POWER LOGNORMAL
C     UPDATED         --DECEMBER  1995.  EXIT FOR GENERALIZED LOGISTIC
C     UPDATED         --FEBRUARY  1996.  EXIT FOR BRADFORD
C     UPDATED         --MAY       1996.  EXIT FOR RECIPROCAL
C     UPDATED         --JANUARY   1998.  EXIT FOR VON MISES
C     UPDATED         --JANUARY   1998.  EXIT FOR INVERTED GAMMA
C     UPDATED         --AUGUST    2001.  EXIT FOR 2-PARAMETER DISTRIBUTIONS
C     UPDATED         --SEPTEMBER 2001.  EXIT FOR 4 ADDITIONAL
C                                        DISTRIBUTIONS
C     UPDATED         --NOVEMBER  2001.  EXIT FOR GEOM EXTR EXPO
C     UPDATED         --MAY       2002.  EXIT FOR TWO-SIDED POWER
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IDATSW
      CHARACTER*4 IBUGS2
      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
CCCCC CHARACTER*4 IENDFI
CCCCC CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
      DIMENSION CORR(*)
      DIMENSION DISPAR(*)
C
C-----COMMON----------------------------------------------------------
C
CCCCC INCLUDE 'DPCOHK.INC'
CCCCC INCLUDE 'DPCOFO.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='DPWC'
      ISUBN2='PP  '
C
      IERROR='NO'
C
      B1=(-999.0)
      EB1=(-999.0)
      SDB1=(-999.0)
      ZB1=(-999.0)
C
      B2=(-999.0)
      EB2=(-999.0)
      SDB2=(-999.0)
      ZB2=(-999.0)
C
      CORRMX=(-999.0)
      PARMX=(-999.0)
C
      CORRUN=(-999.0)
      CORRNO=(-999.0)
      RATIUN=(-999.0)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WCPP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWCPP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N1,ICASPL,IDATSW
   52 FORMAT('N1,ICASPL,IDATSW = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMDIS
   53 FORMAT('NUMDIS = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMDIS.LE.0.OR.NUMDIS.GE.500)GOTO59
      DO55I=1,NUMDIS
      WRITE(ICOUT,56)I,DISPAR(I),CORR(I)
   56 FORMAT('I,DISPAR(I),CORR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   59 CONTINUE
      WRITE(ICOUT,60)IBUGS2,ISUBRO,IFOUND,IERROR
   60 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICONNU
   61 FORMAT('ICONNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)ICONNA
   62 FORMAT('ICONNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ICONST
   63 FORMAT('ICONST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ICONFO
   64 FORMAT('ICONFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)ICONAC
   65 FORMAT('ICONAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICONFO
   66 FORMAT('ICONFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICONCS
   67 FORMAT('ICONCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ICONNU
      IFILE=ICONNA
      ISTAT=ICONST
      IFORM=ICONFO
      IACCES=ICONAC
      IPROT=ICONPR
      ICURST=ICONCS
C
      ISUBN0='WCPP'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WCPP')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 CONCLUSIONS FILE MAY EXIST  **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPWCPP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE CONCLUSIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE SENT TO FILE BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES SUCH CONCLUSIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,ICONST
 1217 FORMAT('ISTAT,ICONST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               ****************************************************************
C               **  STEP 20--
C               **  MAKE PRELIMINARY CALCULTIONS--
C               **  COMPUTE MEAN, S, BIASED S,
C               **  B1, AND B2.
C               **  COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION OF B1 AND
C               **  UNDER THE NORMALITY ASSUMPTION
C               **  REFERENCE--CRAMER, PAGE 386
C               ****************************************************************
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      N=N1
      AN=N
C
      SUM1=0.0
      DO2110I=1,N
      SUM1=SUM1+X1(I)
 2110 CONTINUE
      XBAR=SUM1/AN
C
      SUM2=0.0
      SUM3=0.0
      SUM4=0.0
      DO2120I=1,N
      DEL=X1(I)-XBAR
      A2=DEL*DEL
      A3=DEL*A2
      A4=A2*A2
      SUM2=SUM2+A2
      SUM3=SUM3+A3
      SUM4=SUM4+A4
 2120 CONTINUE
      AM2=SUM2/AN
      AM3=SUM3/AN
      AM4=SUM4/AN
      S=SQRT(SUM2/(AN-1.0))
      BS=SQRT(AM2)
      B1=AM3/(BS**3)
      B2=AM4/(BS**4)
C
      EB1=0.0
      SDB1=6.0*(AN-2.0)/((AN+1.0)*(AN+3.0))
      SDB1=SQRT(SDB1)
      ZB1=(B1-EB1)/SDB1
C
      EB2=3.0-6.0/(AN+1.0)
      SDB2=24.0*AN*(AN-2.0)*(AN-3.0)/((AN+1.0)*(AN+1.0)*(AN+3.0)*(AN+5.0
     1))
      ZB2=(B2-EB2)/SDB2
C
      CORRMX=CORR(1)
      PARMX=DISPAR(1)
      DO2130I=1,NUMDIS
      IF(CORR(I).GT.CORRMX)GOTO2131
      GOTO2130
 2131 CONTINUE
      CORRMX=CORR(I)
      PARMX=DISPAR(I)
 2130 CONTINUE
C
      IF(ICASPL.NE.'LACP')GOTO2149
      CORRUN=0.0
      CORRNO=1.0
      RATIUN=0.0
      DO2140I=1,NUMDIS
      IF(0.99.LE.DISPAR(I).AND.DISPAR(I).LE.1.01)CORRUN=CORR(I)
      IF(0.09.LE.DISPAR(I).AND.DISPAR(I).LE.0.11)CORRNO=CORR(I)
 2140 CONTINUE
      RATIUN=CORRUN/CORRNO
 2149 CONTINUE
C
C               *****************************************
C               **  STEP 30--                          **
C               **  BRANCH TO THE APPROPRIATE CASE     **
C               **  AND WRITE OUT        CONCLUSIONS   **
C               *****************************************
C
      ISTEPN='30'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3001)
 3001 FORMAT(
     *'Conclusion regarding ',
     *'distributional')
C
 3010 CONTINUE
      IF(-3.0.LE.ZB1.AND.ZB1.LE.3.0)GOTO3011
      GOTO3019
 3011 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3012)
 3012 FORMAT(
     *'      Based on the third ',
     *'central moment')
      WRITE(IOUNIT,3013)
 3013 FORMAT(
     *'      there is no evidence ',
     *'from this data')
      WRITE(IOUNIT,3014)
 3014 FORMAT(
     *'      to reject the ',
     *'hypothesis of symmetry')
      WRITE(IOUNIT,3015)
 3015 FORMAT(
     *'      In such case, ',
     *'parsimony dictates that the')
      WRITE(IOUNIT,3016)
 3016 FORMAT(
     *'      symmetric model be ',
     *'preferable over the')
      WRITE(IOUNIT,3017)
 3017 FORMAT(
     *  '      non-symmetric model.')
 3019 CONTINUE
C
 3020 CONTINUE
      IF(ZB1.LE.(-3.0).OR.ZB1.GT.3.0)GOTO3021
      GOTO3029
 3021 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3022)
 3022 FORMAT(
     *'      Based on the third ',
     *'central moment')
      WRITE(IOUNIT,3023)
 3023 FORMAT(
     *'      There is evidence ',
     *'from this data')
      WRITE(IOUNIT,3024)
 3024 FORMAT(
     *'      that the hypothesis of ',
     *  'symmetry')
      WRITE(IOUNIT,3025)
 3025 FORMAT('      should be rejected.')
 3029 CONTINUE
C
      IF(ICASPL.EQ.'LACP')GOTO3100
      IF(ICASPL.EQ.'TCP')GOTO3100
      IF(ICASPL.EQ.'WECP')GOTO4100
      IF(ICASPL.EQ.'E2CP')GOTO5100
CCCCC THE FOLLOWING 5 LINES WERE ADDED MAY 1990
      IF(ICASPL.EQ.'PACP')GOTO9000
      IF(ICASPL.EQ.'IGCP')GOTO9000
      IF(ICASPL.EQ.'WACP')GOTO9000
      IF(ICASPL.EQ.'RICP')GOTO9000
      IF(ICASPL.EQ.'FLCP')GOTO9000
CCCCC THE FOLLOWING 5 LINES WERE ADDED DECEMBER 1993  (ALAN)
      IF(ICASPL.EQ.'POCP')GOTO9000
      IF(ICASPL.EQ.'CSCP')GOTO9000
      IF(ICASPL.EQ.'GECP')GOTO9000
      IF(ICASPL.EQ.'GACP')GOTO9000
CCCCC THE FOLLOWING 2 LINES WERE ADDED     DECEMBER 1993
      IF(ICASPL.EQ.'EVCP')GOTO9000
      IF(ICASPL.EQ.'GPCP')GOTO9000
CCCCC THE FOLLOWING 3 LINES WERE ADDED     APRIL 1995
      IF(ICASPL.EQ.'LNCP')GOTO9000
      IF(ICASPL.EQ.'PNCP')GOTO9000
      IF(ICASPL.EQ.'PLCP')GOTO9000
      IF(ICASPL.EQ.'PFCP')GOTO9000
      IF(ICASPL.EQ.'CHCP')GOTO9000
      IF(ICASPL.EQ.'LLCP')GOTO9000
CCCCC THE FOLLOWING 6 LINES WERE ADDED     OCTOBER 1995
      IF(ICASPL.EQ.'LGCP')GOTO9000
      IF(ICASPL.EQ.'DWCP')GOTO9000
      IF(ICASPL.EQ.'GVCP')GOTO9000
      IF(ICASPL.EQ.'P2CP')GOTO9000
      IF(ICASPL.EQ.'HLCP')GOTO9000
      IF(ICASPL.EQ.'WCCP')GOTO9000
CCCCC THE FOLLOWING LINE WAS ADDED     DECEMBER 1995
      IF(ICASPL.EQ.'GLCP')GOTO9000
CCCCC THE FOLLOWING LINE WAS ADDED     FEBRUARY 1996
      IF(ICASPL.EQ.'DGCP')GOTO9000
      IF(ICASPL.EQ.'BRCP')GOTO9000
CCCCC THE FOLLOWING LINE WAS ADDED     MAY 1996
      IF(ICASPL.EQ.'RECP')GOTO9000
CCCCC THE FOLLOWING LINE WAS ADDED     JANUARY 1998
      IF(ICASPL.EQ.'VMCP')GOTO9000
CCCCC THE FOLLOWING LINE WAS ADDED     MAY 1998
      IF(ICASPL.EQ.'GICP')GOTO9000
      IF(ICASPL.EQ.'BECP')GOTO9000
      IF(ICASPL.EQ.'LDCP')GOTO9000
      IF(ICASPL.EQ.'GGCP')GOTO9000
      IF(ICASPL.EQ.'EWCP')GOTO9000
      IF(ICASPL.EQ.'GGCP')GOTO9000
      IF(ICASPL.EQ.'GOCP')GOTO9000
      IF(ICASPL.EQ.'EPCP')GOTO9000
      IF(ICASPL.EQ.'JBCP')GOTO9000
      IF(ICASPL.EQ.'JUCP')GOTO9000
      IF(ICASPL.EQ.'IWCP')GOTO9000
      IF(ICASPL.EQ.'LXCP')GOTO9000
      IF(ICASPL.EQ.'TRCP')GOTO9000
      IF(ICASPL.EQ.'EECP')GOTO9000
      IF(ICASPL.EQ.'ALCP')GOTO9000
      IF(ICASPL.EQ.'TSCP')GOTO9000
      IF(ICASPL.EQ.'ERCP')GOTO9000
      IF(ICASPL.EQ.'FTCP')GOTO9000
      IF(ICASPL.EQ.'SNCP')GOTO9000
      IF(ICASPL.EQ.'FCP')GOTO9000
      IF(ICASPL.EQ.'STCP')GOTO9000
      IF(ICASPL.EQ.'IBCP')GOTO9000
      IF(ICASPL.EQ.'LZCP')GOTO9000
      IF(ICASPL.EQ.'LTCP')GOTO9000
      IF(ICASPL.EQ.'GHCP')GOTO9000
      IF(ICASPL.EQ.'GZCP')GOTO9000
      IF(ICASPL.EQ.'GICP')GOTO9000
      IF(ICASPL.EQ.'GMCP')GOTO9000
      IF(ICASPL.EQ.'DLCP')GOTO9000
      IF(ICASPL.EQ.'FNCP')GOTO9000
      IF(ICASPL.EQ.'FCCP')GOTO9000
      IF(ICASPL.EQ.'NTCP')GOTO9000
      IF(ICASPL.EQ.'NYCP')GOTO9000
      IF(ICASPL.EQ.'NCCP')GOTO9000
      IF(ICASPL.EQ.'NXCP')GOTO9000
      IF(ICASPL.EQ.'PECP')GOTO9000
      IF(ICASPL.EQ.'TECP')GOTO9000
      IF(ICASPL.EQ.'TXCP')GOTO9000
      IF(ICASPL.EQ.'NBCP')GOTO9000
      IF(ICASPL.EQ.'NZCP')GOTO9000
      IF(ICASPL.EQ.'BBCP')GOTO9000
      IF(ICASPL.EQ.'BICP')GOTO9000
      IF(ICASPL.EQ.'PZCP')GOTO9000
      IF(ICASPL.EQ.'HYCP')GOTO9000
      IF(ICASPL.EQ.'HECP')GOTO9000
      IF(ICASPL.EQ.'YUCP')GOTO9000
      IF(ICASPL.EQ.'SDCP')GOTO9000
      IF(ICASPL.EQ.'ADCP')GOTO9000
      IF(ICASPL.EQ.'MXCP')GOTO9000
      IF(ICASPL.EQ.'MCCP')GOTO9000
      IF(ICASPL.EQ.'GMCP')GOTO9000
      IF(ICASPL.EQ.'G5CP')GOTO9000
      IF(ICASPL.EQ.'G2CP')GOTO9000
      IF(ICASPL.EQ.'G3CP')GOTO9000
      IF(ICASPL.EQ.'G4CP')GOTO9000
      IF(ICASPL.EQ.'BNCP')GOTO9000
      IF(ICASPL.EQ.'AXCP')GOTO9000
      IF(ICASPL.EQ.'BGCP')GOTO9000
      IF(ICASPL.EQ.'ZECP')GOTO9000
      IF(ICASPL.EQ.'ZICP')GOTO9000
      IF(ICASPL.EQ.'LPCP')GOTO9000
      IF(ICASPL.EQ.'LBCP')GOTO9000
      IF(ICASPL.EQ.'BTCP')GOTO9000
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3031)
 3031 FORMAT('***** INTERNAL ERROR IN DPWCPP ',
     1'AT BRANCH POINT 3031--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3032)
 3032 FORMAT('      ICASPL SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3033)
 3033 FORMAT('      LACP, TCP, WECP, E2CP,   ETC. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3034)
 3034 FORMAT('      BUT IS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3035)ICASPL
 3035 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *****************************************
C               **  STEP 31--                          **
C               **  WRITE OUT        CONCLUSIONS       **
C               **  FOR TUKEY OR T PPCC PLOT ANALYSIS  **
C               *****************************************
C
 3100 CONTINUE
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3201)
 3201 FORMAT(
     *'Conclusion regarding ',
     *'normality--')
C
 3210 CONTINUE
      IF(-3.0.LE.ZB2.AND.ZB2.LE.3.0)GOTO3211
      GOTO3219
 3211 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3212)
 3212 FORMAT(
     *'      Based on the fourth ',
     *'central moment')
      WRITE(IOUNIT,3213)
 3213 FORMAT(
     *'      there is no evidence ',
     *'from this data')
      WRITE(IOUNIT,3214)
 3214 FORMAT(
     *'      to reject the hypothesis ',
     *'of normality')
 3219 CONTINUE
C
 3220 CONTINUE
      IF(ZB2.LE.(-3.0).OR.ZB2.GT.3.0)GOTO3221
      GOTO3229
 3221 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3222)
 3222 FORMAT(
     *'      Based on the fourth ',
     *'central moment')
      WRITE(IOUNIT,3223)
 3223 FORMAT(
     *'      There is evidence ',
     *'from this data')
      WRITE(IOUNIT,3224)
 3224 FORMAT(
     *'      that the hypothesis ',
     *'of normality')
      WRITE(IOUNIT,3225)
 3225 FORMAT('      should be rejected.')
 3229 CONTINUE
C
 3230 CONTINUE
      IF(0.0.LE.PARMX.AND.PARMX.LE.0.3)GOTO3231
      GOTO3239
 3231 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3232)
 3232 FORMAT(
     *'      Based on the probability ',
     *'plot')
      WRITE(IOUNIT,3233)
 3233 FORMAT(
     *'      correlation coefficient ',
     *'analysis')
      WRITE(IOUNIT,3234)
 3234 FORMAT(
     *'      indications are that ',
     *'the normal')
      WRITE(IOUNIT,3235)
 3235 FORMAT(
     *'      provides a near-optimal ',
     *'fit among')
      IF(ICASPL.EQ.'LACP')WRITE(IOUNIT,3236)
 3236 FORMAT(
     *'      various members of ',
     *'the Tukey lambda')
      IF(ICASPL.EQ.'TCP')WRITE(IOUNIT,3237)
 3237 FORMAT(
     *'      various members of the t')
      WRITE(IOUNIT,3238)
 3238 FORMAT('      distribution family.')
 3239 CONTINUE
C
 3240 CONTINUE
      IF(0.0.LE.PARMX.AND.PARMX.LE.0.3.AND.
     1RATIUN.GE.0.95)GOTO3241
      GOTO3249
 3241 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,3242)
 3242 FORMAT(
     *'      However, there is ',
     *'also evidence')
      WRITE(IOUNIT,3243)
 3243 FORMAT(
     *'      that many distributions ',
     *'shorter-')
      WRITE(IOUNIT,3244)
 3244 FORMAT(
     *'      tailed than normal ',
     *'(e.g., uniform)')
      WRITE(IOUNIT,3245)
 3245 FORMAT(
     *'      would serve-equally-well ',
     *  'as a')
      WRITE(IOUNIT,3246)
 3246 FORMAT('      distributional model.')
 3249 CONTINUE
      GOTO7900
C
C               **************************************
C               **  STEP 41--                       **
C               **  WRITE OUT EXPERT CONCLUSIONS    **
C               **  FOR WEIBULL PPCC PLOT ANALYSIS  **
C               **************************************
C
 4100 CONTINUE
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      GOTO7900
C
C               ***************************************************
C               **  STEP 51--                                    **
C               **  WRITE OUT EXPERT CONCLUSIONS                 **
C               **  FOR EXTREME VALUE TYPE 2 PPCC PLOT ANALYSIS  **
C               ***************************************************
C
 5100 CONTINUE
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,5101)
 5101 FORMAT(
     *'Conclusion regarding extreme ',
     *'value')
C
 5110 CONTINUE
      IF(PARMX.GT.20.0)GOTO5111
      GOTO5119
 5111 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,5112)
 5112 FORMAT(
     *'      Based on the ',
     *'probability plot')
      WRITE(IOUNIT,5113)
 5113 FORMAT(
     *'      correlation coefficient ',
     *'analysis')
      WRITE(IOUNIT,5114)
 5114 FORMAT(
     *'      indications are ',
     *'that the  ')
      WRITE(IOUNIT,5115)
 5115 FORMAT(
     *'      extreme value type ',
     *'1 distribution')
      WRITE(IOUNIT,5116)
 5116 FORMAT(
     *'      provides a near-optimal ',
     *'fit among')
      WRITE(IOUNIT,5117)
 5117 FORMAT(
     *'      various members of the ',
     *'extreme value')
      WRITE(IOUNIT,5118)
 5118 FORMAT('      distribution family.')
 5119 CONTINUE
C
      GOTO7900
C
C               **************************************************
C               **  STEP 79--                                   **
C               **  IF APPROPRIATE, PRINT OUT A COMMENT         **
C               **  REGARDING THE SMALLESS OF THE SAMPLE SIZE.  **
C               **************************************************
C
 7900 CONTINUE
      ISTEPN='79'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WCPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.30)GOTO7951
      GOTO7959
 7951 CONTINUE
      WRITE(IOUNIT,999)
      WRITE(IOUNIT,7952)
 7952 FORMAT(
     *'      Caution must be ',
     *'exercised in')
      WRITE(IOUNIT,7953)
 7953 FORMAT(
     *'      this distributional-modeling',
     *' problem')
      WRITE(IOUNIT,7954)
 7954 FORMAT(
     *'      due to the relatively ',
     *'small number')
      WRITE(IOUNIT,7955)
 7955 FORMAT('      of data points.')
 7959 CONTINUE
      WRITE(IOUNIT,999)
C
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WCPP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWCPP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N1,ICASPL,IDATSW
 9012 FORMAT('N1,ICASPL,IDATSW = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMDIS
 9013 FORMAT('NUMDIS = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMDIS.LE.0.OR.NUMDIS.GE.500)GOTO9019
      DO9015I=1,NUMDIS
      WRITE(ICOUT,9016)I,DISPAR(I),CORR(I)
 9016 FORMAT('I,DISPAR(I),CORR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9022)N,AN
 9022 FORMAT('N,AN = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)XBAR,S,BS
 9023 FORMAT('XBAR,S,BS = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)B1,EB1,SDB1,ZB1
 9024 FORMAT('B1,EB1,SDB1,ZB1 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)B2,EB2,SDB2,ZB2
 9025 FORMAT('B2,EB2,SDB2,ZB2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)CORRMX,PARMX
 9026 FORMAT('CORRMX,PARMX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)CORRUN,CORRNO,RATIUN
 9027 FORMAT('CORRUN,CORRNO,RATIUN = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGS2,ISUBRO,IFOUND,IERROR
 9029 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IOUNIT
 9031 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IFILE
 9032 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)ISTAT
 9033 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IFORM
 9034 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IACCES
 9035 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IPROT
 9036 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)ICURST
 9037 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9038)IENDFI
C9038 FORMAT('IENDFI = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9039)IREWIN
C9039 FORMAT('IREWIN = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)ISUBN0
 9041 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IERRFI
 9042 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWDST(IWD1,IWD12,ISHIFT,IWD2,IWD22,IANS,IWIDTH,
     1IANS2,N2,IBUGA3,IERROR)
C
C     PURPOSE--GIVEN THAT WE HAVE THE PAIR OF A4 WORDS
C              (IWD1 AND IWD2)
C              IN IHARG(.) THAT ARE    ISHIFT    APART
C              (ISHIFT = 0, 1, 2, ...),
C              FIND THE CORRESPONDING A1 HOLLERITH STRING
C              FOR THE SECOND WORD (IWD2);
C              INCLUDE ALSO ANY CONTINUATIONS
C              OF THE SECOND WORD.
C     NOTE--THIS SUBROUTINE IS USEFUL IN THE CONVERSION
C           OF A WORD (AND ITS CONTINUATION)
C           INTO A CONSTANT OR AN ELEMENT OF A VECTOR.
C     NOTE--VALID VALUES OF ISHIFT FOR THIS SUBROUTINE
C           ARE 0 AND THE POSITIVE INTEGERS.
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 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  1979.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IWD1
      CHARACTER*4 IWD12
      CHARACTER*4 IWD2
      CHARACTER*4 IWD22
      CHARACTER*4 IANS
      CHARACTER*4 IANS2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICH1
      CHARACTER*4 ICH11
      CHARACTER*4 ICH12
      CHARACTER*4 ICH2
      CHARACTER*4 ICH21
      CHARACTER*4 ICH22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
      DIMENSION IANS2(*)
C
      DIMENSION ICH11(10)
      DIMENSION ICH12(10)
      DIMENSION ICH1(20)
      DIMENSION ICH21(10)
      DIMENSION ICH22(10)
      DIMENSION ICH2(20)
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 MAXPAS/100/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPWD'
      ISUBN2='ST  '
C
      NUMASC=4
      NUMAS2=2*NUMASC
C
      IPOS1=0
      IPOS2=0
      I2=0
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWDST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IWD1,IWD12,ISHIFT,IWD2,IWD22
   52 FORMAT('IWD1,IWD12,ISHIFT,IWD2,IWD22 = ',A4,A4,2X,I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IANS(I),I=1,IWIDTH)
   54 FORMAT('IANS(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGA3
   55 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
C
C               ************************************
C               **  STEP 2--                      **
C               **  DETERMINE THE A1-EQUIVALENT   **
C               **  OF THE A4-WORD IWD1.          **
C               **  DETERMINE THE A1-EQUIVALENT   **
C               **  OF THE A4-WORD IWD2.          **
C               ************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPXH1H(IWD1,ICH11,IEND11,IBUGA3)
      CALL DPXH1H(IWD12,ICH12,IEND12,IBUGA3)
      DO205K=1,NUMAS2
      ICH1(K)=' '
  205 CONTINUE
      L=0
      DO206K=1,NUMASC
      L=L+1
      ICH1(L)=ICH11(K)
  206 CONTINUE
      DO207K=1,NUMASC
      L=L+1
      ICH1(L)=ICH12(K)
  207 CONTINUE
      IEND1=0
      IF(IEND11.GE.1)IEND1=IEND11
      IF(IEND11.GE.NUMASC)IEND1=NUMASC
      IF(IEND12.GE.1)IEND1=NUMASC+IEND12
      IF(IEND12.GE.NUMAS2)IEND1=NUMAS2
C
      CALL DPXH1H(IWD2,ICH21,IEND21,IBUGA3)
      CALL DPXH1H(IWD22,ICH22,IEND22,IBUGA3)
      DO605K=1,NUMAS2
      ICH2(K)=' '
  605 CONTINUE
      L=0
      DO606K=1,NUMASC
      L=L+1
      ICH2(L)=ICH21(K)
  606 CONTINUE
      DO607K=1,NUMASC
      L=L+1
      ICH2(L)=ICH22(K)
  607 CONTINUE
      IEND2=0
      IF(IEND21.GE.1)IEND2=IEND21
      IF(IEND21.GE.NUMASC)IEND2=NUMASC
      IF(IEND22.GE.1)IEND2=NUMASC+IEND21
      IF(IEND22.GE.NUMAS2)IEND2=NUMAS2
C
C               ******************************************
C               **  STEP 3--                            **
C               **  SET UP A LARGE LOOP--               **
C               **  MAKE AT MOST 100 PASSES AT IANS(.)  **
C               **  TO SEARCH FOR IWD1                  **
C               **  AND FOLLOWED (ISHIFT WORDS LATER)   **
C               **  BY IWD2.                            **
C               ******************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMINCO=1
      DO1000IPASS=1,MAXPAS
C
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,1091)IMINCO
 1091 FORMAT('IMINCO = ',I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               **************************************
C               **  STEP 4--                        **
C               **  LOCATE THE POSITION IN IANS(.)  **
C               **  OF THE FIRST LETTER OF THE      **
C               **  A1-EQUIVALENT OF IWD1.          **
C               **  STORE THIS POSITION IN IPOS1.   **
C               **************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO410I=IMINCO,IWIDTH
      DO420J=1,IEND1
      K=I+J-1
      IF(K.GT.IWIDTH)GOTO430
      IF(IANS(K).NE.ICH1(J))GOTO410
  420 CONTINUE
      KP1=K+1
      IF(KP1.GT.IWIDTH)GOTO430
      IF(IEND1.NE.NUMCPW.AND.IANS(KP1).NE.' ')GOTO410
      IPOS1=I
      GOTO490
  410 CONTINUE
  430 CONTINUE
C
      WRITE(ICOUT,431)
  431 FORMAT('***** INTERNAL ERROR IN DPWDST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,432)IWD1,IWD12
  432 FORMAT('      1H REPRESENTATION FOR    ',A4,A4,
     1'   NOT FOUND.')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,433)(IANS(I),I=1,IWIDTH)
  433 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  490 CONTINUE
C
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,491)IPOS1,K
  491 FORMAT('IPOS1,K = ',I8,I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               **************************************
C               **  STEP 5--                        **
C               **  LOCATE THE POSITION IN IANS(.)  **
C               **  OF THE FIRST LETTER OF THE      **
C               **  A1-EQUIVALENT OF THE WORD       **
C               **  ISHIFT    WORDS TO THE RIGHT    **
C               **  OF IWD1.                        **
C               **  THIS SHOULD CORRESPOND TO       **
C               **  THE WORD FOUND IN IWD2.         **
C               **  STORE THIS POSITION IN IPOS2.   **
C               **************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMIN=IPOS1
      IPOS2=IMIN
      IF(ISHIFT.LE.0)GOTO590
      DO510K=1,ISHIFT
      DO520I=IMIN,IWIDTH
      I2=I
      IF(IANS(I).EQ.' ')GOTO529
      IF(IANS(IMIN).NE.'='.AND.IANS(I).EQ.'=')GOTO525
      IF(IANS(IMIN).EQ.'='.AND.IANS(I).NE.'=')GOTO525
  520 CONTINUE
      GOTO580
  525 CONTINUE
      IMIN=I2
      IPOS2=IMIN
      GOTO510
  529 CONTINUE
      DO530J=I2,IWIDTH
      J2=J
      IF(IANS(J).NE.' ')GOTO539
  530 CONTINUE
      GOTO580
  539 CONTINUE
      IMIN=J2
      IPOS2=IMIN
  510 CONTINUE
      GOTO590
C
  580 CONTINUE
      WRITE(ICOUT,581)
  581 FORMAT('***** INTERNAL ERROR IN DPWDST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)ISHIFT
  582 FORMAT('      1H REPRESENTATION FOR WORD SHIFTED ',I8,
     1' WORDS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)IWD1,IWD12
  583 FORMAT('      TO THE RIGHT OF ',A4,A4,' NOT FOUND.')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,586)(IANS(I),I=1,IWIDTH)
  586 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  590 CONTINUE
C
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,591)IPOS2,I2
  591 FORMAT('IPOS2,I2 = ',I8,I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ************************************************
C               **  STEP 6--                                  **
C               **  EXTRACT THE CHARACTER STRING IN IANS(.)   **
C               **  STARTING WITH POSITION IPOS2              **
C               **  AND STOPPING WITH (BUT NOT INCLUDING)     **
C               **  THE FIRST BLANK CHARACTER.                **
C               **  STORE SUCH A STRING IN IANS2(.).          **
C               **  STORE THE LENGTH OF SUCH A STRING IN N2.  **
C               ************************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      DO610I=IPOS2,IWIDTH
      IF(IANS(I).EQ.' ')GOTO620
      J=J+1
      IANS2(J)=IANS(I)
  610 CONTINUE
  620 CONTINUE
      N2=J
      IF(N2.GE.1)GOTO629
      WRITE(ICOUT,621)
  621 FORMAT('***** INTERNAL ERROR IN DPWDST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,622)
  622 FORMAT('      LENGTH N2 OF OUTPUT STRING = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,623)
  623 FORMAT('      FOR 1H REPRESENTATION OF WORD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,624)ISHIFT
  624 FORMAT('      SHIFTED ',I8,' WORDS TO THE RIGHT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,625)IWD1,IWD12
  625 FORMAT('OF ',A4,A4,'   .')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,626)(IANS(I),I=1,IWIDTH)
  626 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  629 CONTINUE
C
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,691)N2
  691 FORMAT('N2 = ',I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,692)(IANS2(I),I=1,N2)
  692 FORMAT('IANS2(.) = ',100A1)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ****************************************
C               **  STEP 7--                          **
C               **  AS A FINAL CHECK,                 **
C               **  COMPARE THE A1-EQUIVALENT         **
C               **  OF THE A4-WORD IWD2               **
C               **  WITH THE CONTENTS                 **
C               **  OF IANS2(.)--THE FIRST IEND2      **
C               **  CHARACTERS SHOULD BE IDENTICAL.   **
C               **  IF NOT, THEN MAKE ANOTHER         **
C               **  PASS FURTHER DOWN IANS(.)         **
C               **  TO SEARCH FOR                     **
C               **  THE PAIR (IWWD1 AND IWD2)         **
C               **  AT THE SPECIFIED                  **
C               **  ISHIFT   WORDS APART.             **
C               ****************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N2.GE.IEND2)GOTO709
      GOTO719
  709 CONTINUE
C
      DO710I=1,IEND2
      IF(ICH2(I).NE.IANS2(I))GOTO719
  710 CONTINUE
      GOTO9000
  719 CONTINUE
C
      IMINCO=IPOS1+1
      IF(IMINCO.LE.IWIDTH)GOTO1000
      GOTO1100
 1000 CONTINUE
C
 1100 CONTINUE
      WRITE(ICOUT,1101)
 1101 FORMAT('***** INTERNAL ERROR IN DPWDST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)IWD1,IWD12,IWD2,IWD22
 1102 FORMAT('      1H REPRESENTATION FOR    ',A4,A4,' AND ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)ISHIFT
 1103 FORMAT('      (',I8,' WORDS APART) NOT FOUND.')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1106)(IANS(I),I=1,IWIDTH)
 1106 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWDST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IEND1,IEND2,IPOS1,IPOS2
 9012 FORMAT('IEND1,IEND2,IPOS1,IPOS2 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N2
 9013 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(IANS2(I),I=1,N2)
 9014 FORMAT('IANS2(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IERROR
 9015 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)NUMASC,NUMAS2
 9019 FORMAT('NUMASC,NUMAS2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IEND11,IEND12,IEND1,IEND21,IEND22,IEND2
 9020 FORMAT('IEND11,IEND12,IEND1,IEND21,IEND22,IEND2 = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)(ICH11(I),I=1,10)
 9021 FORMAT('(ICH11(I),I=1,10) = ',10A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)(ICH12(I),I=1,10)
 9022 FORMAT('(ICH12(I),I=1,10) = ',10A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)(ICH1 (I),I=1,10)
 9023 FORMAT('(ICH1 (I),I=1,10) = ',10A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)(ICH21(I),I=1,10)
 9024 FORMAT('(ICH21(I),I=1,10) = ',10A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)(ICH22(I),I=1,10)
 9025 FORMAT('(ICH22(I),I=1,10) = ',10A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)(ICH2 (I),I=1,10)
 9026 FORMAT('(ICH2 (I),I=1,10) = ',10A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWEAR(IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ADJUSTED RANKS
C              FOR DATA IN PREPARATION
C              WITH A WEIBULL PLOT ANALYSIS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --JUNE      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IWRITE
      CHARACTER*4 IHARG3
      CHARACTER*4 IHARG4
      CHARACTER*4 IHARG5
      CHARACTER*4 IHARG6
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
      CHARACTER*4 IRIGHT
      CHARACTER*4 IRIGH2
      CHARACTER*4 IHSET
      CHARACTER*4 IHSET2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP(MAXOBV)
      DIMENSION TEMP2(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR44),TEMP(1))
      EQUIVALENCE (G2RBAG(IGAR45),TEMP2(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
      ISUBN1='DPWE'
      ISUBN2='AR  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
C
      NS2=0
      NS3=0
C
      NIISUB=(-999)
      ICOLL=(-999)
C
      IRIGHT='-999'
      IRIGH2='-999'
      ILOCV=(-999)
      NUMVAR=(-999)
      ICOLR=(-999)
      NIRIGH=(-999)
      ICOL2=(-999)
      NIRIG2=(-999)
      ILOCSV=(-999)
C
      NLEFT=(-999)
C
C               ***********************************************
C               **  TREAT THE WEIBULL ADJUSTED RANKS CASE  **
C               **       1) FOR A FULL VARIABLE, OR          **
C               **       2) FOR PART OF A VARIABLE.          **
C               ***********************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGQ
   52 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
      NEWCOL='NO'
C
C               ****************************************************************
C               **  STEP 2--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE VARIABLE NAME TO LEFT OF = SIGN                     *
C               **  ALREADY IN THE NAME LIST?    AS A VARIABLE?                *
C               **  NOTE THAT     ILEFT     IS THE NAME OF THE VARIABLE        *
C               **  ON THE LEFT.                                               *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               **  NOTE THAT     ICOLL    IS THE DATA COLUMN (1 TO 12)        *
C               **  FOR THE NAME OF THE LEFT.                                  *
C               ****************************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILEFT=IHARG(1)
      ILEFT2=IHARG2(1)
      DO200I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO230
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO280
  200 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO220
      GOTO235
  220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,221)
  221 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,222)
  222 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,223)MAXNAM
  223 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,224)
  224 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,225)
  225 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,226)
  226 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,227)
  227 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,228)
  228 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  230 CONTINUE
      ILISTL=I2
      GOTO235
C
  235 CONTINUE
      NIOLD=0
      ICOLL=NUMCOL+1
      IF(ICOLL.GT.MAXCOL)GOTO240
      GOTO290
  240 CONTINUE
      WRITE(ICOUT,241)
  241 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,242)
  242 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,243)MAXCOL
  243 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,244)
  244 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,245)
  245 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,246)
  246 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,247)
  247 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,248)
  248 FORMAT('      IF       LET X(I) = 3.14         FAILED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,249)
  249 FORMAT('      THEN ONE MIGHT ENTER     LET X = COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,250)
  250 FORMAT('      (THEREBY EQUATING THE NAME X WITH COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,251)
  251 FORMAT('      FOLLOWED BY              LET X(I) = 3.14')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,252)
  252 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,253)
  253 FORMAT('      WITH THE NUMERIC CONSTANTS 3.14)')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  280 CONTINUE
      ILISTL=I2
      ICOLL=IVALUE(ILISTL)
      NIOLD=IN(ILISTL)
  290 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO299
      WRITE(ICOUT,291)
  291 FORMAT('AT THE END OF STEP 2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,292)ILEFT,ILEFT2,NEWNAM,NUMNAM,ILISTL,NUMCOL,ICOLL,
     1NIOLD
  292 FORMAT('ILEFT,ILEFT2,NEWNAM,NUMNAM,ILISTL,NUMCOL,ICOLL,',
     1'NIOLD = ',A4,A4,2X,A4,2X,5I8)
      CALL DPWRST('XXX','BUG ')
  299 CONTINUE
C
C               ****************************************************************
C               **  STEP 3--                                                   *
C               **  EXAMINE THE RIGHT-HAND SIDE--                              *
C               **  HAS THE VARIABLE OR COLUMN ON THE RIGHT                    *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISTR    IS THE LINE IN THE TABLE           *
C               **  OF THE VARIABLE OR COLUMN ON THE RIGHT.                    *
C               **  NOTE THAT     ICOLR    IS THE DATA COLUMN (1 TO 12)        *
C               **  FOR THE VARIABLE OR COLUMN ON THE RIGHT.                   *
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 4--                              **
C               **  BRANCH BETWEEN 1-VARIABLE SPECIFICATION  **
C               **  (LET Y = WEIBULL ADJUSTED RANKS X)       **
C               **  AND 2-VARIABLE SPECIFICATION             **
C               **  (LET Y = WEIBULL ADJUSTED RANKS X TAG)   **
C               ********************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCV=6
C
      NUMVAR=1
      ILOCVP=ILOCV+1
      IF(ILOCVP.GT.NUMARG)GOTO1000
      IHARG5=IHARG(ILOCVP)
      IHARG6=IHARG2(ILOCVP)
      IF(IHARG5.EQ.'SUBS'.AND.IHARG6.EQ.'ET  ')GOTO1000
      IF(IHARG5.EQ.'EXCE'.AND.IHARG6.EQ.'PT  ')GOTO1000
      IF(IHARG5.EQ.'FOR '.AND.IHARG6.EQ.'    ')GOTO1000
      NUMVAR=2
      GOTO2000
C
C               ***************************************
C               **  STEP 5--                         **
C               **  TREAT THE 1-VARIABLE SPECIFICATIONS  **
C               ***************************************
C
 1000 CONTINUE
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=1
C
      IRIGHT=IHARG(ILOCV)
      IRIGH2=IHARG2(ILOCV)
      DO1100I=1,NUMNAM
      I2=I
      IF(IRIGHT.EQ.IHNAME(I).AND.IRIGH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1900
      IF(IRIGHT.EQ.IHNAME(I).AND.IRIGH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1150
 1100 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1101)
 1101 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)
 1102 FORMAT('      THE SPECIFIED ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)
 1103 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1104)
 1104 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1105)
 1105 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1106)
 1106 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1107)IRIGHT,IRIGH2
 1107 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1108)
 1108 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1109)(IANS(I),I=1,IWIDTH)
 1109 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 1150 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      THE SPECIFIED ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)
 1154 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)
 1156 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1157)
 1157 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1158)
 1158 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1159)(IANS(I),I=1,IWIDTH)
 1159 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 1900 CONTINUE
      ILISTR=I2
      ICOLR=IVALUE(ILISTR)
      NIRIGH=IN(ILISTR)
      GOTO7000
C
C               ************************************************
C               **  STEP 6.2--                                **
C               **  TREAT THE 2 VARIABLE SPECIFICATION.                **
C               **  CHECK THE VALIDITY OF THE FIRST ARGUMENT  **
C               ************************************************
C
 2000 CONTINUE
C
      ISTEPN='6.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=2
C
      IHARG3=IHARG(ILOCV)
      IHARG4=IHARG2(ILOCV)
      DO2210I=1,NUMNAM
      I2=I
      IF(IHARG3.EQ.IHNAME(I).AND.IHARG4.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO2290
      IF(IHARG3.EQ.IHNAME(I).AND.IHARG4.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO2220
 2210 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE SPECIFIED FIRST  ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)
 2216 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)IHARG3,IHARG4
 2217 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2218)
 2218 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2219)(IANS(I),I=1,IWIDTH)
 2219 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2220 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2221)
 2221 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2222)
 2222 FORMAT('      THE SPECIFIED FIRST  ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2223)
 2223 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2224)
 2224 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2225)
 2225 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2226)
 2226 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2227)
 2227 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2228)IHARG3,IHARG4
 2228 FORMAT('      THE ARGUMENT IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2229)
 2229 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2230)(IANS(I),I=1,IWIDTH)
 2230 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2290 CONTINUE
C
      ILISTR=I2
      ICOLR=IVALUE(ILISTR)
      NIRIGH=IN(ILISTR)
C
C               *****************************************************
C               **  STEP 6.3--                                     **
C               **  CHECK THE VALIDITY OF THE SECOND ARGUMENT      **
C               *****************************************************
C
 2300 CONTINUE
C
      ISTEPN='6.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCVP=ILOCV+1
      IF(ILOCVP.LE.NUMARG)GOTO2309
C
      WRITE(ICOUT,2301)
 2301 FORMAT('***** ERROR IN DPWEAR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2302)
 2302 FORMAT('      NO SECOND VARIABLE NAME OR COLUMN NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2303)
 2303 FORMAT('      WAS GIVEN AFTER THE OPERATION ',
     1'CALCULATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2304)
 2304 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2305)(IANS(I),I=1,IWIDTH)
 2305 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2309 CONTINUE
C
      IHARG5=IHARG(ILOCVP)
      IHARG6=IHARG2(ILOCVP)
      DO2310I=1,NUMNAM
      I2=I
      IF(IHARG5.EQ.IHNAME(I).AND.IHARG6.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO2390
      IF(IHARG5.EQ.IHNAME(I).AND.IHARG6.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO2320
 2310 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      THE SPECIFIED SECOND ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2313)
 2313 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)
 2315 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2317)IHARG5,IHARG6
 2317 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2318)
 2318 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2319)(IANS(I),I=1,IWIDTH)
 2319 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2320 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2321)
 2321 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2322)
 2322 FORMAT('      THE SPECIFIED SECOND ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2323)
 2323 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2324)
 2324 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2325)
 2325 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2326)
 2326 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2327)
 2327 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2328)IHARG5,IHARG6
 2328 FORMAT('      THE ARGUMENT IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2329)
 2329 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2330)(IANS(I),I=1,IWIDTH)
 2330 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2390 CONTINUE
C
      ILIST2=I2
      ICOL2=IVALUE(ILIST2)
      NIRIG2=IN(ILIST2)
C
C               ******************************************************
C               **  STEP 6.4--                                      **
C               **  CHECK THAT THE 2 VARIABLES HAVE THE SAME        **
C               **  NUMBER OF ELEMENTS.                             **
C               ******************************************************
C
      ISTEPN='6.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NIRIG2.EQ.NIRIGH)GOTO2490
C
      WRITE(ICOUT,2411)
 2411 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2412)
 2412 FORMAT('      FOR A 2-VARIABLE MATHEMATICAL OPERATION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2413)
 2413 FORMAT('      THE NUMBER OF OBSERVATIONS IN EACH VARIABLE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2414)
 2414 FORMAT('      MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2415)
 2415 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2416)IHARG3,IHARG4,NIRIGH
 2416 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2417)IHARG5,IHARG6,NIRIG2
 2417 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2418)
 2418 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2419)(IANS(I),I=1,IWIDTH)
 2419 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2490 CONTINUE
      GOTO7000
C
C               *******************************
C               **  STEP 7--                 **
C               **  DETERMINE THE SUBCASE    **
C               **  AND BRANCH ACCORDINGLY.  **
C               *******************************
C
 7000 CONTINUE
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,7006)NINEW,NIRIGH,NIRIG2,NUMVAR
 7006 FORMAT('NINEW,NIRIGH,NIRIG2,NUMVAR = ',4I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(NUMVAR.EQ.1)GOTO7001
      IF(NUMVAR.EQ.2)GOTO7002
C
 7001 CONTINUE
      IF(ILOCV.EQ.NUMARG)GOTO8000
      ILOCVP=ILOCV+1
      IF(ILOCV.LT.NUMARG.AND.IHARG(ILOCVP).EQ.'SUBS'.AND.
     1IHARG2(ILOCVP).EQ.'ET  ')GOTO9000
      IF(ILOCV.LT.NUMARG.AND.IHARG(ILOCVP).EQ.'EXCE'.AND.
     1IHARG2(ILOCVP).EQ.'PT  ')GOTO9000
      IF(ILOCV.LT.NUMARG.AND.IHARG(ILOCVP).EQ.'FOR '.AND.
     1IHARG2(ILOCVP).EQ.'    ')GOTO10000
      GOTO7010
C
 7002 CONTINUE
      ILOCVP=ILOCV+1
      IF(ILOCVP.EQ.NUMARG)GOTO8000
      ILOCV2=ILOCV+2
      IF(ILOCVP.LT.NUMARG.AND.IHARG(ILOCV2).EQ.'SUBS'.AND.
     1IHARG2(ILOCV2).EQ.'ET  ')GOTO9000
      IF(ILOCVP.LT.NUMARG.AND.IHARG(ILOCV2).EQ.'EXCE'.AND.
     1IHARG2(ILOCV2).EQ.'PT  ')GOTO9000
      IF(ILOCVP.LT.NUMARG.AND.IHARG(ILOCV2).EQ.'FOR '.AND.
     1IHARG2(ILOCV2).EQ.'    ')GOTO10000
      GOTO7010
C
 7010 CONTINUE
      WRITE(ICOUT,7011)
 7011 FORMAT('***** ERROR IN DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7012)
 7012 FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7018)
 7018 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7019)(IANS(I),I=1,IWIDTH)
 7019 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
C               ************************************************
C               **  STEP 8--                                  **
C               **  TREAT THE FULL VARIABLE CASE.             **
C               **  EXAMPLE--LET Y = WEIBULL ADJUSTED RANKS X                  *
C               **  THEN JUMP TO STEP NUMBER 10 BELOW         **
C               **  FOR THE LIST UPDATING AND                 **
C               **  FOR SOME INFORMATIVE PRINTING.            **
C               ************************************************
C
 8000 CONTINUE
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,8011)NINEW,NIRIGH,NUMVAR
 8011 FORMAT('NINEW,NIRIGH,NUMVAR = ',3I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      ICASEQ='FULL'
      NIOLD=NIRIGH
      IF(NUMVAR.GE.2.AND.NIRIG2.GT.NIOLD)NIOLD=NIRIG2
      NINEW=NIOLD
      DO8100I=1,NINEW
      ISUB(I)=1
 8100 CONTINUE
      NIISUB=NIOLD
      GOTO11000
C
C               ****************************************************************
C               **  STEP 9--                                                   *
C               **  TREAT THE PARTIAL VARIABLE SUBSET CASE.                    *
C               **  EXAMPLE--LET Y = WEIBULL ADJUSTED RANKS X     SUBSET 2 3 5
C               **  JUMP TO STEP NUMBER 11 BELOW                               *
C               **  FOR THE ACTUAL MATHEMATICAL OPERATION,                    *
C               **  FOR THE LIST UPDATING, AND                                 *
C               **  FOR SOME INFORMATIVE PRINTING.                             *
C               ****************************************************************
C
19000 CONTINUE
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='SUBS'
      IF(NUMVAR.EQ.1)ILOCSV=ILOCV+2
      IF(NUMVAR.EQ.2)ILOCSV=ILOCV+3
      IHSET=IHARG(ILOCSV)
      IHSET2=IHARG2(ILOCSV)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      NIOLD=IN(ILOC)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
CCCCC NINEW=NS
      NINEW=NIOLD
      NIISUB=NIOLD
      GOTO11000
C
C               ****************************************************************
C               **  STEP 10--                                                  *
C               **  TREAT THE PARTIAL VARIABLE FOR CASE.                       *
C               **  EXAMPLE--LET Y = WEIBULL ADJUSTED RANKS X     FOR I = 1 2 10
C               **  JUMP TO STEP NUMBER 11 BELOW                               *
C               **  FOR THE ACTUAL MATHEMATICAL OPERATION,                    *
C               **  FOR THE LIST UPDATING, AND                                 *
C               **  FOR SOME INFORMATIVE PRINTING.                             *
C               ****************************************************************
C
10000 CONTINUE
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FOR'
      CALL DPFOR(NIOLD,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIFOR=NINEW
      NIISUB=NINEW
      GOTO11000
C
C               ******************************************
C               **  STEP 11--                            **
C               **  GENERATE    NWEIAR    WEIBULL   **
C               **  ADJUSTED RANKS.                  **
C               **  STORE THEM TEMPORARILY IN           **
C               **  THE VECTOR TEMP(.).                    **
C               ******************************************
C
11000 CONTINUE
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NITEMP=NINEW
      NS2=0
CCCCC IMAX=NINEW
CCCCC IF(ICASEQ.EQ.'FOR'.AND.IMAX.GT.NIFOR)IMAX=NIFOR
CCCCC DO11100I=1,IMAX
      DO11100I=1,NINEW
      IJ=MAXN*(ICOLR-1)+I
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,11110)I,NS2,NINEW,ISUB(I),IJ,V(IJ)
11110 FORMAT('I,NS2,NINEW,ISUB(I),IJ,V(IJ) = ',5I8,F12.5)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ISUB(I).EQ.0)GOTO11100
C
      IF(NUMVAR.EQ.1)GOTO11111
      GOTO11119
11111 CONTINUE
      IF(I.GT.NIRIGH)GOTO11119
      NS2=NS2+1
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)TEMP(NS2)=1.0
      IF(ICOLR.EQ.MAXCP1)TEMP(NS2)=1.0
      IF(ICOLR.EQ.MAXCP2)TEMP(NS2)=1.0
      IF(ICOLR.EQ.MAXCP3)TEMP(NS2)=1.0
      IF(ICOLR.EQ.MAXCP4)TEMP(NS2)=1.0
      IF(ICOLR.EQ.MAXCP5)TEMP(NS2)=1.0
      IF(ICOLR.EQ.MAXCP6)TEMP(NS2)=1.0
11119 CONTINUE
C
      IF(NUMVAR.EQ.2)GOTO11121
      GOTO11129
11121 CONTINUE
      IF(I.GT.NIRIG2)GOTO11129
      NS2=NS2+1
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)TEMP(NS2)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)TEMP(NS2)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)TEMP(NS2)=RES(I)
      IF(ICOL2.EQ.MAXCP3)TEMP(NS2)=RES(I)
      IF(ICOL2.EQ.MAXCP4)TEMP(NS2)=RES(I)
      IF(ICOL2.EQ.MAXCP5)TEMP(NS2)=RES(I)
      IF(ICOL2.EQ.MAXCP6)TEMP(NS2)=RES(I)
11129 CONTINUE
C
11100 CONTINUE
C
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,11131)ICOLL,ICOLR,ICOL2,NS2,
     1NINEW,ICASEQ
11131 FORMAT('ICOLL,ICOLR,ICOL2,NS2,NINEW,ICASEQ = ',
     15I8,2X,A4)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IWRITE='ON'
      IF(IPRINT.EQ.'OFF')IWRITE='OFF'
      IF(IFEEDB.EQ.'OFF')IWRITE='OFF'
C
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,11132)(TEMP(I),I=1,NS2)
11132 FORMAT(F10.5)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      CALL WEIBAR(TEMP,NS2,IWRITE,TEMP2,IBUGA3,IERROR)
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,999)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,11133)(TEMP2(I),I=1,NS2)
11133 FORMAT(F10.5)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***********************************************************
C               **  STEP 12--                                            **
C               **  IF CALLED FOR (THAT IS, IF IBUGA3 IS ON),      **
C               **  PRINT OUT THE INTERMEDIATE VARIABLE TEMP2(.).            **
C               **  THIS IS USEFUL FOR DIAGNOSTIC PURPOSES               **
C               **  IN REVIEWING THE OUTPUT FROM THIS SUBROUTINE.        **
C               ***********************************************************
C
      ISTEPN='12'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO12090
      WRITE(ICOUT,12051)
12051 FORMAT('OUTPUT FROM MIDDLE OF DPWEAR AFTER WEIBAR ',
     1'HAS BEEN CALLED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12052)NS2
12052 FORMAT('NS2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NS2.LE.0)GOTO12090
      DO12054I=1,NS2
      WRITE(ICOUT,12055)I,TEMP(I),TEMP2(I)
12055 FORMAT('I,TEMP(I),TEMP2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
12054 CONTINUE
C
12090 CONTINUE
C
C               ******************************************************
C               **  STEP 13--                                       **
C               **  COPY THE WEIBULL ADJUSTED RANKS                **
C               **  FROM THE INTERMEDIATE VECTOR TEMP2(.)               **
C               **  TO THE APPROPRIATE COLUMN                       **
C               **  (BASED ON THE QUALIFIER--FULL, SUBSET, OR FOR)  **
C               **  IN THE INTERNAL DATAPLOT DATA TABLE.            **
C               ******************************************************
C
      ISTEPN='13'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS3=0
      DO13000I=1,NIISUB
      IJ=MAXN*(ICOLL-1)+I
      IF(ISUB(I).EQ.0)GOTO13000
      NS3=NS3+1
      IF(ICOLL.LE.MAXCOL)V(IJ)=TEMP2(NS3)
      IF(ICOLL.EQ.MAXCP1)PRED(I)=TEMP2(NS3)
      IF(ICOLL.EQ.MAXCP2)RES(I)=TEMP2(NS3)
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=TEMP2(NS3)
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=TEMP2(NS3)
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=TEMP2(NS3)
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=TEMP2(NS3)
      IF(NS3.EQ.1)IROW1=I
      IROWN=I
13000 CONTINUE
C
C               *******************************************
C               **  STEP 14--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING.   **
C               *******************************************
C
      ISTEPN='14'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO')NINEW=NLEFT
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO')NINEW=NIRIGH
CCCCC IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'YES')NINEW=MAXN
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
C
      IHNAME(ILISTL)=ILEFT
      IHNAM2(ILISTL)=ILEFT2
      IUSE(ILISTL)='V'
      IVALUE(ILISTL)=ICOLL
      VALUE(ILISTL)=ICOLL
      IN(ILISTL)=NINEW
C
CCCCC IUSE(ICOLL)='V'
CCCCC IVALUE(ICOLL)=ICOLL
CCCCC VALUE(ICOLL)=ICOLL
CCCCC IN(ICOLL)=NINEW
C
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM.EQ.'YES')NUMCOL=NUMCOL+1
C
      DO14100J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO14105
      GOTO14100
14105 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
14100 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO14059
      IF(IFEEDB.EQ.'OFF')GOTO14059
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,14011)ILEFT,ILEFT2,NS2
14011 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL-1)+IROW1
      IF(ICOLL.LE.MAXCOL)WRITE(ICOUT,14021)ILEFT,ILEFT2,V(IJ),IROW1
14021 FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL.LE.MAXCOL)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1)WRITE(ICOUT,14021)ILEFT,ILEFT2,PRED(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2)WRITE(ICOUT,14021)ILEFT,ILEFT2,RES(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3)WRITE(ICOUT,14021)ILEFT,ILEFT2,YPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP3)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4)WRITE(ICOUT,14021)ILEFT,ILEFT2,XPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP4)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5)WRITE(ICOUT,14021)ILEFT,ILEFT2,X2PLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP5)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6)WRITE(ICOUT,14021)ILEFT,ILEFT2,TAGPLO(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP6)CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL-1)+IROWN
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)WRITE(ICOUT,14031)NS2,ILEFT,ILEFT2,V(IJ),IROWN
14031 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS2.NE.1)WRITE(ICOUT,14031)NS2,ILEFT,ILEFT2,PRED(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS2.NE.1)WRITE(ICOUT,14031)NS2,ILEFT,ILEFT2,RES(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)WRITE(ICOUT,14031)NS2,ILEFT,ILEFT2,YPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)WRITE(ICOUT,14031)NS2,ILEFT,ILEFT2,XPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)WRITE(ICOUT,14031)NS2,ILEFT,ILEFT2,X2PLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)WRITE(ICOUT,14031)NS2,ILEFT,ILEFT2,TAGPLO(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(NS2.NE.1)GOTO14090
      WRITE(ICOUT,14041)
14041 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,14042)
14042 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
14090 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,14112)ILEFT,ILEFT2,ICOLL
14112 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,14113)ILEFT,ILEFT2,NINEW
14113 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
14059 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGA3,IBUGQ
 9013 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NS2,NS3,NINEW,NIISUB
 9015 FORMAT('NS2,NS3,NINEW,NIISUB = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NS,NIISUB,NS2
 9016 FORMAT('NS,NIISUB,NS2 = ',I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWEB(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,IANSLC,
     1IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--ACCESS THE WORLD WIDE WEB
C
C              THIS COMMAND TAKES THE FOLLOWING FORMS:
C                  WEB                - GO TO DEFAULT URL
C                  WEB   - GO TO URL SPECIFIED BY 
C     INPUT  ARGUMENTS--IANS    (A  HOLLERITH VECTOR)
C                     --IWIDTH (AN INTEGER VARIABLE)
C                     --IBROWS  (A CHARACTER VARIABLE THAT IDENTIFIES
C                               THE BROWSER TO USE)
C                     --IURL    (A CHARACTER VARIABLE THAT IDENTIFIES
C                               THE WEB URL OF THE DATAPLOT HOME PAGE)
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
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-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--97/4
C     ORIGINAL VERSION--APRIL     1997.
C     UPDATED         --MARCH     1999.  UPDATE A FEW ADDRESSES
C     UPDATED         --MARCH     1999.  TREAT "HANDBOOK" SPECIAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IANSLC
      CHARACTER*500 ICALL
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IBRWFL
C
      CHARACTER*128 ICANS
C
      CHARACTER*128 ISTRIN
      CHARACTER*4 IERRO2
      CHARACTER*1 IQUOTE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
      DIMENSION IARGT(*)
      DIMENSION IANSLC(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.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='DPWE'
      ISUBN2='B   '
C
      ISTRIN=' '
C
      CALL DPCONA(39,IQUOTE)
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WEB ')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWEB--')
      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 ')
      WRITE(ICOUT,55)(IANSLC(I),I=1,MIN(IWIDTH,80))
   55 FORMAT('IANS(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)IBROWS(1:80)
   86 FORMAT('IBROWS = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IURL(1:80)
   88 FORMAT('IDPURL = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IHBURL(1:80)
   89 FORMAT('IHBURL = ',A80)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IF(
     1       (IHOST1.EQ.'SUN') .OR.
     1       (IHOST1.EQ.'CRAY' .AND. IOPSY1.EQ.'UNIX') .OR.
     1       (IHOST1.EQ.'CONV') .OR.
     1       (IHOST1.EQ.'SGI ') .OR.
     1       (IHOST1.EQ.'HP-9') .OR.
     1       (IHOST1.EQ.'AIX ') .OR.
     1       (IHOST1.EQ.'LINU') .OR.
     1       (IOPSY1.EQ.'UNIX'))GOTO199
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO199
  100 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** FROM DPWEB--WEB HELP CURRENTLY ONLY SUPPORTED ',
     1'UNIX OR IBM-PC WINDOW 95/NT PLATFORMS.')
  199 CONTINUE
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  CHECK FOR SOME SPECIAL CASES FIRST              **
C               ******************************************************
C
      NCURL=0
      IHB=0
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'NIST')THEN
        NCURL=20
        ISTRIN='http://www.nist.gov/'
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'SED ')THEN
        NCURL=31
        ISTRIN='http://www.itl.nist.gov/div898/'
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'ITL ')THEN
        NCURL=24
        ISTRIN='http://www.itl.nist.gov/'
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIMA')THEN
        NCURL=49
        ISTRIN='http://www.mel.nist.gov/div826/msid/sima/sima.htm'
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'HPCC')THEN
        NCURL=20
        ISTRIN='http://www.hpcc.gov/'
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'SEMA')THEN
        NCURL=40
        ISTRIN='http://www.sematech.org/public/home.html'
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'JJF ')THEN
        NCURL=33
        ISTRIN='http://www.cam.nist.gov/~filliben'
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'FILL')THEN
        NCURL=33
        ISTRIN='http://www.cam.nist.gov/~filliben'
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'HAND')THEN
        IHB=1
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'DATA'.AND.
     1       IHARG2(1).EQ.'PLOT')THEN
        GOTO9000
      ENDIF
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WEB ')GOTO299
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,291)IHB,NCURL
  291 FORMAT('IHB,NCURL=',I8,I8)
  299 CONTINUE
C
C               ******************************************************
C               **  STEP 2--                                        **
C               **  ADD BROWSER TO COMMAND STRING                   **
C               ******************************************************
C
 2099 CONTINUE
      ISTEPN='52.1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WEB ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICALL=' '
      DO2000I=MAXBRO,1,-1
         NUMBRO=I
         IF(IBROWS(I:I).NE.' ')GOTO2009
 2000 CONTINUE
 2009 CONTINUE
      IF(NUMBRO.GT.0)THEN
        ICALL(1:NUMBRO)=IBROWS(1:NUMBRO)
        NCSTR=NUMBRO+1
        ICALL(NCSTR:NCSTR)=' '
      ELSE
        ICALL(1:9)='netscape '
        NCSTR=9
      ENDIF
C
      IBRWFL='NETS'
      IF(NUMBRO.GE.8)THEN
        DO2025I=1,NUMBRO-7
          IF(IBROWS(I:I+7).EQ.'IEXPLORE' .OR.
     1       IBROWS(I:I+7).EQ.'iexplore')THEN
             IBRWFL='IEXP'
             GOTO2028
          ENDIF
 2025   CONTINUE
 2028   CONTINUE
      ENDIF
C
C               ******************************************************
C               **  STEP 3--                                        **
C               **  CHECK FOR URL ON COMMAND LINE.  IF NOT FOUND,   **
C               **  CHECK FOR IURL VARIABLE FROM PRIOR SET URL      **
C               ******************************************************
C
      IF(NCURL.GT.0.AND.IHB.EQ.0)GOTO3099
C
      DO3010I=1,128
      ICANS(I:I)=IANSLC(I)
 3010 CONTINUE
C
      IF(NUMARG.LT.1)THEN
        NCSTRI=0
        GOTO3019
      ENDIF
      ISTART=1
      ISTOP=IWIDTH
      IWORD=2
      IF(IHB.EQ.1.AND.NUMARG.GT.1)THEN
        IWORD=IWORD+1
      ELSEIF(IHB.EQ.1.AND.NUMARG.LE.1)THEN
        NCSTRI=0
        GOTO3099
      ENDIF 
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRIN,NCSTRI,
     1IBUGS2,ISUBRO,IERROR)
C
 3019 CONTINUE
      IF(NCSTRI.LE.0)THEN
        DO3050I=80,1,-1
          NCSTRI=I
          IF(IURL(I:I).NE.' ')GOTO3059
 3050   CONTINUE
 3059   CONTINUE
        IF(NCSTRI.GT.0)THEN
          ISTRIN(1:NCSTRI)=IURL(1:NCSTRI)
        ELSE
          NCSTRI=20
          ISTRIN(1:NCSTRI)='http://www.nist.gov/'
        ENDIF
      ENDIF
C
 3099 CONTINUE
C
C  IF "SET NETSCAPE OLD" COMMAND WAS ENTERED, THEN USE 
C  -remote NETSCAPE OPTION.  THIS ONLY APPLIES TO UNIX PLATFORMS.
C
      IF(IHOST1.EQ.'IBM-')THEN
        IF(IBRWFL.EQ.'NETS')THEN
          NCSTR=NCSTR+1
          NCSTR2=NCSTR+3
          ICALL(NCSTR:NCSTR2)=' -h '
          NCSTR=NCSTR2
        ENDIF
        GOTO5129 
      ENDIF
      IF(INETSW.EQ.'OLD'.AND.IHOST1.NE.'IBM-')THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+8
        ICALL(NCSTR:NCSTR2)=' -remote '
        NCSTR=NCSTR2+1
        ICALL(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+7
        ICALL(NCSTR:NCSTR2)='openURL('
        NCSTR=NCSTR2
      ENDIF
C
 5129 CONTINUE
      IF(IHB.EQ.1)THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+NCHURL-1
        ICALL(NCSTR:NCSTR2)=IHBURL(1:NCHURL)
        NCSTR=NCSTR2
        IF(NCSTRI.GT.0)THEN
          NCSTR=NCSTR+1
          NCSTR2=NCSTR+NCSTRI-1
          ICALL(NCSTR:NCSTR2)=ISTRIN(1:NCSTRI)
          NCSTR=NCSTR2
        ENDIF
      ELSEIF(NCURL.GT.0)THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+NCURL-1
        ICALL(NCSTR:NCSTR2)=ISTRIN(1:NCURL)
        NCSTR=NCSTR2
      ELSE
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+NCSTRI-1
        ICALL(NCSTR:NCSTR2)=ISTRIN(1:NCSTRI)
        NCSTR=NCSTR2
      ENDIF
C
C               ****************************************************
C               **  STEP 53--                                     **
C               **  USE DPSYS2 TO MAKE A SYSTEM CALL              **
C               ****************************************************
C
 5300 CONTINUE
      ISTEPN='53'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WEB ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(INETSW.EQ.'OLD'.AND.IHOST1.NE.'IBM-')THEN
        NCSTR=NCSTR+1
        ICALL(NCSTR:NCSTR)=')'
        NCSTR=NCSTR+1
        ICALL(NCSTR:NCSTR)=IQUOTE
      ENDIF
      IF(IHOST1.NE.'IBM-')THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+1
        ICALL(NCSTR:NCSTR2)=' &'
        NCSTR=NCSTR2
      ENDIF
C
      IF(INETSW.EQ.'NEW')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5411)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IHOST1.NE.'IBM-')THEN
          WRITE(ICOUT,5412)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5413)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5414)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5415)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
 5411 FORMAT('*****NOTE: IT MAY TAKE THE BROWSER A FEW MOMENTS TO ',
     1      'START UP.')
 5412 FORMAT('     IF YOU ARE USING THE NETSCAPE BROWSER, YOU CAN ',
     1       'SPEED UP SUBSEQUENT')
 5413 FORMAT('     USE OF WEB HELP BY ENTERING THE FOLLOWING DATAPLOT',
     1       ' COMMAND')
 5414 FORMAT('     (LEAVE THE BROWSER OPEN):')
 5415 FORMAT('         SET NETSCAPE OLD')
      CALL DPSYS2(ICALL,NCSTR,ISUBRO,IERROR)
C
 5390 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WEB ')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWEB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR,IERRO2
 9012 FORMAT('IBUGS2,ISUBRO,IERROR= ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGS2,IFOUND,IERROR
 9028 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9097)ICALL(1:128)
 9097 FORMAT('ICALL = ',A128)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9099)ICALL(129:256)
 9099 FORMAT('ICALL = ',A128)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWEIB(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A WEIBULL PLOT
C              (USEFUL FOR RELIABILITY AND LIFE-TESTING).
C     EXAMPLE--WEIBULL PLOT Y TAG
C              WEIBULL PLOT Y
C     NOTE--NORMALLY THIS COMMAND HAS 2 ARGUMENTS--
C           ARGUMENT 1 IS THE RESPONSE VARIABLE
C           ARGUMENT 2 IS THE CENSOR-TAG VARIABLE
C           IF THE WEIBULL PLOT COMMAND HAS ONLY
C           1 ARGUMENT, THEN IT IS ASSUMED THAT ALL
C           OF THE DATA IS TO BE INCLUDED
C           (THAT IS, NO CENSORING).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/6
C     ORIGINAL VERSION--JUNE      1987.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --APRIL     1992. DEFINE CUTOFF
C     UPDATED         --MAY       1995. ADD LINE TO EQUIVALENCE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IX2TSC
      CHARACTER*4 IY1TSC
      CHARACTER*4 IY2TSC
C
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
C
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 IBUGA2
C
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992 (ALAN)
      INCLUDE 'DPCOHO.INC'
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      DIMENSION YS(MAXOBV)
      DIMENSION TAGC2(MAXOBV)
      DIMENSION ITAGC2(MAXOBV)
      DIMENSION WAR(MAXOBV)
      DIMENSION WMR(MAXOBV)
      DIMENSION WMRT(MAXOBV)
      DIMENSION YST(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),YS(1))
      EQUIVALENCE (GARBAG(IGARB4),TAGC2(1))
      EQUIVALENCE (GARBAG(IGARB5),YST(1))
      EQUIVALENCE (GARBAG(IGARB6),WAR(1))
      EQUIVALENCE (GARBAG(IGARB7),WMRT(1))
CCCCC MAY 1995.  ADD LINE TO EQUIVALENCE.
      EQUIVALENCE (GARBAG(IGARB8),WMR(1))
      EQUIVALENCE (IGARBG(IIGAR1),ITAGC2(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
      ISUBN1='DPWE'
      ISUBN2='IB  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      BETA=(-999.0)
      ETA=(-999.0)
      SDBETA=(-999.0)
      SDETA=(-999.0)
      BPT1=(-999.0)
      BPT5=(-999.0)
      B1=(-999.0)
      B5=(-999.0)
      B10=(-999.0)
      B20=(-999.0)
      B50=(-999.0)
      B80=(-999.0)
      B90=(-999.0)
      B95=(-999.0)
      B99=(-999.0)
      B995=(-999.0)
      B999=(-999.0)
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED   APRIL 1992 (ALAN)
      ICUTMX=NUMBPW
      IF(IHOST1.EQ.'CDC '.OR.IHOST1.EQ.'CYBE')ICUTMX=48
      IF(IHOST1.EQ.'205 ')ICUTMX=48
      CUTOFF=2**(ICUTMX-3)
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'WEIB')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWEIB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NPLOTV,NPLOTP,NS
   52 FORMAT('NPLOTV,NPLOTP,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IANGLU,IBUGG2,IBUGG3,IBUGQ
   54 FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGQ = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASPL,MAXN
   56 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)MAXNPP
   58 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IX1TSC,IX2TSC,IY1TSC,IY2TSC
   61 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IX1TSV,IX2TSV,IY1TSV,IY2TSV
   62 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***********************************
C               **  TREAT THE WEIBULL PLOT CASE  **
C               ***********************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO1110
      GOTO9000
C
 1110 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      ICASPL='WEIB'
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  CARRY OUT A GENERAL CHECK FOR THE                 **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE 1 OR 2).                            **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL 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               **  STEP 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'WEIB')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ********************************************************
C               **  STEP 14--                                         **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE                **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE 1 OR 2).                            **
C               ********************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.1)GOTO1490
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPWEIB--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A WEIBULL PLOT, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,IWIDTH)
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ****************************************************************
C               **  STEP 15--                                                  *
C               **  EXAMINE THE VARIABLES--                                    *
C               **  HAS EACH VARIABLE                                          *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISR1, ILISR2,                              *
C               **  IS THE LINE IN THE TABLE                                   *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               **  NOTE THAT     ICOLR1, ICOLR2,                              *
C               **  IS THE DATA COLUMN (1 TO 10+6)                             *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               ****************************************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      IF(NUMVAR.LE.1)GOTO1590
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPWEIB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,IWIDTH)
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPWEIB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,IWIDTH)
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  CHECK THAT VARIABLES 1 AND 2       HAVE         **
C               **  THE SAME NUMBER OF ELEMENTS.                    **
C               ******************************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.LE.1)GOTO2190
      IF(NIRIG1.EQ.NIRIG2)GOTO2190
C
 2110 CONTINUE
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPWEIB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      THE NUMBER OF OBSERVATIONS IN VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      1 AND 2 MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1
 2116 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2
 2117 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2120)
 2120 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2121)(IANS(I),I=1,IWIDTH)
 2121 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2190 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPWEIB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH AN WEIBULL PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE RESPONSE VARIABLE              **
C               **       THE CENSOR-TAG VARIABLE            **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1WRITE(ICOUT,780)N,NIRIG1,NQ,IMAX
  780 FORMAT(' N,NIRIG1,NQ,IMAX = ',4I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL DPWRST('XXX','BUG ')
      DO3300I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3300
      J=J+1
C
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IF(NUMVAR.LE.1)Y2(J)=1.0
      IF(NUMVAR.LE.1)GOTO3300
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
 3300 CONTINUE
      NS=J
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1WRITE(ICOUT,776)J,NS
  776 FORMAT('J,NS = ',2I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL DPWRST('XXX','BUG ')
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT THE            **
C               **  COMBINATION OF CENSORING AND           **
C               **  SUBSETTING DOES NOT RESULT IN          **
C               **  TOO FEW DATA POINTS RESULTING          **
C               **  (AT LEAST 2)                           **
C               **  WITH WHICH TO FORM A WEIBULL PLOT.     **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUNT=0
      IF(NS.LE.2)ICOUNT=NS
      IF(NS.LE.2)GOTO3410
      DO3400I=1,NS
CCCCC WRITE(ICOUT,777)I,ICOUNT,NS,MINN2,Y2(I)
CC777 FORMAT('I,ICOUNT,NS,MINN2,Y2(I) = ',I8,E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUNT=ICOUNT+1
 3400 CONTINUE
 3410 CONTINUE
      IF(ICOUNT.LE.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPWEIB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED CENSORING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      AND SUBSETTING HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)IHRI11,IHRI12
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH A WEIBULL PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)ICOUNT
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE (ICOUNT = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)
 3459 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3460)(IANS(I),I=1,IWIDTH)
 3460 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ****************************************************************
C               **  STEP 41--                                                  *
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='41'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'WEIB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC JUNE, 1990.  DIMENSIONS FOR YS - YST NOW DONE IN DPWEIB
      CALL DPWEI2(Y1,Y2,NS,ICASPL,MAXN,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1BETA,ETA,SDBETA,SDETA,
     1BPT1,BPT5,B1,B5,B10,B20,B50,B80,B90,B95,B99,B995,B999,
     1YS,TAGC2,ITAGC2,WAR,WMR,WMRT,YST,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 51--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='51'
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   APRIL 1992
CCCCC IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      DO5100IPASS=1,17
      IF(IPASS.EQ.1)IH='BETA'
      IF(IPASS.EQ.1)IH2='    '
      IF(IPASS.EQ.2)IH='ETA'
      IF(IPASS.EQ.2)IH2='    '
      IF(IPASS.EQ.3)IH='SDBE'
      IF(IPASS.EQ.3)IH2='TA  '
      IF(IPASS.EQ.4)IH='SDET'
      IF(IPASS.EQ.4)IH2='A   '
C
      IF(IPASS.EQ.5)IH='BPT1'
      IF(IPASS.EQ.5)IH2='    '
      IF(IPASS.EQ.6)IH='BPT5'
      IF(IPASS.EQ.6)IH2='    '
      IF(IPASS.EQ.7)IH='B1  '
      IF(IPASS.EQ.7)IH2='    '
      IF(IPASS.EQ.8)IH='B5  '
      IF(IPASS.EQ.8)IH2='    '
      IF(IPASS.EQ.9)IH='B10 '
      IF(IPASS.EQ.9)IH2='    '
      IF(IPASS.EQ.10)IH='B20 '
      IF(IPASS.EQ.10)IH2='    '
      IF(IPASS.EQ.11)IH='B50 '
      IF(IPASS.EQ.11)IH2='    '
      IF(IPASS.EQ.12)IH='B80 '
      IF(IPASS.EQ.12)IH2='    '
      IF(IPASS.EQ.13)IH='B90 '
      IF(IPASS.EQ.13)IH2='    '
      IF(IPASS.EQ.14)IH='B95 '
      IF(IPASS.EQ.14)IH2='    '
      IF(IPASS.EQ.15)IH='B99 '
      IF(IPASS.EQ.15)IH2='    '
      IF(IPASS.EQ.16)IH='B995'
      IF(IPASS.EQ.16)IH2='    '
      IF(IPASS.EQ.17)IH='B999'
      IF(IPASS.EQ.17)IH2='    '
      DO5150I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO5180
 5150 CONTINUE
      IF(NUMNAM.LT.MAXNAM)GOTO5170
      WRITE(ICOUT,5151)
 5151 FORMAT('***** ERROR IN DPWEIB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5152)
 5152 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5153)MAXNAM
 5153 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5154)
 5154 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5155)
 5155 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5156)
 5156 FORMAT('      HAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5157)
 5157 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5158)
 5158 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5159)
 5159 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5160)
 5160 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5161)
 5161 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5162)
 5162 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5163)(IANS(I),I=1,IWIDTH)
 5163 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 5170 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      IF(IPASS.EQ.1)VALUE(ILOC)=BETA
      IF(IPASS.EQ.2)VALUE(ILOC)=ETA
      IF(IPASS.EQ.3)VALUE(ILOC)=SDBETA
      IF(IPASS.EQ.4)VALUE(ILOC)=SDETA
      IF(IPASS.EQ.5)VALUE(ILOC)=BPT1
      IF(IPASS.EQ.6)VALUE(ILOC)=BPT5
      IF(IPASS.EQ.7)VALUE(ILOC)=B1
      IF(IPASS.EQ.8)VALUE(ILOC)=B5
      IF(IPASS.EQ.9)VALUE(ILOC)=B10
      IF(IPASS.EQ.10)VALUE(ILOC)=B20
      IF(IPASS.EQ.11)VALUE(ILOC)=B50
      IF(IPASS.EQ.12)VALUE(ILOC)=B80
      IF(IPASS.EQ.13)VALUE(ILOC)=B90
      IF(IPASS.EQ.14)VALUE(ILOC)=B95
      IF(IPASS.EQ.15)VALUE(ILOC)=B99
      IF(IPASS.EQ.16)VALUE(ILOC)=B995
      IF(IPASS.EQ.17)VALUE(ILOC)=B999
      VAL=VALUE(ILOC)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(ILOC)=IVAL
      GOTO5100
C
 5180 CONTINUE
      IF(IPASS.EQ.1)VALUE(I2)=BETA
      IF(IPASS.EQ.2)VALUE(I2)=ETA
      IF(IPASS.EQ.3)VALUE(I2)=SDBETA
      IF(IPASS.EQ.4)VALUE(I2)=SDETA
      IF(IPASS.EQ.5)VALUE(I2)=BPT1
      IF(IPASS.EQ.6)VALUE(I2)=BPT5
      IF(IPASS.EQ.7)VALUE(I2)=B1
      IF(IPASS.EQ.8)VALUE(I2)=B5
      IF(IPASS.EQ.9)VALUE(I2)=B10
      IF(IPASS.EQ.10)VALUE(I2)=B20
      IF(IPASS.EQ.11)VALUE(I2)=B50
      IF(IPASS.EQ.12)VALUE(I2)=B80
      IF(IPASS.EQ.13)VALUE(I2)=B90
      IF(IPASS.EQ.14)VALUE(I2)=B95
      IF(IPASS.EQ.15)VALUE(I2)=B99
      IF(IPASS.EQ.16)VALUE(I2)=B995
      IF(IPASS.EQ.17)VALUE(I2)=B999
      VAL=VALUE(I2)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(I2)=IVAL
      GOTO5100
C
 5100 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'WEIB')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWEIB--')
      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)ICASPL,MAXN,NUMVAR
 9014 FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9029
      DO9020I=1,NPLOTP
      WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
 9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9031)ICOUNT
 9031 FORMAT('ICOUNT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)IX1TSC,IX2TSC,IY1TSC,IY2TSC
 9041 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IX1TSV,IX2TSV,IY1TSV,IY2TSV
 9042 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)BETA,ETA,SDBETA,SDETA
 9043 FORMAT('BETA,ETA,SDBETA,SDETA = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9050I=1,NIRIG1
      WRITE(ICOUT,9051)I,Y1(I),Y2(I),ISUB(I)
 9051 FORMAT('I,Y1(I),Y2(I),ISUB(I) = ',I8,2E15.7,I8)
      CALL DPWRST('XXX','BUG ')
 9050 CONTINUE
      WRITE(ICOUT,9061)IHRI11,IHRI12
 9061 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)IHRI21,IHRI22
 9062 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWEI2(Y,TAGC,N,ICASPL,MAXN,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1BETA,ETA,SDBETA,SDETA,
     1BPT1,BPT5,B1,B5,B10,B20,B50,B80,B90,B95,B99,B995,B999,
     1YS,TAGC2,ITAGC2,WAR,WMR,WMRT,YST,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
CCCCC JUNE, 1990. YS - YST NOW DIMENSIONED IN DPWEIB
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A WEIBULL PLOT.
C              THE PLOT WILL CONSIST OF 6 COMPONENTS--
C                  1) THE RAW DATA
C                  2) THE FITTED LINE
C                  3) THE HORIZONTAL 63.2% LINE
C                  4) THE VERTICAL   63.2% LINE
C                  5) 95% CONFIDENCE LIMITS
C                  6) 99% CONFIDENCE LIMITS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/6
C     ORIGINAL VERSION--JUNE      1987.
C     UPDATED         --FEBRUARY  1988.  (ERROR TRAP FOR NON-POSITIVE DATA)
C     UPDATED         --JUNE      1990.  SOME DIMENSIONS NOW DONE IN DPWEIB
C     UPDATED         --APRIL     1992.  YMIN/2/3/4/ TO XMIN/2/3/4/
C     UPDATED         --NOVEMBER  1992.  CHARACTER*4 ICASPL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IX2TSC
      CHARACTER*4 IY1TSC
      CHARACTER*4 IY2TSC
C
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1992
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y(*)
      DIMENSION TAGC(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
CCCCC JUNE, 1990.  FOLLOWING NOW DIMENSIONED IN DPWEIB
CCCCC DIMENSION YS(MAXOBV)
CCCCC DIMENSION TAGC2(MAXOBV)
CCCCC DIMENSION ITAGC2(MAXOBV)
CCCCC DIMENSION WAR(MAXOBV)
CCCCC DIMENSION WMR(MAXOBV)
CCCCC DIMENSION WMRT(MAXOBV)
CCCCC DIMENSION YST(MAXOBV)
      DIMENSION YS(*)
      DIMENSION TAGC2(*)
      DIMENSION ITAGC2(*)
      DIMENSION WAR(*)
      DIMENSION WMR(*)
      DIMENSION WMRT(*)
      DIMENSION YST(*)
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='DPWE'
      ISUBN2='I2  '
C
      IERROR='NO'
C
      AN=N
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'WEI2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO
   52 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,MAXN,N,NPLOTV
   53 FORMAT('ICASPL,MAXN,N,NPLOTV = ',A4,2X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO62
      DO60I=1,N
      WRITE(ICOUT,61)I,Y(I),TAGC(I)
   61 FORMAT('I,Y(I),TAGC(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
   62 CONTINUE
      WRITE(ICOUT,71)IX1TSC,IX2TSC,IY1TSC,IY2TSC
   71 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IX1TSV,IX2TSV,IY1TSV,IY2TSV
   72 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)BETA,ETA,SDBETA,SDETA
   73 FORMAT('BETA,ETA,SDBETA,SDETA = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)BPT1,BPT5,B1,B5
   74 FORMAT('BPT1,BPT5,B1,B5 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)B10,B20,B50,B80,B90
   75 FORMAT(' B10,B20,B50,B80,B90 = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)B95,B99,B995,B999
   76 FORMAT('B95,B99,B995,B999 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.2)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPWEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MUST BE AT LEAST 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)N
 1114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.GE.3)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPWEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      WAS EXACTLY EQUAL TO 2.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1130I=1,N
      IF(Y(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPWEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      DO1140I=1,N
      IF(Y(I).NE.0.0)GOTO1149
 1140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPWEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      ALL INPUT TAG VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      ARE IDENTICALLY EQUAL TO 0.0;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      THUS THERE ARE NO RESPONSE VARIABLE VALUES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1145)
 1145 FORMAT('      REMAINING UPON WHICH TO DO A WEIBULL ANALYSIS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1149 CONTINUE
C
C               ***********************************************
C               **  STEP 21--                                **
C               **  SORT THE DATA AND CARRY ALONG THE TAG    **
C               ***********************************************
C
      CALL SORTC(Y,TAGC,N,YS,TAGC2)
C
      DO2100I=1,N
      ITAGC2(I)=TAGC2(I)+0.1
 2100 CONTINUE
C
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  COMPUTE WEIBULL ADUSTED RANKS            **
C               ***********************************************
C
C               -----------------------------------------------
C               SET INITIAL VALUE FOR SAVED ADJUSTED RANK.
C               SET INITIAL VALUE FOR RANK INCREMENT.
C               -----------------------------------------------
C
      SAVEAR=0.0
C
      I=0
      ANUM=(AN+1.0)-SAVEAR
      ADENOM=1+(N-I)
      RANINC=ANUM/ADENOM
C
      NVALID=0
      DO2200I=1,N
      IF(ITAGC2(I).EQ.1)GOTO2210
      GOTO2220
C
C               -----------------------------------------------
C               TREAT THE VALID (TO BE INCLUDED) ITEM CASE.
C               COMPUTE THE ADJUSTED RANK.
C               SAVE THE ADJUSTED RANK.
C               DO NOT RECOMPUTE THE RANK INCREMENT.
C               -----------------------------------------------
C
 2210 CONTINUE
      NVALID=NVALID+1
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1WRITE(ICOUT,2211)I,YS(I),TAGC2(I),ITAGC2(I),WAR(I)
 2211 FORMAT('I,YS(I),TAGC2(I),ITAGC2(I),WAR(I) = ',I8,2E15.7,
     1I8,E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1CALL DPWRST('XXX','BUG ')
      WAR(I)=SAVEAR+RANINC
      SAVEAR=WAR(I)
      GOTO2290
C
C               -----------------------------------------------
C               TREAT THE SUSPENDED (= CENSORED) ITEM CASE
C               RECOMPUTE THE RANK INCREMENT.
C               DO NOT RECOMPUTE THE SAVED ADJUSTED RANK.
C               -----------------------------------------------
C
 2220 CONTINUE
      ANUM=(AN+1.0)-SAVEAR
      ADENOM=1+(N-I)
      RANINC=ANUM/ADENOM
      GOTO2290
C
 2290 CONTINUE
 2200 CONTINUE
C
C               ************************************
C               **  STEP 23--                     **
C               **  DETERMINE THE NUMBER OF       **
C               **  "GOOD"                        **
C               **  = NON-CENSORED/NON-SUSPENDED  **
C               **  DATA VALUES.                  **
C               ************************************
C
      NSUB=0
      DO2300I=1,N
      IF(ITAGC2(I).EQ.0)GOTO2300
      NSUB=NSUB+1
 2300 CONTINUE
      ANSUB=NSUB
C
C               ****************************************
C               **  STEP 24--                         **
C               **  COMPUTE WEIBULL MEDIAN RANKS      **
C               **  (FOR THE GOOD DATA ONLY)          **
C               ****************************************
C
      DO2400I=1,N
      WMR(I)=(-999.0)
      IF(ITAGC2(I).EQ.0)GOTO2400
      WMR(I)=100.0*(WAR(I)-0.3)/(AN+0.4)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1WRITE(ICOUT,2411)I,WAR(I),WMR(I)
 2411 FORMAT('I,WAR(I),WMR(I) = ',I8,2E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1CALL DPWRST('XXX','BUG ')
 2400 CONTINUE
C
C               ****************************************
C               **  STEP 30--                         **
C               **  FIT THE DATA TO ESTIMATE          **
C               **  BETA (= SHAPE PARAMETER) AND      **
C               **  ETA  (= CHARACTERISTIC LIFE)      **
C               ****************************************
C
C               ******************************************
C               **  STEP 31--                           **
C               **  TRANSFORM THE WEIBULL MEDIAN RANKS  **
C               ******************************************
C
      DO3100I=1,N
      WMRT(I)=(-999.0)
      IF(ITAGC2(I).EQ.0)GOTO3100
      ARG1=100.0/(100.0-WMR(I))
      ARG2=ALOG(ARG1)
      WMRT(I)=ALOG(ARG2)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1WRITE(ICOUT,3111)I,ITAGC2(I),WMR(I),WMRT(I)
 3111 FORMAT('I,ITAGC2(I),WMR(I),WMRT(I) = ',2I8,2E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1CALL DPWRST('XXX','BUG ')
 3100 CONTINUE
C
C               ******************************************
C               **  STEP 32--                           **
C               **  TRANSFORM THE SORTED DATA           **
C               ******************************************
C
      DO3200I=1,N
      YST(I)=(-999.0)
      IF(ITAGC2(I).EQ.0)GOTO3200
      IF(YS(I).GT.0.0)GOTO3219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3211)
 3211 FORMAT('***** ERROR IN DPWEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3212)
 3212 FORMAT('      ZERO OR NEGATIVE DATA IS NOT PERMITTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3213)
 3213 FORMAT('      IN A WEIBULL PLOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3214)
 3214 FORMAT('      THE ILLEGAL VALUE IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3215)
 3215 FORMAT('      SUGGESTION--ADD A CONSTANT SO THAT ALL DATA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3216)
 3216 FORMAT('      IS POSITIVE, AND THEN REDO THE WEIBULL PLOT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3219 CONTINUE
      YST(I)=ALOG(YS(I))
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1WRITE(ICOUT,3221)I,ITAGC2(I),YS(I),YST(I)
 3221 FORMAT('I,ITAGC2(I),YS(I),YST(I) = ',2I8,2E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1CALL DPWRST('XXX','BUG ')
 3200 CONTINUE
C
C               ******************************************
C               **  STEP 33--                           **
C               **  CARRY OUT THE FIT OF                **
C               **  TRANSFORMED SORTED DATA VERSUS      **
C               **  TRANSFORMED WEIBULL MEDIAN RANKS    **
C               ******************************************
C
      SUMX=0.0
      SUMY=0.0
      DO3310I=1,N
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1WRITE(ICOUT,3311)I,ITAGC2(I),YST(I),WMRT(I)
 3311 FORMAT('I,ITAGC2(I),YST(I),WMRT(I) = ',2I8,2E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'WEI2')
     1CALL DPWRST('XXX','BUG ')
      IF(ITAGC2(I).EQ.0)GOTO3310
      SUMX=SUMX+WMRT(I)
      SUMY=SUMY+YST(I)
 3310 CONTINUE
      XBAR=SUMX/ANSUB
      YBAR=SUMY/ANSUB
C
      SUMXX=0.0
      SUMYY=0.0
      SUMXY=0.0
      DO3320I=1,N
      IF(ITAGC2(I).EQ.0)GOTO3320
      SUMXX=SUMXX+(WMRT(I)-XBAR)*(WMRT(I)-XBAR)
      SUMYY=SUMYY+(YST(I)-YBAR)*(YST(I)-YBAR)
      SUMXY=SUMXY+(WMRT(I)-XBAR)*(YST(I)-YBAR)
 3320 CONTINUE
      ASLOPE=0.0
      IF(SUMXX.GT.0.0)ASLOPE=SUMXY/SUMXX
      AINTER=YBAR-ASLOPE*XBAR
C
      SUMRR=0.0
      SUMX2=0.0
      DO3330I=1,N
      IF(ITAGC2(I).EQ.0)GOTO3330
      RES=YST(I)-(AINTER+ASLOPE*WMRT(I))
      SUMRR=SUMRR+RES*RES
      SUMX2=SUMX2+WMRT(I)*WMRT(I)
 3330 CONTINUE
      RESVAR=SUMRR/(AN-2.0)
      RESSD=0.0
      IF(RESVAR.GT.0.0)RESSD=SQRT(RESVAR)
      SDINTE=RESSD*SQRT(SUMX2/(AN*SUMXX))
      SDSLOP=RESSD*SQRT(1.0/SUMXX)
C
C               ****************************************
C               **  STEP 34--                         **
C               **  FORM ESTIMATES FOR                **
C               **  BETA (= SHAPE PARAMETER) AND      **
C               **  ETA  (= CHARACTERISTIC LIFE)      **
C               ****************************************
C
      IF(ASLOPE.GT.0.0)GOTO3339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3331)
 3331 FORMAT('***** INTERNAL ERROR IN DPWEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3332)
 3332 FORMAT('      THE FITTED SLOPE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3333)
 3333 FORMAT('      IS 0 OR NEGATIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3334)
 3334 FORMAT('      WHICH WOULD YIELD AN IMPOSSIBLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3335)
 3335 FORMAT('      VALUE FOR BETA = 1/SLOPE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3336)ASLOPE,AINTER
 3336 FORMAT('      ASLOPE,AINTER = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3337)SUMX,SUMY,SUMXX,SUMYY,SUMXY
 3337 FORMAT('      SUMX,SUMY,SUMXX,SUMYY,SUMXY = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3339 CONTINUE
      BETA=1/ASLOPE
      ETA=EXP(AINTER)
      SDBETA=BETA*BETA*SDSLOP
      SDETA=ETA*SDINTE
C
C               ************************************************
C               **  STEP 35--                                 **
C               **  FORM ESTIMATES FOR                        **
C               **     BPT1= .1%   POINT OF BEST-FIT DIST.    **
C               **     BPT5= .5%   POINT OF BEST-FIT DIST.    **
C               **     B1  =  1%   POINT OF BEST-FIT DIST.    **
C               **     B5  =  5%   POINT OF BEST-FIT DIST.    **
C               **     B10 = 10%   POINT OF BEST-FIT DIST.    **
C               **     B20 = 20%   POINT OF BEST-FIT DIST.    **
C               **     B50 = 50%   POINT OF BEST-FIT DIST.    **
C               **     B80 = 80%   POINT OF BEST-FIT DIST.    **
C               **     B90 = 90%   POINT OF BEST-FIT DIST.    **
C               **     B95 = 95%   POINT OF BEST-FIT DIST.    **
C               **     B99 = 99%   POINT OF BEST-FIT DIST.    **
C               **     B995= 99.5% POINT OF BEST-FIT DIST.    **
C               **     B999= 99.9% POINT OF BEST-FIT DIST.    **
C               ************************************************
C
      P=.001
      BPT1=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.005
      BPT5=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.01
      B1=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.05
      B5=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.10
      B10=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.20
      B20=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.50
      B50=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.80
      B80=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.90
      B90=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.95
      B95=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.99
      B99=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.995
      B995=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
      P=.999
      B999=ETA*(ALOG(1.0/(1.0-P)))**(1.0/BETA)
C
C               ****************************************
C               **  STEP 41--                         **
C               **  SAVE OLD SETTINGS FOR             **
C               **     HORIZONTAL AXIS PLOT SCALE     **
C               **     VERTICAL AXIS PLOT SCALE       **
C               **  CHANGE                            **
C               **     HORIZONTAL AXIS PLOT SCALE     **
C               **     TO LOG                         **
C               **  CHANGE                            **
C               **     VERTICAL AXIS PLOT SCALE       **
C               **     TO WEIBULL                     **
C               ****************************************
 
      IX1TSV=IX1TSC
      IX2TSV=IX2TSC
      IY1TSV=IY1TSC
      IY2TSV=IY2TSC
C
      IX1TSC='LOG'
      IX2TSC='LOG'
      IY1TSC='WEIB'
      IY2TSC='WEIB'
C
C               ****************************************
C               **  STEP 42--                         **
C               **  DETERMINE PLOT LIMITS FOR         **
C               **  PREDICTED LINE                    **
C               ****************************************
C
      P2=0.1
      P=P2/100.0
      ARG1=1.0/(1.0-P)
      TERM=ALOG(ARG1)
      ARG2=1.0/BETA
      PPF=ETA*TERM**ARG2
      XMIN=PPF
C
      P2=99.9
      P=P2/100.0
      ARG1=1.0/(1.0-P)
      TERM=ALOG(ARG1)
      ARG2=1.0/BETA
      PPF=ETA*TERM**ARG2
      XMAX=PPF
C
      XINC=(XMAX-XMIN)/100.0
C
      XMIN2=ALOG10(XMIN)
CCCCC XMIN3=AINT(XMIN2)
      IF(XMIN2.GE.0.0)XMIN3=AINT(XMIN2)
      IF(XMIN2.LT.0.0)XMIN3=(-AINT(-XMIN2+1.0))
      XMIN4=10.0**XMIN3+0.001
C
      XMAX2=ALOG10(XMAX)
CCCCC XMAX3=AINT(XMAX2)+1.0
      IF(XMAX2.GE.0.0)XMAX3=AINT(XMAX2)
      IF(XMAX2.LT.0.0)XMAX3=(-AINT(-XMAX2+1.0))
      XMAX3=XMAX3+1.0
      XMAX4=10.0**XMAX3-0.001
C
      X632=ETA
C
C               ****************************************
C               **  STEP 51--                         **
C               **  FORM PLOT COORDINATES             **
C               **     RAW (GOOD) DATA                **
C               **     PREDICTED LINE                 **
C               **     HORIZONTAL 63.2% LINE          **
C               **     VERTICAL   63.2% LINE          **
C               **     95% CONFIDENCE BAND            **
C               **     99% CONFIDENCE BAND            **
C               ****************************************
C
      J=0
      DO5110I=1,N
      IF(ITAGC2(I).EQ.0)GOTO5110
      J=J+1
      Y2(J)=WMR(I)
      X2(J)=YS(I)
      D2(J)=1.0
 5110 CONTINUE
C
      X=XMIN-XINC
CCCCC MARCH 1996.  CHECK THAT PREDICTED VALUE IS STRICTLY POSITIVE.
CCCCC IF NOT, INCREMENT UNTIL GET POSITIVE POINT.
      DO5120I=1,10000
      X=X+XINC
      IF(X.GT.XMAX)GOTO5129
      PRED=100.0*(1.0-EXP(-((X/ETA)**BETA)))
      IF(PRED.LE.0.0)THEN
        ZINC=XINC/500.
        XJUNK=X
        DO5125LL=1,500
          XJUNK=XJUNK+ZINC
          PRED=100.0*(1.0-EXP(-((XJUNK/ETA)**BETA)))
          IF(PRED.LE.0.0)GOTO5125
          J=J+1
          Y2(J)=PRED
          X2(J)=XJUNK
          D2(J)=2.0
          GOTO5128
 5125   CONTINUE
 5128   CONTINUE
      ELSE
        J=J+1
        Y2(J)=PRED
        X2(J)=X
        D2(J)=2.0
      ENDIF
 5120 CONTINUE
 5129 CONTINUE
C
      J=J+1
      Y2(J)=63.2
      X2(J)=XMIN4
      D2(J)=3.0
      J=J+1
      Y2(J)=63.2
      X2(J)=XMAX4
      D2(J)=3.0
C
      J=J+1
      Y2(J)=99.9
      X2(J)=X632
      D2(J)=4.0
      J=J+1
      Y2(J)=0.1
      X2(J)=X632
      D2(J)=4.0
C
      N2=J
      NPLOTV=3
C
C               ****************************************
C               **  STEP 61--                         **
C               **  RESTORE OLD SETTINGS FOR          **
C               **     HORIZONTAL AXIS PLOT SCALE     **
C               **     VERTICAL AXIS PLOT SCALE       **
C               ****************************************
C
CCCCC IX1TSC=IX1TSV
CCCCC IX2TSC=IX2TSV
CCCCC IY1TSC=IY1TSV
CCCCC IY2TSC=IY2TSV
C     (THIS RESTORATION MUST BE DONE IN MAIN)
C
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 DPWEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,MAXN,N2,IERROR
 9012 FORMAT('ICASPL,MAXN,N2,IERROR = ',A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)IX1TSC,IX2TSC,IY1TSC,IY2TSC
 9021 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IX1TSV,IX2TSV,IY1TSV,IY2TSV
 9022 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)AINTER,ASLOPE,SDINTE,SDSLOP
 9031 FORMAT('AINTER,ASLOPE,SDINTE,SDSLOP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)BETA,ETA,SDBETA,SDETA
 9032 FORMAT('BETA,ETA,SDBETA,SDETA = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)BPT1,BPT5,B1,B5
 9034 FORMAT('BPT1,BPT5,B1,B5 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)B10,B20,B50,B80,B90
 9035 FORMAT(' B10,B20,B50,B80,B90 = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)B95,B99,B995,B999
 9036 FORMAT('B95,B99,B995,B999 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)RESSD
 9037 FORMAT('RESSD = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)XMIN,XMIN2,XMIN3,XMIN4
 9041 FORMAT('XMIN,XMIN2,XMIN3,XMIN4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)XINC
 9042 FORMAT('XINC = ',E15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED     APRIL 1992
CCCCC WRITE(ICOUT,9043)YMIN,YMIN2,YMIN3,YMIN4
C9043 FORMAT('YMIN,YMIN2,YMIN3,YMIN4 = ',4E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)XMIN,XMIN2,XMIN3,XMIN4
 9043 FORMAT('XMIN,XMIN2,XMIN3,XMIN4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)ETA,X632
 9044 FORMAT('ETA,X632 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWEIG(IHARG,IHARG2,NUMARG,IDEFW1,IDEFW2,
     1IWEIG1,IWEIG2,IWEIGH,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE USER VARIABLE NAME IN WHICH
C              THE WEIGHTS FOR FITTING, PRE-FITTING, ANOVA, EC. RESIDE.
C              CHARACTERS 1 TO 4 OF THE SPECIFIED KNOT NAME
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IWEIG1;
C              CHARACTERS 5 TO 8 OF THE SPECIFIED KNOT NAME
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IWEIG2.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IHARG2 (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFW1 (A  HOLLERITH VARIABLE)
C                     --IDEFW2 (A  HOLLERITH VARIABLE)
C     OUTPUT ARGUMENTS--IWEIG1 (A  HOLLERITH VARIABLE)
C                     --IWEIG2 (A  HOLLERITH VARIABLE)
C                     --IWEIGH (A  HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IDEFW1
      CHARACTER*4 IDEFW2
      CHARACTER*4 IWEIG1
      CHARACTER*4 IWEIG2
      CHARACTER*4 IWEIGH
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
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
      IFOUND='NO'
      IERROR='NO'
C
      GOTO1110
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD1=IDEFW1
      IHOLD2=IDEFW2
      IWEIGH='OFF'
      GOTO1180
C
 1160 CONTINUE
      IHOLD1=IHARG(NUMARG)
      IHOLD2=IHARG2(NUMARG)
      IWEIGH='ON'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IWEIG1=IHOLD1
      IWEIG2=IHOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IWEIG1,IWEIG2
 1181 FORMAT('THE WEIGHTS VARIABLE HAS JUST BEEN DESIGNATED AS ',
     1A4,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IWEIGH.EQ.'OFF')WRITE(ICOUT,1182)
 1182 FORMAT('(THAT IS, THE EQUAL-WEIGHTS CASE IS BEING ASSUMED)')
      IF(IWEIGH.EQ.'OFF')CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPWICC(IHARG,IHARG2,IARGT,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE WINDOW CORNER COORDINATES
C              (LOWER LEFT AND UPPER RIGHT)
C              WHICH IN TURN WILL DEFINE THE SIZE AND SHAPE
C              OF THE PLOT WINDOW.
C              THE 2 PAIRS OF COORDINATES ARE CONTAINED IN THE
C              4 VARIABLES    PWXMIN,PWYMIN    AND    PWXMAX,PWYMAX
C      NOTE--THE PLOT WINDOW INCLUDES THE AREA INSIDE THE FRAME
C            AND THE AREA OUTSIDE THE FRAME.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--PWXMIN = X COOR. FOR LOWER LEFT  CORNER
C                     --PWXMAX = X COOR. FOR UPPER RIGHT CORNER
C                     --PWYMIN = Y COOR. FOR LOWER LEFT  CORNER
C                     --PWYMAX = Y COOR. FOR UPPER RIGHT CORNER
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1996. NO ARGUMENTS EQUAL DEFAULT
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 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 ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      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
      ISUBN1='DPWI'
      ISUBN2='CC  '
C
      IFOUND='NO'
      IERROR='NO'
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 DPWICC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IFOUND,IERROR
   52 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   53 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  TREAT THE    WINDOW    COORDINATES    CASE  **
C               **************************************************
C
      IF(NUMARG.LE.0)GOTO1150
      GOTO1110
C
 1110 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
CCCCC DECEMBER 1996.  IF NO ARGUMENTS, IHARG(NUMARG) = 'COOR'
      IF(IHARG(NUMARG).EQ.'COOR')GOTO1150
      IF(NUMARG.GE.2)GOTO1175
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPCORN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR WINDOW CORNER COORDINATES ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE IT IS DESIRED TO POSITION   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE LOWER LEFT CORNER OF THE WINDOW')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      10% ACROSS THE PAGE AND 20% UP THE PAGE, AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THE UPPER RIGHT CORNER OF THE WINDOW')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      90% ACROSS THE PAGE AND 80% UP THE PAGE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      WINDOW CORNER COORDINATES 10 20 90 80')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      WINDOW 10 20 90 80')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PWXMIN=0.
      PWYMIN=0.
      PWXMAX=100.
      PWYMAX=100.
      GOTO1180
C
 1175 CONTINUE
      DO1176J=2,NUMARG
      IF(IARGT(J).EQ.'NUMB')GOTO1177
      GOTO1178
 1177 CONTINUE
      IF(J.EQ.2)PWXMIN=ARG(J)
      IF(J.EQ.3)PWYMIN=ARG(J)
      IF(J.EQ.4)PWXMAX=ARG(J)
      IF(J.EQ.5)PWYMAX=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.2)PWXMIN=VALUE(ILOC)
      IF(J.EQ.3)PWYMIN=VALUE(ILOC)
      IF(J.EQ.4)PWXMAX=VALUE(ILOC)
      IF(J.EQ.5)PWYMAX=VALUE(ILOC)
 1176 CONTINUE
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('THE WINDOW CORNER COORDINATES HAVE JUST BEEN SET ',
     1'AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)PWXMIN,PWYMIN
 1186 FORMAT('    (X,Y) FOR LOWER LEFT  CORNER OF WINDOW = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1187)PWXMAX,PWYMAX
 1187 FORMAT('    (X,Y) FOR UPPER RIGHT CORNER OF WINDOW = ',2E15.7)
      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 DPWICC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9013 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWIDT(IHARG,IARGT,ARG,NUMARG,
     1PDEFWI,
     1PTEXWI,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE WIDTH FOR TEXT CHARACTERS.
C              THE WIDTH FOR TEXT CHARACTERS WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PTEXWI.
C     NOTE--THE WIDTH IS IN STANDARDIZED UNITS (0.0 TO 100.0).
C     NOTE--THE WIDTH DOES NOT INCLUDE BETWEEN-LINE GAP.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PDEFWI
C                     --IBUGD2
C     OUTPUT ARGUMENTS--PTEXWI
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--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 IARGT
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      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(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWIDT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PDEFWI
   53 FORMAT('PDEFWI = ',E15.7)
      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),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
   90 CONTINUE
C
C               *****************************
C               **  TREAT THE WIDTH CASE  **
C               *****************************
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      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.'?')GOTO8100
C
      IF(NUMARG.GE.1.AND.IARGT(NUMARG).EQ.'NUMB')
     1GOTO1160
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPWIDT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR WIDTH ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE IT IS DESIRED THAT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE TEXT CHARACTERS HAVE A WIDTH OF 5')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      (WHERE THE HORIZONTAL SCREEN UNITS RANGE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      FROM 0 TO 100, AND WHERE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      THE BETWEEN-CHARACTER GAP IS NOT INCLUDED),')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('           WIDTH 5 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PTEXWI=PDEFWI
      GOTO1180
C
 1160 CONTINUE
      PTEXWI=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE WIDTH (FOR TEXT CHARACTERS)  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PTEXWI
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 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)PTEXWI
 8111 FORMAT('THE CURRENT (TEXT) WIDTH  IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)PDEFWI
 8112 FORMAT('THE DEFAULT (TEXT) WIDTH  IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      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 DPWIDT--')
      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)PTEXWI
 9013 FORMAT('PTEXWI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWILC(XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A 1-SAMPLE OR PAIRED 2-SAMPLE SIGNED RANK TEST
C     EXAMPLE--SIGNED RANK TEST Y1 Y2
C              SIGNED RANK TEST Y1 Y2 D0
C              SIGNED RANK TEST Y MU
C              SIGNED RANK TEST MU Y
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-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--99/6
C     ORIGINAL VERSION--JUNE      1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
      CHARACTER*4 IH31
      CHARACTER*4 IH32
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
      CHARACTER*4 IUSE3
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
C
      DIMENSION YRANK(MAXOBV)
      EQUIVALENCE(GARBAG(IGARB1),YRANK(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='DPWI'
      ISUBN2='LC  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
      IUSE3='-999'
C
      NUMVAR=(-999)
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=5
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ***************************************
C               **  TREAT THE SIGNED RANK TEST CASE  **
C               ***************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'SIGN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWILC--')
      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 ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS COULD BE A VARIABLE,        **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IF(IARGT(1).EQ.'NUMB')GOTO1110
      IHWUSE='VORP'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO1110
      GOTO1120
 1110 CONTINUE
      VALUE1=ARG(1)
      IUSE1='P'
      GOTO1190
 1120 CONTINUE
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
      GOTO1190
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPWILC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH A SIGNED RANK TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS COULD BE A VARIABLE,        **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IF(IARGT(2).EQ.'NUMB')GOTO2110
      IHWUSE='VORP'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO2110
      GOTO2120
 2110 CONTINUE
      VALUE2=ARG(2)
      IUSE2='P'
      GOTO2190
 2120 CONTINUE
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
      GOTO2190
 2190 CONTINUE
C
C               *******************************************************
C               **  STEP 22--                                        **
C               **  IF ARGUMENT 2 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2) **
C               **  FOR ARGUMENT 2 EQUALS NUMBER OF OBSERVATIONS     **
C               **  FOR VARIABLE 1 (N1)                              **
C               *******************************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.NE.'V')GOTO2290
      IF(N2.GE.MINN2)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPWILC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (FOR WHICH A SIGNED RANK TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)MINN2
 2215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)
 2216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)IH21,IH22
 2217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2218)N2
 2218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2219)
 2219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2220)(IANS(I),I=1,IWIDTH)
 2220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2290 CONTINUE
C
C               ****************************************
C               **  STEP 23--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 3  **
C               **  THIS IS AN OPTIONAL ARGUMENT, BUT **
C               **  IF PRESENT MUST BE A NUMBER OR A  **
C               **  PARAMETER                         **
C               ****************************************
C
      ISTEPN='31'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      D0=0.0
      IF(NUMARG.LT.3)GOTO2390
      IH31=IHARG(3)
      IH32=IHARG2(3)
      IF(IH31.EQ.'SUBS'.AND.IH32.EQ.'ET  ')GOTO2390
      IF(IH31.EQ.'FOR '.AND.IH32.EQ.'    ')GOTO2390
      IF(IH31.EQ.'EXCE'.AND.IH32.EQ.'PT  ')GOTO2390
      IF(IARGT(3).EQ.'NUMB')GOTO2310
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH31,IH32,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      D0=VALUE(ILOCV)
      GOTO2390
 2310 CONTINUE
      D0=ARG(3)
      GOTO2390
 2390 CONTINUE
C
C               *****************************************************
C               **  STEP 31--                                      **
C               **  FOR A SIGNED RANK TEST,                        **
C               **  AT LEAST ONE OF THE FIRST 2 ARGUMENTS          **
C               **  MUST BE A VARIABLE.                            **
C               **  CHECK FOR THIS.                                **
C               **  IF ONLY 1 ARGUMENT IS A VARIABLE,              **
C               **  THIS IMPLIES A 1-SAMPLE SIGN TEST.             **
C               **  (IF SO, COPY THE OTHER ARGUMENT AS THE TARGET  **
C               **  MU VALUE).                                     **
C               **  IF BOTH ARGUMENTS ARE VARIABLES,               **
C               **  THIS IMPLIES A 2-SAMPLE SIGN TEST.             **
C               *****************************************************
C
      ISTEPN='31'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'WILC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.EQ.'V'.AND.IUSE2.NE.'V')GOTO3110
      IF(IUSE1.NE.'V'.AND.IUSE2.EQ.'V')GOTO3120
      IF(IUSE1.EQ.'V'.AND.IUSE2.EQ.'V')GOTO3130
      GOTO3140
C
 3110 CONTINUE
      NUMVAR=1
      ILOCV=1
      AMU0=VALUE2
      D0=0.0
      GOTO3190
 3120 CONTINUE
      NUMVAR=1
      ILOCV=2
      AMU0=VALUE1
      D0=0.0
      GOTO3190
 3130 CONTINUE
      NUMVAR=2
      ILOCV=(-999)
      AMU0=(-999.0)
      GOTO3190
C
 3140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3141)
 3141 FORMAT('***** ERROR IN DPWILC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3142)
 3142 FORMAT('      FOR A SIGNED RANK TEST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3143)
 3143 FORMAT('      EITHER THE FIRST ARGUMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3144)
 3144 FORMAT('      OR THE SECOND ARGUMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3145)
 3145 FORMAT('      (OR BOTH ARGUMENTS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3146)
 3146 FORMAT('      MUST BE A VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3147)
 3147 FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3148)
 3148 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3149)
 3149 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3150)(IANS(I),I=1,IWIDTH)
 3150 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3190 CONTINUE
C
C               *****************************************************
C               **  STEP 32--                                      **
C               **  FOR A 2-SAMPLE SIGNED RANK TEST,               **
C               **  BOTH VARIABLES MUST HAVE THE SAME NUMBER OF    **
C               **  OBSERVATIONS (I.E., PAIRED SAMPLES)            **
C               *****************************************************
C
      ISTEPN='32'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.EQ.N2.OR.NUMVAR.EQ.1)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3211)
 3211 FORMAT('***** ERROR IN DPSIGN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3212)
 3212 FORMAT('      FOR A 2-SAMPLE SIGNED RANK TEST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3213)
 3213 FORMAT('      BOTH VARIABLES MUST HAVE THE SAME NUMBER OF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3218)
 3218 FORMAT('      OBSERVATIONS.  SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3220)IH11,IH12,N1
 3220 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3222)IH21,IH22,N2
 3222 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3239)
 3239 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3250)(IANS(I),I=1,IWIDTH)
 3250 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA FROM SAMPLE 1.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'WILC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPWILC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH A SIGNED RANK TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH)
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 42--                                **
C               **  TEMPORARILY FORM THE VARIABLE X(.)       **
C               **  WHICH WILL HOLD THE DATA FROM SAMPLE 2.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE2.NE.'V')GOTO4290
C
      ISTEPN='42'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'WILC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4210
      IF(ICASEQ.EQ.'SUBS')GOTO4220
      IF(ICASEQ.EQ.'FOR')GOTO4230
C
 4210 CONTINUE
      DO4215I=1,N2
      ISUB(I)=1
 4215 CONTINUE
      NQ=N2
      GOTO4250
C
 4220 CONTINUE
      NIOLD=N2
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4250
C
 4230 CONTINUE
      NIOLD=N2
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4250
C
 4250 CONTINUE
      IF(NQ.GE.MINN2)GOTO4260
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4251)
 4251 FORMAT('***** ERROR IN DPWILC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4252)
 4252 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4253)IH21,IH22
 4253 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4254)
 4254 FORMAT('      (FOR WHICH A SIGNED RANK TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4255)
 4255 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4256)MINN2
 4256 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4257)NQ
 4257 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4258)
 4258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH)
 4259 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4260 CONTINUE
      J=0
      IMAX=N2
      IF(NQ.LT.N2)IMAX=NQ
      DO4270I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4270
      J=J+1
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
 4270 CONTINUE
      NS2=J
C
 4290 CONTINUE
C
      IF(NS1.EQ.NS2.OR.NUMVAR.LT.2)GOTO4390
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4351)
 4351 FORMAT('***** ERROR IN DPWILC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4352)
 4352 FORMAT('      AFTER THE APPROPRIATE SUBSETS HAVE BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4353)
 4353 FORMAT('      THE NUMBER OF OBSERVATIONS FROM THE TWO ',
     1'VARIABLES ARE NOT EQUAL.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4354)IH11,IH12,NS1
 4354 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4355)IH21,IH22,NS2
 4355 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4358)
 4358 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4359)(IANS(I),I=1,IWIDTH)
 4359 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4390 CONTINUE
C
C               ****************************************
C               **  STEP 52--                         **
C               **  CARRY OUT  THE SIGNED RANK TEST   **
C               ****************************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'WILC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'WILC')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPWILC, AS WE ARE ABOUT TO CALL DPWIL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      DO5217I=1,NS2
      WRITE(ICOUT,5218)I,X(I)
 5218 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5217 CONTINUE
      WRITE(ICOUT,5231)AMU0,D0,IBUGA3
 5231 FORMAT('AMU0,D0,IBUGA3 = ',2E15.7,A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPWIL2(Y,NS1,X,YRANK,AMU0,D0,NUMVAR,ILOCV,
     1XTEMP1,XTEMP2,MAXNXT,
     1STATVA,STTCD2,
     1CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
     1ILOW,IUPP,ITWO,
     1IBUGA3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'WIL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPWI'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDF'
      VALUE0=STTCD2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW90'
      VALUE0=CUTL90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP90'
      VALUE0=CUTU90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW95'
      VALUE0=CUTL95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP95'
      VALUE0=CUTU95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW99'
      VALUE0=CUTL99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP99'
      VALUE0=CUTU99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CONC'
      IH2='LOW '
      VALUE0=REAL(ILOW)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CONC'
      IH2='UPP '
      VALUE0=REAL(IUPP)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CONC'
      IH2='TWO '
      VALUE0=REAL(ITWO)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
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 DPWILC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWIL2(Y1,N1,Y2,YRANK,AMU0,D0,NUMVAR,ILOCV,
     1XTEMP,YTEMP,MAXNXT,
     1STATVA,STTCD2,
     1CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
     1ILOW,IUPP,ITWO,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT A 2-SAMPLE PAIRED SIGNED RANK
C              TEST
C     EXAMPLE--SIGNED RANK TEST Y1 Y2
C              SIGNED RANK TEST Y1 Y2 D0
C     SAMPLE 1 IS IN INPUT VECTOR Y1
C              (WITH N1 OBSERVATIONS).
C     SAMPLE 2 IS IN INPUT VECTOR Y2
C              (WITH N2 OBSERVATIONS).
C              (BUT N1 SHOULD EQUAL N2)
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-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--99/6
C     ORIGINAL VERSION--JUNE      1999.
C     ORIGINAL VERSION--AUGIST    2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION YRANK(*)
      DIMENSION XTEMP(*)
      DIMENSION YTEMP(*)
C
      DIMENSION C1VL01(30)
      DIMENSION C1VL05(30)
CCCCC DIMENSION C1VL10(30)
      DIMENSION C2VL01(30)
      DIMENSION C2VL05(30)
      DIMENSION C2VL10(30)
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
      DATA (C1VL01(I),I=1,30) /
     1  0,   0,   0,    0,    0,    0,    0,    2,    3,    5,
     1  7,  10,  13,   16,   20,   24,   28,   33,   38,   43,
     1 49,  56,  62,   69,   77,   85,   93,  102,  111,  120/
C
      DATA (C1VL05(I),I=1,30) /
     1  0,   0,   0,    0,    1,    2,    4,    6,    8,   11,
     1 14,  17,  21,   26,   30,   36,   41,   47,   54,   60,
     1 68,  75,  83,   92,  101,  110,  120,  130,  141,  152/
C
CCCCC NEED TO GET VALUES FOR 1-SIDED 10% TEST
CCCCC DATA (C1VL10(I),I=1,30) /
CCCCC1  0,   0,   0,    0,    1,    2,    4,    6,    8,   11,
CCCCC1 14,  17,  21,   26,   30,   36,   41,   47,   54,   60,
CCCCC1 68,  75,  83,   92,  101,  110,  120,  130,  141,  152/
C
CCCCC DATA (C2VL01(I),I=1,30) /
      DATA (C2VL01(I),I=1,16) /
     1  0,   0,   0,    0,    0,    0,    0,    0,    2,    3,
     1  5,   7,  10,   13,   16,   19/
CCCCC1  5,   7,  10,   13,   16,   19,   41,   47,   54,   60,
CCCCC1 68,  75,  83,   92,  101,  110,  120,  130,  141,  152/
C
      DATA (C2VL05(I),I=1,30) /
     1  0,   0,   0,    0,    0,    1,    2,    4,    6,    8,
     1 11,  14,  17,   21,   25,   30,   35,   40,   46,   52,
     1 59,  66,  73,   81,   90,   98,  107,  117,  127,  137/
C
      DATA (C2VL10(I),I=1,30) /
     1  0,   0,   0,    0,    1,    2,    4,    6,    8,   11,
     1 14,  17,  21,   26,   30,   36,   41,   47,   54,   60,
     1 68,  75,  83,   92,  101,  110,  120,  130,  141,  152/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPWI'
      ISUBN2='L2  '
C
      IERROR='NO'
C
      N=(-99)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'WIL2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPWIL2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,53)NUMVAR,ILOCV,AMU0,D0
   53 FORMAT('NUMVAR,ILOCV,AMU0,D0 = ',I8,I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N1
   55 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N1
      WRITE(ICOUT,57)I,Y1(I),Y2(I)
   57 FORMAT('I,Y1(I),Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPWIL2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N1
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N1.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPWIL2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y1(1)
      DO1135I=2,N1
      IF(Y1(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPWIL2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(NUMVAR.LT.2)GOTO1239
      HOLD=Y2(1)
      DO1235I=2,N1
      IF(Y2(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM DPWIL2--VARIABLE 2 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
 1290 CONTINUE
C
C               ************************************
C               **   STEP 21--                    **
C               **   BRANCH DEPENDING ON WHETHER  **
C               **   1-SAMPLE SIGNED RANK TEST OR **
C               **   2-SAMPLE SIGNED RANK TEST.   **
C               ************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.EQ.1)GOTO3100
      GOTO4100
C
 3100 CONTINUE
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'WIL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
CCCCC MARCH 2005.  DON'T NEED BOTH AMU0 AND D0.
C
      NTEMP=0
      DO3200I=1,N1
CCCCC   ADIFF1=Y1(I) - AMU0 - D0
CCCCC   ADIFF2=ABS(Y1(I) - AMU0 - D0)
        ADIFF1=Y1(I) - AMU0
        ADIFF2=ABS(Y1(I) - AMU0)
        IF(ADIFF1.GT.0.0)THEN
          NTEMP=NTEMP+1
          XTEMP(NTEMP)=1.0
          YTEMP(NTEMP)=ADIFF2
        ELSEIF(ADIFF1.LT.0.0)THEN
          NTEMP=NTEMP+1
          XTEMP(NTEMP)=-1.0
          YTEMP(NTEMP)=ADIFF2
        ENDIF
 3200 CONTINUE
      CALL RANK(YTEMP,NTEMP,IWRITE,YRANK,IBUGA3,IERROR)
C
      WMINUS=0.0
      WPLUS=0.0
      DO3300I=1,NTEMP
        ADIFF1=XTEMP(I)
        IF(ADIFF1.LT.0.0)THEN
          WMINUS=WMINUS+YRANK(I)
        ELSEIF(ADIFF1.GT.0.0)THEN
          WPLUS=WPLUS+YRANK(I)
        ENDIF
 3300 CONTINUE
C
      W=MIN(WMINUS,WPLUS)
      STATVA=W
C
      AN=REAL(NTEMP)
      AMEAN=AN*(AN+1.0)/4.0
      ASD=SQRT(AN*(AN+1.0)*(2.0*AN+1.0)/24.0)
C
      STTCD1=0.0
      STTCD2=0.0
      STTCD3=0.0
      IF(NTEMP.GT.16)THEN
        CALL NORCDF((W-AMEAN)/ASD,STTCD2)
        CALL NORCDF((WPLUS-AMEAN)/ASD,STTCD1)
        CALL NORCDF((WMINUS-AMEAN)/ASD,STTCD3)
      ENDIF
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
      ILOW=-1
      IUPP=-1
      ITWO=-1
C
      IF(NTEMP.GT.30)THEN
        CALL NORPPF(.050,CUTL90)
        CUTL90=AMEAN + ASD*CUTL90
        CALL NORPPF(.950,CUTU90)
        CUTU90=AMEAN + ASD*CUTU90
        CALL NORPPF(.025,CUTL95)
        CUTL95=AMEAN + ASD*CUTL95
        CALL NORPPF(.975,CUTU95)
        CUTU95=AMEAN + ASD*CUTU95
        CALL NORPPF(.005,CUTL99)
        CUTL99=AMEAN + ASD*CUTL99
        CALL NORPPF(.995,CUTU99)
        CUTU99=AMEAN + ASD*CUTU99
      ELSE
        CUTL90=C2VL10(NTEMP)
        CUTU90=C2VL10(NTEMP)
        CUTL95=C2VL05(NTEMP)
        CUTU95=C2VL05(NTEMP)
        CUTL99=C2VL01(NTEMP)
        CUTU99=C2VL01(NTEMP)
      ENDIF
C
      IF(NTEMP.GT.30)THEN
CCCCC   IF(STTCD2.GT.0.025.AND.STTCD2.LT.0.975)ICONC2='ACCEPT'
CCCCC   IF(STTCD1.LT.0.950)ICONC1='ACCEPT'
CCCCC   IF(STTCD3.LT.0.950)ICONC3='ACCEPT'
        IF(STTCD2.LE.0.025.OR.STTCD2.GE.0.975)THEN
          ICONC2='ACCEPT'
          ITWO=1
        ENDIF
        IF(STTCD1.LE.0.05)THEN
          ICONC1='ACCEPT'
          ILOW=1
        ENDIF
        IF(STTCD3.LE.0.05)THEN
          ICONC3='ACCEPT'
          IUPP=1
        ENDIF
      ELSE
CCCCC   IF(WPLUS.GT.C1VL05(NTEMP))ICONC3='ACCEPT'
CCCCC   IF(W.GT.C2VL05(NTEMP))ICONC2='ACCEPT'
CCCCC   IF(WMINUS.GT.C1VL05(NTEMP))ICONC1='ACCEPT'
        IF(WPLUS.LE.C1VL05(NTEMP))THEN
          ICONC3='ACCEPT'
          IUPP=1
        ENDIF
        IF(W.LE.C2VL05(NTEMP))THEN
          ICONC2='ACCEPT'
          ITWO=1
        ENDIF
        IF(WMINUS.LE.C1VL05(NTEMP))THEN
          ICONC1='ACCEPT'
          ILOW=1
        ENDIF
      ENDIF
C
C               ****************************************
C               **   STEP 32--                        **
C               **   WRITE OUT EVERYTHING             **
C               **   FOR A 1-SAMPLE SIGNED RANK TEST  **
C               ****************************************
C
      ISTEPN='32'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO4290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3211)
 3211 FORMAT(
     1'                 WILCOXON SIGNED RANK TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3212)
 3212 FORMAT(
     1'                         (1-SAMPLE)')
      CALL DPWRST('XXX','WRIT')
CCCCC IF(D0.EQ.0.0)THEN
      IF(AMU0.EQ.0.0)THEN
        WRITE(ICOUT,3213)
 3213   FORMAT('NULL HYPOTHESIS UNDER TEST--',
     1         'POPULATION MEAN MU1 = 0')
        CALL DPWRST('XXX','WRIT')
      ELSE
CCCCC   WRITE(ICOUT,3215)D0
        WRITE(ICOUT,3215)AMU0
 3215   FORMAT('NULL HYPOTHESIS UNDER TEST--',
     1         'POPULATION MEAN MU1 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,3221)N1
 3221 FORMAT('SAMPLE SIZE                             = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3222)NTEMP
 3222 FORMAT('NUMBER OF NON-ZERO DIFFERENCES          = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3223)WPLUS
 3223 FORMAT('SUM OF POSITIVE RANKS (W+)              = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3224)WMINUS
 3224 FORMAT('SUM OF NEGATIVE RANKS (W-)              = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3225)W
 3225 FORMAT('WILCOXON SIGNED RANK TEST STATITIC (W)  = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      IF(NTEMP.GE.16)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3226)AMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3228)ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3229)(W-AMEAN)/ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3230)(WPLUS-AMEAN)/ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3231)(WMINUS-AMEAN)/ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3232)STTCD2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3233)STTCD1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3235)STTCD3
        CALL DPWRST('XXX','WRIT')
      ENDIF
 3227 FORMAT('NORMAL APPROXIMATIONS (IF N > 15)')
 3226 FORMAT('MEAN OF SIGNED RANK STATISTIC           = ',G15.7)
 3228 FORMAT('SD OF SIGNED RANK STATISTIC             = ',G15.7)
 3229 FORMAT('NORMAL APPROXIMATION = (W  - MEAN)/SD   = ',G15.7)
 3230 FORMAT('NORMAL APPROXIMATION = (W+ - MEAN)/SD   = ',G15.7)
 3231 FORMAT('NORMAL APPROXIMATION = (W- - MEAN)/SD   = ',G15.7)
 3232 FORMAT('SIGNED RANK STATISTIC CDF VALUE (W)     = ',G15.7)
 3233 FORMAT('SIGNED RANK STATISTIC CDF VALUE (W+)    = ',G15.7)
 3235 FORMAT('SIGNED RANK STATISTIC CDF VALUE (W-)    = ',G15.7)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,3258)
 3258 FORMAT(
     1'               ALTERNATIVE-             ALTERNATIVE-')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3259)
 3259 FORMAT(
     1'ALTERNATIVE-   HYPOTHESIS               HYPOTHESIS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3261)
 3261 FORMAT(
     1'HYPOTHESIS     ACCEPTANCE INTERVAL      CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      IF(NTEMP.GT.30)THEN
      WRITE(ICOUT,3263)ICONC2
 3263 FORMAT(
     1'MU1 <> MU2     (W)  (0,0.025), (0.975,1)  ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3262)ICONC1
 3262 FORMAT(
     1'MU1 < MU2      (W+) (0,0.05)              ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3264)ICONC3
 3264 FORMAT(
     1'MU1 > MU2      (W-) (0,0.05)              ',A6)
      CALL DPWRST('XXX','WRIT')
      ELSE
      WRITE(ICOUT,3273)C2VL05(NTEMP),ICONC2
 3273 FORMAT(
     1'MU1 <> MU2     W  <= ',G15.7,'    ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3272)C1VL05(NTEMP),ICONC1
 3272 FORMAT(
     1'MU1 < MU2      W- <= ',G15.7,'    ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3274)C1VL05(NTEMP),ICONC3
 3274 FORMAT(
     1'MU1 > MU2      W+ <= ',G15.7,'    ',A6)
      CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
 3290 CONTINUE
      GOTO9000
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'WIL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      NTEMP=0
      DO4200I=1,N1
        ADIFF1=Y1(I) - Y2(I) - D0
        ADIFF2=ABS(Y1(I) - Y2(I) - D0)
        IF(ADIFF1.GT.0.0)THEN
          NTEMP=NTEMP+1
          XTEMP(NTEMP)=1.0
          YTEMP(NTEMP)=ADIFF2
        ELSEIF(ADIFF1.LT.0.0)THEN
          NTEMP=NTEMP+1
          XTEMP(NTEMP)=-1.0
          YTEMP(NTEMP)=ADIFF2
        ENDIF
 4200 CONTINUE
      CALL RANK(YTEMP,NTEMP,IWRITE,YRANK,IBUGA3,IERROR)
C
      WMINUS=0.0
      WPLUS=0.0
      DO4300I=1,NTEMP
        ADIFF1=XTEMP(I)
        IF(ADIFF1.LT.0.0)THEN
          WMINUS=WMINUS+YRANK(I)
        ELSEIF(ADIFF1.GT.0.0)THEN
          WPLUS=WPLUS+YRANK(I)
        ENDIF
 4300 CONTINUE
C
      W=MIN(WMINUS,WPLUS)
      STATVA=W
C
      AN=REAL(NTEMP)
      AMEAN=AN*(AN+1.0)/4.0
      ASD=SQRT(AN*(AN+1.0)*(2.0*AN+1.0)/24.0)
C
      STTCD1=0.0
      STTCD2=0.0
      STTCD3=0.0
      IF(NTEMP.GT.16)THEN
        CALL NORCDF((W-AMEAN)/ASD,STTCD2)
        CALL NORCDF((WPLUS-AMEAN)/ASD,STTCD1)
        CALL NORCDF((WMINUS-AMEAN)/ASD,STTCD3)
      ENDIF
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
      ILOW=-1
      IUPP=-1
      ITWO=-1
C
      IF(NTEMP.GT.30)THEN
        CALL NORPPF(.050,CUTL90)
        CUTL90=AMEAN + ASD*CUTL90
        CALL NORPPF(.950,CUTU90)
        CUTU90=AMEAN + ASD*CUTU90
        CALL NORPPF(.025,CUTL95)
        CUTL95=AMEAN + ASD*CUTL95
        CALL NORPPF(.975,CUTU95)
        CUTU95=AMEAN + ASD*CUTU95
        CALL NORPPF(.005,CUTL99)
        CUTL99=AMEAN + ASD*CUTL99
        CALL NORPPF(.995,CUTU99)
        CUTU99=AMEAN + ASD*CUTU99
      ELSE
        CUTL90=C2VL10(NTEMP)
        CUTU90=C2VL10(NTEMP)
        CUTL95=C2VL05(NTEMP)
        CUTU95=C2VL05(NTEMP)
        CUTL99=C2VL01(NTEMP)
        CUTU99=C2VL01(NTEMP)
      ENDIF
C
      IF(NTEMP.GT.30)THEN
CCCCC   IF(STTCD2.GT.0.025.AND.STTCD2.LT.0.975)ICONC2='ACCEPT'
CCCCC   IF(STTCD1.LT.0.950)ICONC1='ACCEPT'
CCCCC   IF(STTCD3.LT.0.950)ICONC3='ACCEPT'
        IF(STTCD2.LE.0.025.OR.STTCD2.GE.0.975)THEN
          ICONC2='ACCEPT'
          ITWO=1
        ENDIF
        IF(STTCD1.LE.0.05)THEN
          ICONC1='ACCEPT'
          ILOW=1
        ENDIF
        IF(STTCD3.LE.0.05)THEN
          ICONC3='ACCEPT'
          IUPP=1
        ENDIF
      ELSE
CCCCC   IF(WPLUS.GT.C1VL05(NTEMP))ICONC3='ACCEPT'
CCCCC   IF(W.GT.C2VL05(NTEMP))ICONC2='ACCEPT'
CCCCC   IF(WMINUS.GT.C1VL05(NTEMP))ICONC1='ACCEPT'
        IF(WPLUS.LE.C1VL05(NTEMP))THEN
          ICONC3='ACCEPT'
          IUPP=1
        ENDIF
        IF(W.LE.C2VL05(NTEMP))THEN
          ICONC2='ACCEPT'
          ITWO=1
        ENDIF
        IF(WMINUS.LE.C1VL05(NTEMP))THEN
          ICONC1='ACCEPT'
          ILOW=1
        ENDIF
      ENDIF
     
C
C               ****************************************
C               **   STEP 42--                        **
C               **   WRITE OUT EVERYTHING             **
C               **   FOR A 2-SAMPLE SIGNED RANK TEST  **
C               ****************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO4290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4211)
 4211 FORMAT(
     1'                 WILCOXON SIGNED RANK TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4212)
 4212 FORMAT(
     1'                    (PAIRED 2-SAMPLE)')
      CALL DPWRST('XXX','WRIT')
      IF(D0.EQ.0.0)THEN
        WRITE(ICOUT,4213)
 4213   FORMAT('NULL HYPOTHESIS UNDER TEST--',
     1         'POPULATION MEANS MU1 = MU2')
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,4215)D0
 4215   FORMAT('NULL HYPOTHESIS UNDER TEST--',
     1         'POPULATION MEANS MU1 - MU2 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,4221)N1
 4221 FORMAT('SAMPLE SIZE                             = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4222)NTEMP
 4222 FORMAT('NUMBER OF NON-ZERO DIFFERENCES          = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4223)WPLUS
 4223 FORMAT('SUM OF POSITIVE RANKS (W+)              = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4224)WMINUS
 4224 FORMAT('SUM OF NEGATIVE RANKS (W-)              = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4225)W
 4225 FORMAT('WILCOXON SIGNED RANK TEST STATITIC (W)  = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      IF(NTEMP.GE.16)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)AMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4228)ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)(W-AMEAN)/ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4230)(WPLUS-AMEAN)/ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)(WMINUS-AMEAN)/ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4232)STTCD2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)STTCD1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4235)STTCD3
        CALL DPWRST('XXX','WRIT')
      ENDIF
 4227 FORMAT('NORMAL APPROXIMATIONS (IF N > 15)')
 4226 FORMAT('MEAN OF SIGNED RANK STATISTIC           = ',G15.7)
 4228 FORMAT('SD OF SIGNED RANK STATISTIC             = ',G15.7)
 4229 FORMAT('NORMAL APPROXIMATION = (W  - MEAN)/SD   = ',G15.7)
 4230 FORMAT('NORMAL APPROXIMATION = (W+ - MEAN)/SD   = ',G15.7)
 4231 FORMAT('NORMAL APPROXIMATION = (W- - MEAN)/SD   = ',G15.7)
 4232 FORMAT('SIGNED RANK STATISTIC CDF VALUE (W)     = ',G15.7)
 4233 FORMAT('SIGNED RANK STATISTIC CDF VALUE (W+)    = ',G15.7)
 4235 FORMAT('SIGNED RANK STATISTIC CDF VALUE (W-)    = ',G15.7)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,4258)
 4258 FORMAT('               ALTERNATIVE-             ALTERNATIVE-')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4259)
 4259 FORMAT('ALTERNATIVE-   HYPOTHESIS               HYPOTHESIS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4261)
 4261 FORMAT('HYPOTHESIS     ACCEPTANCE INTERVAL      CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      IF(NTEMP.GT.30)THEN
      WRITE(ICOUT,4263)ICONC2
 4263 FORMAT(
     1'MU1 <> MU2     (W)  (0,0.025), (0.975,1)  ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4262)ICONC1
 4262 FORMAT(
     1'MU1 < MU2      (W+) (0,0.05)              ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4264)ICONC3
 4264 FORMAT(
     1'MU1 > MU2      (W-) (0,0.05)              ',A6)
      CALL DPWRST('XXX','WRIT')
      ELSE
      WRITE(ICOUT,4273)C2VL05(NTEMP),ICONC2
 4273 FORMAT(
     1'MU1 <> MU2     W  <= ',G15.7,'    ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4272)C1VL05(NTEMP),ICONC1
 4272 FORMAT(
     1'MU1 < MU2      W- <= ',G15.7,'    ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4274)C1VL05(NTEMP),ICONC3
 4274 FORMAT(
     1'MU1 > MU2      W+ <= ',G15.7,'    ',A6)
      CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
 4290 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'WIL2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWIL2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9013)AMU0,D0,NUMVAR,ILOCV
 9013 FORMAT('AMU0,D0,NUMVAR,ILOCV = ',2E15.7,I8,I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N1
 9015 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N1
      WRITE(ICOUT,9017)I,Y1(I),Y2(I)
 9017 FORMAT('I,Y1(I),Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWIPO(IHARG,NUMARG,IDEFWP,IWINPO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE WINDOW POINTER
C              THE WINDOW POINTER WILL BE PLACED
C              IN THE HOLLERITH VARIABLE IWINPO.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFWP
C     OUTPUT ARGUMENTS--IWINPO
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--90/9
C     ORIGINAL VERSION--AUGUST 1990.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFWP
      CHARACTER*4 IWINPO
C
      CHARACTER*4 IBUGP2
      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(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
      IF(NUMARG.GE.2)GOTO1110
      GOTO1199
C
 1110 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
      GOTO1160
C
 1150 CONTINUE
      IWINPO=IDEFWP
      GOTO1180
C
 1160 CONTINUE
      IWINPO=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IWINPO
 1181 FORMAT('THE WINDOW POINTER HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPWISY(IHARG,NUMARG,IDEFWS,IWINSY,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE WINDOW SYSTEM
C              THE WINDOW MANAGER WILL BE PLACED
C              IN THE HOLLERITH VARIABLE IWINSY.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFWS
C     OUTPUT ARGUMENTS--IWINSY
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--90/9
C     ORIGINAL VERSION--AUGUST 1990.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFWS
      CHARACTER*4 IWINSY
C
      CHARACTER*4 IBUGP2
      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(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
      IF(NUMARG.GE.2)GOTO1110
      GOTO1199
C
 1110 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
      GOTO1160
C
 1150 CONTINUE
      IWINSY=IDEFWS
      GOTO1180
C
 1160 CONTINUE
      IWINSY=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IWINSY
 1181 FORMAT('THE WINDOW SYSTEM HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPWRIT(
     1IMACRO,IMACNU,IMACCS,
     1IFORSW,ICWRIF,NCWRIF,
     1IWRIRW,
     1ITABTI,NCTABT,ITABBR,ITABSP,ITABWD,ITABHT,
     1IFORFM,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--WRITE OUT VALUES OF SPECIFIC VARIABLES,
C              OR PARAMETERS, OR MODELS
C              TO AN OUTPUT MASS STORAGE FILE
C              OR (IF NO FILE GIVEN) TO THE DEFAULT OUTPUT UNIT
C              (WHICH WILL BE THE TERMINAL).
C     ASSUMPTION--THE OUTPUT FILE ALREADY EXISTS;
C                 (THAT IS, DATAPLOT WILL AUTOMATICALLY
C                 OPEN THE FILE
C                 VIA (ON THE UNIVAC 1108), BY AN @ASG,AX ...)
C                 BUT WILL NOT AUTOMATICALLY CREATE THE FILE
C                 VIA (ON THE UNIVAC 1108), BY AN @ASG,UP ...))
C     ASSUMPTION--THE COMPUTER SYSTEM IS SUCH THAT
C                 EQUATING THE FILE NAME TO
C                 THE FORTRAN NUMERIC DESIGNATION
C                 OF 32 (OR HOWEVER THE VARIABLE    IWRINU    IS DEFINED
C                 IN INITFO) IS PERMISSABLE.
C     NOTE--OUTPUT FOR THE WRITE COMMAND MAY POTENTIALLY
C           GO TO 3 DIFFERENT DESTINATIONS--
C                1) THE TERMINAL ITSELF;
C                2) A FILE;
C           DIFFERENT SYSTEMS ALLOW DIFFERENT COMBINATIONS
C           OF THE ABOVE.
C           ALL SYSTEMS WILL ALLOW OUTPUT TO THE TERMINAL ITSELF;
C           MOST SYSTEMS WILL ALLOW OUTPUT TO A FILE;
C           TO DESIGNATE WHETHER THE LAST 2 OPTIONS
C           ARE ALLOWABLE AT A GIVEN INSTALLATION,
C           THE ANALYST SETS (IN SUBROUTINE    INITFO    AT IMPLEMENTATION TIME)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--MAY       1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --DECEMBER  1978.
C     UPDATED         --MARCH     1979.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --MARCH     1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --JANUARY   1982.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --SEPTEMBER 1987.    WRITE MATRICES
C     UPDATED         --OCTOBER   1987.    FORMATTED OUTPUT
C     UPDATED         --JANUARY   1988.    FORMATTED OUTPUT (PARAM.)
C     UPDATED         --DECEMBER  1988.    9,10, 11, AND 12 DEC. PLACES
C     UPDATED         --DECEMBER  1988.    FORMATTED WRITE
C     UPDATED         --DECEMBER  1988.    WRITE UP TO 20 PARAMETERS
C     UPDATED         --AUGUST    1992.    SHIFT COLUMN HEADERS
C     UPDATED         --NOVEMBER  1995. 1) SIMPLIFY CODE
C                                       2) ALLOW MORE THAN 10 VARIABLES
C                                       3) UNFORMATTED WRITE
C     UPDATED         --JULY      1996. FORMAT STATEMENTS FOR PC
C     UPDATED         --JULY      1996. BUG FIX (FOR WRITE LINES > 80 CHARACTERS)
C     UPDATED         --SEPTEMBER 1997. PC REQUIRES "1X" IN FORMAT STATEMENTS
C     UPDATED         --OCTOBER   1997. ADD "WRITE VARIABLES ALL" OPTION
C     UPDATED         --DECEMBER  1997. MAXCOL TO 100
C     UPDATED         --JULY      2003.  BUG: FILE NAME < 80
C                                        CHARACTERS, BUT COMMAND LINE
C                                        > 80 CHARACTERS
C     UPDATED         --SEPTEMBER 2003.  ADD "ERR" CLAUSE FOR FORMATTED
C                                        WRITE
C     UPDATED         --SEPTEMBER 2003.  ADD "WRITE HTML" OPTION
C     UPDATED         --SEPTEMBER 2003.  ADD "WRITE LATEX" OPTION
C     UPDATED         --JUNE      2006.  FOR STRING, MAKE LEADING
C                                        SPACE USER-SETTABLE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IMACRO
      CHARACTER*12 IMACCS
C
      CHARACTER*4 IFORSW
      CHARACTER*4 IHTMFL
      CHARACTER*80 ITABTI
      CHARACTER*4 ITABBR
C
      CHARACTER*4 IFORFM
C
      CHARACTER*80 ICWRIF
CCCCC NOVEMBER 1995.  ADD FOLLOWING LINE.
      CHARACTER*40 IFORMT
      CHARACTER*80 IFMTTA
      CHARACTER*1 IQUOTE
      CHARACTER*1 IBACSL
C
      CHARACTER*4 IWRIRW
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH1
      CHARACTER*4 IH2
      CHARACTER*4 JVNAM1
      CHARACTER*4 JPNAM1
      CHARACTER*4 JMNAM1
      CHARACTER*4 JFNAM1
      CHARACTER*4 JUNAM1
      CHARACTER*4 JENAM1
      CHARACTER*4 JVNAM2
      CHARACTER*4 JPNAM2
      CHARACTER*4 JMNAM2
      CHARACTER*4 JFNAM2
      CHARACTER*4 JUNAM2
      CHARACTER*4 JENAM2
C
      CHARACTER*4 JMNAM3
      CHARACTER*4 JMNAM4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IOFILE
      CHARACTER*4 IOTERM
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 FIX FOLLOWING 2 LINES.  JULY 1996.
CCCCC CHARACTER*80 ICANS
CCCCC CHARACTER*80 ISTRIN
      CHARACTER*200 ICANS
C
      CHARACTER*4 IC4
      CHARACTER*1 IC1
C
      CHARACTER*4 ICASWR
      CHARACTER*4 IANSI
      CHARACTER*4 IANSIR
C
      CHARACTER*4 ICASTO
C
      CHARACTER*4 IHMAT1
      CHARACTER*4 IHMAT2
C
C---------------------------------------------------------------------
C
CCCCC NOVEMBER 1995.  ADD FOLLOWING SECTION.
CCCCC PARAMETER (MAXV3=25)
      PARAMETER (MAXV3=500)
      DIMENSION JVNAM1(MAXV3)
      DIMENSION JPNAM1(MAXV3)
      DIMENSION JMNAM1(MAXV3)
      DIMENSION JFNAM1(MAXV3)
      DIMENSION JUNAM1(MAXV3)
      DIMENSION JENAM1(MAXV3)
C
      DIMENSION JVNAM2(MAXV3)
      DIMENSION JPNAM2(MAXV3)
      DIMENSION JMNAM2(MAXV3)
      DIMENSION JFNAM2(MAXV3)
      DIMENSION JUNAM2(MAXV3)
      DIMENSION JENAM2(MAXV3)
C
      DIMENSION JMNAM3(MAXV3)
      DIMENSION JMNAM4(MAXV3)
C
      DIMENSION NIV(MAXV3)
      DIMENSION NIM(MAXV3)
      DIMENSION IVCOL2(MAXV3)
      DIMENSION PVAL(MAXV3)
      DIMENSION IFSTA2(MAXV3)
      DIMENSION IFSTO2(MAXV3)
      DIMENSION IMVAL1(MAXV3)
      DIMENSION IMVAL2(MAXV3)
      DIMENSION ZLIST(MAXV3)
      DIMENSION IZLIST(MAXV3)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
CCCCC NOVEMBER 1995.  ADD FOLLOWING 4 LINES (FOR UNFORMATTED WRITE)
      INCLUDE 'DPCOZ2.INC'
      DIMENSION XSCRT(MAXOBW)
      EQUIVALENCE (G2RBAG(1),XSCRT(1))
      CHARACTER*4 IFMFLG
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='DPWR'
      ISUBN2='IT  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='YES'
      IERROR='NO'
C
      ICASWR='-999'
      IOFILE='-999'
      IOTERM='-999'
C
      Z1=0.0
      Z2=0.0
      Z3=0.0
      Z4=0.0
      Z5=0.0
      Z6=0.0
      Z7=0.0
      Z8=0.0
      Z9=0.0
      Z10=0.0
CCCCC NOVEMBER 1995.  ADD FOLLOWING SECTION
      DO20I=1,MAXV3
      ZLIST(I)=0.0
 20   CONTINUE
CCCCC APRIL 1996.  FIX TYPO IN FOLLOWING LINE
CCCCC IF(IFORSW.EQ.'E'.OR.IFORMSW.EQ.'EXP'.OR.IFORSW.EQ.'EXPO')THEN
      IF(IFORSW.EQ.'E'.OR.IFORSW.EQ.'EXP'.OR.IFORSW.EQ.'EXPO')THEN
        NUMDIG=99
      ELSEIF(IFORSW.EQ.'0')THEN
        NUMDIG=0
      ELSEIF(IFORSW.EQ.'1')THEN
        NUMDIG=1
      ELSEIF(IFORSW.EQ.'2')THEN
        NUMDIG=2
      ELSEIF(IFORSW.EQ.'3')THEN
        NUMDIG=3
      ELSEIF(IFORSW.EQ.'4')THEN
        NUMDIG=4
      ELSEIF(IFORSW.EQ.'5')THEN
        NUMDIG=5
      ELSEIF(IFORSW.EQ.'6')THEN
        NUMDIG=6
      ELSEIF(IFORSW.EQ.'7')THEN
        NUMDIG=7
      ELSEIF(IFORSW.EQ.'8')THEN
        NUMDIG=8
      ELSEIF(IFORSW.EQ.'9')THEN
        NUMDIG=9
      ELSEIF(IFORSW.EQ.'10')THEN
        NUMDIG=10
      ELSEIF(IFORSW.EQ.'11')THEN
        NUMDIG=11
      ELSEIF(IFORSW.EQ.'12')THEN
        NUMDIG=12
      ELSE
        NUMDIG=-99
      ENDIF
      IFORMT=' '
      IFMTTA=' '
      IFMFLG='OFF'
      CALL DPCONA(39,IQUOTE)
      CALL DPCONA(92,IBACSL)
C
      HALF=0.5
C
      DO40I=1,MAXV3
      JVNAM1(I)='    '
      JPNAM1(I)='    '
      JMNAM1(I)='    '
      JFNAM1(I)='    '
      JUNAM1(I)='    '
      JENAM1(I)='    '
      JVNAM2(I)='    '
      JPNAM2(I)='    '
      JMNAM2(I)='    '
      JFNAM2(I)='    '
      JUNAM2(I)='    '
      JENAM2(I)='    '
   40 CONTINUE
C
C               ****************************
C               **  TREAT THE WRITE CASE  **
C               ****************************
C
CCCCC NOVEMBER 1995.  MODIFY FOLLOWING LINE
CCCCC MAXV2=10
      MAXV2=MAXV3
      MAXP2=100
      MAXM2=100
      MAXF2=100
      MAXU2=100
      MAXE2=100
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WRIT')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X,1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGS2,IBUGQ
   54 FORMAT('IBUGS2,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IMACRO,IMACNU,IMACCS
   56 FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFORSW
   57 FORMAT('IFORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,58)IRD,IRD2
CCC58 FORMAT('IRD,IRD2 = ',2I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IBUGS2,ISUBRO,IERROR
   63 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IWIDTH
   64 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,65)(IANSLC(I),I=1,IWIDTH)
   65 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IWRINU
   71 FORMAT('IWRINU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IWRINA
   72 FORMAT('IWRINA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IWRIST
   73 FORMAT('IWRIST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IWRIFO
   74 FORMAT('IWRIFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)IWRIAC
   75 FORMAT('IWRIAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IWRIFO
   76 FORMAT('IWRIFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)IWRICS
   77 FORMAT('IWRICS = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)NCWRIF
   84 FORMAT('NCWRIF = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCWRIF.GE.1)WRITE(ICOUT,85)(ICWRIF(I:I),I=1,NCWRIF)
   85 FORMAT('(ICWRIF(I:I),I=1,NCWRIF) = ',80A1)
      IF(NCWRIF.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)IWRIRW
   86 FORMAT('IWRIRW = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
CCCCC SEPTEMBER 2003: CHECK FOR "WRITE HTML" CASE.
C
      IF((IHARG(1).EQ.'HTM '.AND.IHARG2(1).EQ.'    ') .OR.
     1   (IHARG(1).EQ.'HTML'.AND.IHARG2(1).EQ.'    '))THEN
        IHTMFL='ON'
        ISHIFT=1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGS2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(IHARG(1).EQ.'LATE'.AND.IHARG2(1).EQ.'X   ')THEN
        IHTMFL='LATE'
        ISHIFT=1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGS2,IERROR)
      ELSE
        IHTMFL='OFF'
      ENDIF
C
C               *******************************************************
C               **  STEP 1.1--                                       **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1.1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1)GOTO119
      IERROR='YES'
      GOTO8800
  119 CONTINUE
C
C               ****************************************************************
C               **  STEP 2A--
C               **  DETERMINE THE TYPE OF WRITE CASE--
C               **       1) TO TERMINAL;
C               **       2) TO FILE;
C               **  NOTE--IOTERM WILL = 'YES' ONLY IN EXPLICIT TERMINAL CASE.
C               **  NOTE--IOFILE WILL = 'YES' ONLY IN FILE CASE.
C               ****************************************************************
C
      ISTEPN='2A'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  200 CONTINUE
      IWORD=2
      CALL DPFILE(IANSLC,IWIDTH,IWORD,
     1IOFILE,IBUGS2,ISUBRO,IERROR)
C
      IOTERM='NO'
      IF(IOFILE.EQ.'NO')GOTO209
      IF(IHARG(1).EQ.'TERM'.AND.IHARG2(1).EQ.'INAL')GOTO205
      GOTO209
  205 CONTINUE
      IOFILE='NO'
      IOTERM='YES'
  209 CONTINUE
C
C               *************************************
C               **  STEP 2B--                      **
C               **  IF HAVE THE FILE OUTPUT CASE--  **
C               **  COPY OVER VARIABLES            **
C               *************************************
C
      ISTEPN='2B'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'NO')GOTO1190
C
      IOUNIT=IWRINU
      IFILE=IWRINA
      ISTAT=IWRIST
      IFORM=IWRIFO
      IACCES=IWRIAC
      IPROT=IWRIPR
      ICURST=IWRICS
C
      ISUBN0='WRIT'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WRIT')GOTO1189
      WRITE(ICOUT,1183)IOUNIT
 1183 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)IFILE
 1184 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)ISTAT,IFORM,IACCES,IPROT,ICURST
 1185 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)ISUBN0,IERRFI
 1186 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
C
 1190 CONTINUE
C
C               ***********************************************
C               **  STEP 2C--                                **
C               **  IF HAVE THE FILE OUTPUT CASE--            **
C               **  CHECK TO SEE IF THE WRITE FILE MAY EXIST  **
C               ***********************************************
C
      ISTEPN='2C'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'NO')GOTO1290
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** IMPLEMENTATION ERROR IN DPWRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED WRITING')
      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    IWRIST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH ALLOWS SUCH WRITING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      HAS BEEN SET TO    NONE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,IWRIST
 1217 FORMAT('ISTAT,IWRIST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)
 1218 FORMAT('      ALL WRITING MUST BE DONE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      DIRECTLY TO THE TERMINAL.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               *************************************
C               **  STEP 2D--                      **
C               **  IF HAVE THE FILE INPUT CASE--  **
C               **  EXTRACT THE FILE NAME          **
C               *************************************
C
      ISTEPN='2D'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'NO')GOTO1390
C
      DO1310I=1,200
      ICANS(I:I)=IANSLC(I)
 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.GE.1)GOTO1349
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1341)
 1341 FORMAT('***** ERROR IN DPWRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1342)
 1342 FORMAT('      A USER FILE NAME IS REQUIRED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1343)
 1343 FORMAT('      IN THE WRITE COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1344)
 1344 FORMAT('      (FOR EXAMPLE,    WRITE CALIB.DAT X Y Z)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1345)
 1345 FORMAT('      BUT NONE WAS GIVEN HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1346)
 1346 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,1347)(IANSLC(I),I=1,MIN(100,IWIDTH))
 1347   FORMAT('      ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(IWIDTH.LE.0)WRITE(ICOUT,999)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1349 CONTINUE
C
 1390 CONTINUE
CCCCC JULY 2002: QUOTED FILE NAMES MAY CONTAIN SPACES.
CCCCC DETERMINE HOW MANY ARGUMENTS FILE NAME MAY CONTAIN.
C
      IFWORD=0
      IFQUOT=0
      IF(IFILE(1:1).EQ.'"')THEN
        IFQUOT=1
        DO1351I=80,1,-1
          IF(IFILE(I:I).NE.' ')THEN
            ILAST=I
            GOTO1354
          ENDIF
 1351   CONTINUE
 1354   CONTINUE
        ICOUNT=0
        ISPAC=0
        DO1356I=1,ILAST
          IF((IFILE(I:I).EQ.' '.OR.IFILE(I:I).EQ.'-') .AND.
     1       ISPAC.EQ.0)THEN
            ISPAC=1
            ICOUNT=ICOUNT+1
          ELSEIF((IFILE(I:I).NE.' '.AND.IFILE(I:I).NE.'-') .AND.
     1      ISPAC.EQ.1)THEN
            ISPAC=0
          ENDIF
 1356   CONTINUE
        IFWORD=ICOUNT
      ENDIF
C
C
C               *************************************
C               **  STEP 2E--                      **
C               **  IF HAVE THE FILE INPUT CASE--  **
C               **  OPEN THE FILE                  **
C               *************************************
C
      ISTEPN='2E'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'NO')GOTO1490
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT AND THE  (DECEMBER 1988)
CCCCC SUBSEQUENT 2 LINES ADDED     DECEMBER 1988
CCCCC IREWIN='ON'  DECEMBER 1988
CCCCC IREWIN=IWRIRW
      IREWIN='ON'
CCCCC NOVEMBER 1995.  FOR UNFORMATTED WRITE, BE SURE TO OPEN THE
CCCCC FILE IN UNFORMATTED MODE.
      IFMFLG='OFF'
      IF(NCWRIF.GE.1)THEN
        IF(ICWRIF(1:5).EQ.'(UNFO'.OR.ICWRIF(1:5).EQ.'(BINA')THEN
          IFORM='UNFORMATTED'
          IFMFLG='ON'
        ENDIF
      ENDIF
C
      IF(IWRICS(1:4).EQ.'CLOS')
     1CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
CCCCC THE FOLLOWING LINE WAS ADDED  DECEMBER 1988
      IF(IWRICS(1:4).EQ.'CLOS')IWRICS='OPEN'
      IF(IERRFI.EQ.'YES')GOTO9000
C
 1490 CONTINUE
C
C               ******************************************
C               **  STEP 2F--                           **
C               **  FOR THE 2 CASES--                   **
C               **      1) TERMINAL OUTPUT;             **
C               **      2) FILE OUTPUT;                 **
C               **  DEFINE THE OUTPUT WRITE UNIT NUMBER, **
C               **  AND OTHER VARIABLES NEEDED          **
C               **  FOR UPCOMING WRITES.                **
C               ******************************************
C
      ISTEPN='2F'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPR2=IPR
      IF(IOFILE.EQ.'YES')IPR2=IWRINU
      IF(IOTERM.EQ.'YES')IPR2=IPR
C
      IOUNIT=IPR2
C
C               *************************************************
C               **  STEP 3A--                                  **
C               **  CHECK TO SEE IF OUTPUTTING                 **
C               **  A CHARACTER STRING.                        **
C               **  FOR EXAMPLE, WRITE "CALIBRATION ANALYSIS"  **
C               **  IF SO, THEN TREAT THIS SPECIAL             **
C               **  CASE IMMEDIATELY.                          **
C               *************************************************
C
      ISTEPN='3A'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASWR='NOST'
      IC4=IHARLC(1)
      IF(IOFILE.EQ.'YES')IC4=IHARLC(2+IFWORD)
      IC1=IC4(1:1)
      IF(IC1.EQ.'''')ICASWR='STRI'
      IF(IC1.EQ.'"')ICASWR='STRI'
C
      IF(ICASWR.EQ.'NOST')GOTO890
C
CCCCC NOVEMBER 1995.  IT IS AN ERROR TO WRITE A STRING TO AN
CCCCC UNFORMATTED FILE.
      IF(IFMFLG.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,821)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,822)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,823)
        CALL DPWRST('XXX','BUG')
        GOTO8800
      ENDIF
  821 FORMAT('***** ERROR FROM DPWRIT.  IT IS ILLEGAL TO WRITE A ',
     1'STRING TO AN UNFORMATTED FILE.')
  822 FORMAT('      ENTER THE COMMAND:  SET WRITE FORMAT ')
  823 FORMAT('      WITH NO ARGUMENTS TO RESTORE THE WRITE FILE AS A ',
     1'FORMATTED FILE.')
C
CCCCC JULY 2002: COMPLICATION: IF FILE NAME ENCLOSED IN QUOTES,
CCCCC THEN NEED TO DISTINGUISH BETWEEN FILE NAME AND STRING.
CCCCC FLAG EARLIER IF FILE NAME IS QUOTED, IF SO, THEN
CCCCC STRING STARTS ON THIRD QUOTE, NOT FIRST QUOTE.  ALSO,
CCCCC FILE NAMES ARE CURRENTLY ONLY DOUBLE QUOTED, NOT SINGLE
CCCCC QUOTED.
C
      NQUOT=0
      DO820I=1,IWIDTH
      ILOCQ1=I
      IANSI=IANSLC(I)
      IF(IFQUOT.EQ.1)THEN
        IF(IANSI(1:1).EQ.'"' .OR. IANSI(1:1).EQ.IC1)NQUOT=NQUOT+1
        IF(IANSI(1:1).EQ.IC1 .AND. NQUOT.GE.3)GOTO829
      ELSE
        IF(IANSI(1:1).EQ.IC1)GOTO829
      ENDIF
  820 CONTINUE
      GOTO890
  829 CONTINUE
C
      DO830I=1,IWIDTH
      IREV=IWIDTH-I+1
      ILOCQ2=IREV
      IANSIR=IANSLC(IREV)
      IF(IANSIR(1:1).EQ.IC1)GOTO839
  830 CONTINUE
      GOTO890
  839 CONTINUE
C
      ISTART=ILOCQ1+1
      ISTOP=ILOCQ2-1
      IF(ISTART.GT.ISTOP)THEN
        WRITE(IPR2,999)
      ELSEIF(ISTART.LE.ISTOP)THEN
        IF(IFORFM.EQ.'ON')THEN
          WRITE(IPR2,841)(IANSLC(I),I=ISTART,ISTOP)
  841     FORMAT(1X,240A1)
        ELSE
          WRITE(IPR2,842)(IANSLC(I),I=ISTART,ISTOP)
  842     FORMAT(240A1)
        ENDIF
      ENDIF
      GOTO8800
C
  890 CONTINUE
C
C               *****************************************
C               **  STEP 3B--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET; OR                    **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='3B'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO390
      DO300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO320
  300 CONTINUE
      GOTO390
  310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO390
  320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO390
  390 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WRIT')GOTO395
      WRITE(ICOUT,391)NUMARG,ILOCQ
  391 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  395 CONTINUE
C
C               ****************************************************************
C               **  STEP 4--
C               **  DETERMINE THE TYPE AND NUMBER OF ITEMS
C               **  TO BE PRINTED.
C               **  NUMALL = TOTAL NUMBER OF PRINT ITEMS
C               **           (AS DETERMINED BY INCLUDING ONLY ALL BEFORE
C               **           'SUBS' OR 'FOR')
C               **  NUMV   = NUMBER OF VARIABLES TO BE PRINTED;
C               **  NUMP   = NUMBER OF PARAMETERS TO BE PRINTED;
C               **  NUMM   = NUMBER OF MODELS TO BE PRINTED (SHOULD = 0 OR 1)
C               **  NUMF   = NUMBER OF FUNCTIONS TO BE PRINTED
C               **  NUMU   = NUMBER OF UNKNOWNS TO BE PRINTED;
C               **  NUME   = TOTAL NUMBER OF PRINT ITEMS (SHOULD = NUMALL);
C               **  OCTOBER 1997: ADD A "WRITE VARIABLES ALL" OPTION
C               ****************************************************************
C
      ISTEPN='4'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMALL=ILOCQ-1
C
      IV=0
      IP=0
      IM=0
      IF=0
      IU=0
      IE=0
      JMIN=1
      IF(IOFILE.EQ.'YES')JMIN=2+IFWORD
      JMAX=ILOCQ-1
      IF(JMIN.GT.JMAX)GOTO4290
CCCCC OCTOBER 1997.  ADD "VARIABLES ALL" OPTION.
      IF((IHARG(JMIN).EQ.'VARI'.AND.IHARG(JMIN+1).EQ.'ALL').OR.
     1   (IHARG(JMIN).EQ.'ALL'.AND.IHARG(JMIN+1).EQ.'VARI'))THEN
        IF(NUMCOL.LE.0)GOTO9000
        NZLIST=0
        DO4100I=1,NUMCOL
          DO4110J=1,NUMNAM
            IF(I.EQ.IVALUE(J).AND.IUSE(J).EQ.'V')THEN
C
              IJUNK=IVALUE(J)
              IF(NZLIST.GE.1)THEN
                DO4112LL=1,NZLIST
                  IF(IJUNK.EQ.IZLIST(LL))GOTO4100
 4112           CONTINUE
                NZLIST=NZLIST+1
                IZLIST(NZLIST)=IJUNK
              ELSE
                NZLIST=1
                IZLIST(NZLIST)=IJUNK
              ENDIF
C
              IV=IV+1
              IF(IV.LE.MAXV2)THEN
                JVNAM1(IV)=IHNAME(J)
                JVNAM2(IV)=IHNAM2(J)
                NIV(IV)=IN(J)
                IVCOL2(IV)=IVALUE(J)
              ENDIF
              IE=IE+1
              IF(IE.LE.MAXE2)THEN
                JENAM1(IE)=IHNAME(J)
                JENAM2(IE)=IHNAM2(J)
              ENDIF
            ENDIF
 4110     CONTINUE
 4100   CONTINUE
        GOTO4290
      ENDIF
C
      DO4200J=JMIN,JMAX
      IH1=IHARG(J)
      IH2=IHARG2(J)
C
C     ***************
C     THE FOLLOWING CODE ALLOWS THE    TO    KEYWORD
C     TO BE ACTIVATED, AS IN
C     WRITE FILE.EXT Y1 TO Y10
C     DECEMBER 1986
C     ***************
C
      ICASTO='OFF'
      IF (IH1.EQ.'TO  ')GOTO4210
      GOTO4220
C
 4210 CONTINUE
      ICASTO='ON'
      JM1=J-1
      JP1=J+1
      CALL DPEXTL(IHARG(JM1),IHARG2(JM1),IHARG(JP1),IHARG2(JP1),
     1KNUMB,IVAL1,IVAL2,IBUGS2,ISUBRO,IERROR)
C
      IVA1P1=IVAL1+1
      IVA2M1=IVAL2-1
      IF(IVA1P1.GT.IVA2M1)GOTO4200
CCCCC DO4215IVAL=IVA1P1,IVA2M1
      IVAL=IVAL1
 4215 CONTINUE
      IVAL=IVAL+1
      IF(IVAL.GE.IVAL2)GOTO4200
C
      CALL DPAPNU(IHARG(JM1),IHARG2(JM1),KNUMB,IVAL,
     1IH1,IH2,IBUGS2,ISUBRO,IERROR)
      GOTO4220
C
 4220 CONTINUE
      IF(IH1.EQ.'PARA'.AND.IH2.EQ.'METE')GOTO4370
      IF(IH1.EQ.'SCAL'.AND.IH2.EQ.'ARS ')GOTO4370
      IF(IH1.EQ.'CONS'.AND.IH2.EQ.'TANT')GOTO4370
C
      DO4300I=1,NUMNAM
      I2=I
      IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))GOTO4305
      GOTO4300
 4305 CONTINUE
      IF(IUSE(I).EQ.'V')GOTO4310
      IF(IUSE(I).EQ.'P')GOTO4320
      IF(IUSE(I).EQ.'M')GOTO4330
      IF(IUSE(I).EQ.'F')GOTO4340
 4300 CONTINUE
      GOTO4350
C
 4310 CONTINUE
      IV=IV+1
      IF(IV.GT.MAXV2)GOTO4380
      JVNAM1(IV)=IH1
      JVNAM2(IV)=IH2
      NIV(IV)=IN(I2)
      IVCOL2(IV)=IVALUE(I2)
      GOTO4380
C
 4320 CONTINUE
      IP=IP+1
      IF(IP.GT.MAXP2)GOTO4380
      JPNAM1(IP)=IH1
      JPNAM2(IP)=IH2
      PVAL(IP)=VALUE(I2)
      GOTO4380
C
 4330 CONTINUE
      IM=IM+1
      IF(IM.GT.MAXM2)GOTO4380
      JMNAM1(IM)=IH1
      JMNAM2(IM)=IH2
      IMVAL1(IM)=IVALUE(I2)
      IMVAL2(IM)=IVALU2(I2)
      NIM(IM)=IN(I2)
      GOTO4380
C
 4340 CONTINUE
      IF=IF+1
      IF(IF.GT.MAXF2)GOTO4380
      JFNAM1(IF)=IH1
      JFNAM2(IF)=IH2
      IFSTA2(IF)=IVSTAR(I2)
      IFSTO2(IF)=IVSTOP(I2)
      GOTO4380
C
 4350 CONTINUE
      IU=IU+1
      IF(IU.GT.MAXU2)GOTO4380
      JUNAM1(IU)=IH1
      JUNAM2(IU)=IH2
      GOTO4380
C
 4370 CONTINUE
      DO4375I=1,NUMNAM
      I2=I
      IF(IUSE(I).EQ.'P')GOTO4372
      GOTO4375
 4372 CONTINUE
      IH1=IHNAME(I2)
      IH2=IHNAM2(I2)
      IP=IP+1
      IF(IP.GT.MAXP2)GOTO4375
      JPNAM1(IP)=IH1
      JPNAM2(IP)=IH2
      PVAL(IP)=VALUE(I2)
      GOTO4373
 4373 CONTINUE
      IE=IE+1
      IF(IE.GT.MAXE2)GOTO4375
      JENAM1(IE)=IH1
      JENAM2(IE)=IH2
 4375 CONTINUE
      GOTO4200
C
 4380 CONTINUE
      IE=IE+1
      IF(IE.GT.MAXE2)GOTO4200
      JENAM1(IE)=IH1
      JENAM2(IE)=IH2
C
 4280 CONTINUE
      IF(ICASTO.EQ.'ON')GOTO4215
C
 4200 CONTINUE
 4290 CONTINUE
      NUMV=IV
      NUMP=IP
      NUMM=IM
      NUMF=IF
      NUMU=IU
      NUME=IE
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WRIT')GOTO4419
      WRITE(ICOUT,4411)NUMALL,NUMV,NUMP,NUMM,NUMF,NUMU,NUME
 4411 FORMAT('NUMALL,NUMV,NUMP,NUMM,NUMF,NUMU,NUME = ',7I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4412)
 4412 FORMAT('I,JVNAM1(I),JVNAM2(I),JPNAM1(I),JPNAM2(I),
     1JMNAM1(I),JMNAM2(I),JFNAM1(I),JFNAM2(I),JUNAM1(I),JUNAM2(I)')
      CALL DPWRST('XXX','BUG ')
      DO4415I=1,15
      WRITE(ICOUT,4416)I,JVNAM1(I),JVNAM2(I),JPNAM1(I),JPNAM2(I),
     1JMNAM1(I),JMNAM2(I),JFNAM1(I),JFNAM2(I),JUNAM1(I),JUNAM2(I)
 4416 FORMAT(I8,5X,2A4,1X,2A4,1X,2A4,1X,2A4,1X,2A4)
      CALL DPWRST('XXX','BUG ')
 4415 CONTINUE
 4419 CONTINUE
C
C               ***************************************************
C               **  STEP 4--                                     **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 10) OF VARIABLES TO BE PRINTED         **
C               **  (NOTE--THIS DOES NOT INCLUDE PARAMETERS      **
C               **  OR MODELS IN THE ABOVE COUNT--               **
C               **  ONLY VARIABLES.)                             **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF CONSTANTS TO BE PRINTED.       **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF MODELS TO BE PRINTED.          **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF FUNCTIONS TO BE PRINTED.       **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF UNKNOWNS TO BE PRINTED.        **
C               ***************************************************
C
      IF(0.LE.NUMV.AND.NUMV.LE.MAXV2)GOTO530
C
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPWRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,512)
  512 FORMAT('      FOR A PRINT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,513)
  513 FORMAT('      THE NUMBER OF VARIABLES (NOT COUNTING ',
     1'PARAMETERS OR MODELS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,514)MAXV2
  514 FORMAT('      MUST BE AT MOST ',I8,'  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,515)
  515 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,516)
  516 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,517)NUMV
  517 FORMAT('      OF VARIABLES TO BE PRINTED WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,518)MAXV2
  518 FORMAT('      NOTE--ONLY THE FIRST ',I8,' VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,519)
  519 FORMAT('      WILL BE PRINTED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,520)
  520 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,521)(IANSLC(I),I=1,IWIDTH)
  521 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
C
  530 CONTINUE
      IF(0.LE.NUMP.AND.NUMP.LE.MAXP2)GOTO550
C
      WRITE(ICOUT,531)
  531 FORMAT('***** ERROR IN DPWRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,532)
  532 FORMAT('      FOR A PRINT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,533)
  533 FORMAT('      THE NUMBER OF PARAMETERS (CONSTANTS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,534)MAXP2
  534 FORMAT('      MUST BE AT MOST ',I8,'  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,535)
  535 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,536)
  536 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,537)NUMP
  537 FORMAT('      OF PARAMETERS TO BE PRINTED WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,538)MAXP2
  538 FORMAT('      NOTE--ONLY THE FIRST ',I8,' PARAMETERS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,539)
  539 FORMAT('      WILL BE PRINTED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,540)
  540 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,541)(IANSLC(I),I=1,IWIDTH)
  541 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
C
  550 CONTINUE
      IF(0.LE.NUMM.AND.NUMM.LE.MAXM2)GOTO570
C
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPWRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A PRINT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)
  553 FORMAT('      THE NUMBER OF MODELS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)MAXM2
  554 FORMAT('      MUST BE AT MOST ',I8,'  ;')
      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)NUMM
  557 FORMAT('      OF MODELS TO BE PRINTED WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)MAXM2
  558 FORMAT('      NOTE--ONLY THE FIRST ',I8,' MODELS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,559)
  559 FORMAT('      WILL BE PRINTED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  560 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,561)(IANSLC(I),I=1,IWIDTH)
  561 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
C
  570 CONTINUE
      IF(0.LE.NUMF.AND.NUMM.LE.MAXF2)GOTO590
C
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPWRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A PRINT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,573)
  573 FORMAT('      THE NUMBER OF FUNCTIONS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,574)MAXF2
  574 FORMAT('      MUST BE AT MOST ',I8,'  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,575)
  575 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,576)
  576 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,577)NUMF
  577 FORMAT('      OF FUNCTIONS TO BE PRINTED WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)MAXF2
  578 FORMAT('      NOTE--ONLY THE FIRST ',I8,' FUNCTIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      WILL BE PRINTED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  580 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,581)(IANSLC(I),I=1,IWIDTH)
  581 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
C
  590 CONTINUE
      IF(0.LE.NUMU.AND.NUMU.LE.MAXU2)GOTO690
C
      WRITE(ICOUT,611)
  611 FORMAT('***** ERROR IN DPWRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,612)
  612 FORMAT('      FOR A PRINT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,613)
  613 FORMAT('      THE NUMBER OF UNKNOWNS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,614)MAXU2
  614 FORMAT('      MUST BE AT MOST ',I8,'  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,615)
  615 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,616)
  616 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,617)NUMU
  617 FORMAT('      OF UNKNOWNS TO BE PRINTED WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,618)MAXU2
  618 FORMAT('      NOTE--ONLY THE FIRST ',I8,' UNKNOWNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,619)
  619 FORMAT('      WILL BE PRINTED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,620)
  620 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,621)(IANSLC(I),I=1,IWIDTH)
  621 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
C
  690 CONTINUE
C
C               ******************************************
C               **  STEP 5A--                           **
C               **  PRINT OUT FUNCTIONS IF CALLED FOR.  **
C               ******************************************
C
      ISTEPN='5A'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMF.LE.0)GOTO3439
      IF(IOFILE.EQ.'YES')GOTO3432
      IF(NCWRIF.GE.1)GOTO3432
      WRITE(IPR2,999)
      WRITE(IPR2,3431)
 3431 FORMAT(1X,'FUNCTIONS--')
      WRITE(IPR2,999)
 3432 CONTINUE
CCCCC NOVEMBER 1995.  IT IS AN ERROR TO WRITE A FUNCTION TO AN
CCCCC UNFORMATTED FILE.
      IF(IFMFLG.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,3451)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,3452)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,3453)
        CALL DPWRST('XXX','BUG')
        GOTO8800
      ENDIF
 3451 FORMAT('***** ERROR FROM DPWRIT.  IT IS ILLEGAL TO WRITE A ',
     1'FUNCTION TO AN UNFORMATTED FILE.')
 3452 FORMAT('      ENTER THE COMMAND:  SET WRITE FORMAT ')
 3453 FORMAT('      WITH NO ARGUMENTS TO RESTORE THE WRITE FILE AS A ',
     1'FORMATTED FILE.')
C
      DO3435I=1,NUMF
      JMIN=IFSTA2(I)
      JMAX=IFSTO2(I)
      IF(NCWRIF.LE.0)
     1WRITE(IPR2,3436)JFNAM1(I),JFNAM2(I),(IFUNC(J),J=JMIN,JMAX)
 3436 FORMAT(1X,4X,2A4,'--',115A1)
      IF(NCWRIF.GE.1)
     1WRITE(IPR2,ICWRIF)(IFUNC(J),J=JMIN,JMAX)
 3435 CONTINUE
 3439 CONTINUE
C
C               ******************************************
C               **  STEP 5B--                           **
C               **  PRINT OUT THE MODEL IF CALLED FOR.  **
C               ******************************************
C
CCCCC ISTEPN='5'
CCCCC IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(NUMM.LE.0)GOTO4429
CCCCC WRITE(IPR2,999)
CCCCC WRITE(IPR2,4426)
C4426 FORMAT('MODEL--')
CCCCC WRITE(IPR2,999)
CCCCC IF(NUMCHA.EQ.0)WRITE(IPR2,4081)
C4081 FORMAT(4X,'NO MODEL YET DEFINED')
CCCCC IF(NUMCHA.EQ.0)GOTO4429
C
CCCCC DO4427I=1,5
CCCCC I2=I
CCCCC IF(MODEL(I).NE.' ')GOTO4428
C4427 CONTINUE
CCCCC WRITE(IPR2,4420)(MODEL(I),I=1,NUMCHA)
C4420 FORMAT(120A1)
CCCCC WRITE(IPR2,999)
CCCCC GOTO4429
C
C4428 CONTINUE
CCCCC IF(I2.EQ.1)WRITE(IPR2,4421)(MODEL(I),I=1,NUMCHA)
C4421 FORMAT(4X,120A1)
CCCCC IF(I2.EQ.2)WRITE(IPR2,4422)(MODEL(I),I=1,NUMCHA)
C4422 FORMAT(3X,120A1)
CCCCC IF(I2.EQ.3)WRITE(IPR2,4423)(MODEL(I),I=1,NUMCHA)
C4423 FORMAT(2X,120A1)
CCCCC IF(I2.EQ.4)WRITE(IPR2,4424)(MODEL(I),I=1,NUMCHA)
C4424 FORMAT(1X,120A1)
CCCCC IF(I2.GE.5)WRITE(IPR2,4425)(MODEL(I),I=1,NUMCHA)
C4425 FORMAT(120A1)
CCCCC WRITE(IPR2,999)
CCCCC GOTO4429
C
C4429 CONTINUE
C
C               ****************************************************************
C               **  STEP 6--
C               **  PRINT OUT THE PARAMETERS AND CONSTANTS THAT WERE SPECIFIED.
C               ****************************************************************
C
CCCCC NOVEMBER 1995.  FOLLOWING SECTION WAS SIMPLIFIED.
      ISTEPN='6'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMP.LE.0)GOTO4490
C
      IF(NCWRIF.GE.1)GOTO4470
      GOTO4430
C
 4430 CONTINUE
      IF(IOFILE.EQ.'YES')GOTO4432
      WRITE(IPR2,999)
      WRITE(IPR2,4431)
 4431 FORMAT(1X,'PARAMETERS AND CONSTANTS--')
      WRITE(IPR2,999)
 4432 CONTINUE
C
      DO4435I=1,NUMP
      Z1=PVAL(I)
CCCCC WRITE(IPR2,4436)JPNAM1(I),JPNAM2(I),Z1
C4436 FORMAT(4X,2A4,'--',E15.7)
      IF(IFORSW.EQ.'E'.OR.IFORSW.EQ.'EXP'.OR.IFORSW.EQ.'EXPO')THEN
        WRITE(IPR2,4459)JPNAM1(I),JPNAM2(I),Z1
        GOTO4460
      ELSEIF(IFORSW.EQ.'0')THEN
        IZ1=Z1+SIGN(HALF,Z1)
        WRITE(IPR2,4440)JPNAM1(I),JPNAM2(I),IZ1
      ELSEIF(NUMDIG.GE.1.AND.NUMDIG.LE.12)THEN
        IFORMT='(4X,2A4, -- ,F15.  )'
        IFORMT(9:9)=IQUOTE
        IFORMT(12:12)=IQUOTE
        WRITE(IFORMT(18:19),'(I2)')NUMDIG
        WRITE(IPR2,IFORMT)JPNAM1(I),JPNAM2(I),Z1
      ELSE
        WRITE(IPR2,4459)JPNAM1(I),JPNAM2(I),Z1
        GOTO4460
      ENDIF
 4440 FORMAT(1X,4X,2A4,'--',I10)
 4459 FORMAT(1X,4X,2A4,'--',E15.7)
 4460 CONTINUE
 4435 CONTINUE
      GOTO4490
C
 4470 CONTINUE
CCCCC NOVEMBER 1995.  IT IS AN ERROR TO WRITE A PARAMETER TO AN
CCCCC UNFORMATTED FILE.
      IF(IFMFLG.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,4451)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,4452)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,4453)
        CALL DPWRST('XXX','BUG')
        GOTO8800
      ENDIF
 4451 FORMAT('***** ERROR FROM DPWRIT.  IT IS ILLEGAL TO WRITE A ',
     1'PARAMETER TO AN UNFORMATTED FILE.')
 4452 FORMAT('      ENTER THE COMMAND:  SET WRITE FORMAT ')
 4453 FORMAT('      WITH NO ARGUMENTS TO RESTORE THE WRITE FILE AS A ',
     1'FORMATTED FILE.')
C
      IF(NUMP.GE.1.AND.NUMP.LE.20)THEN
        WRITE(IPR2,ICWRIF) (PVAL(LL),LL=1,NUMP)
      ENDIF
      GOTO4490
C
 4490 CONTINUE
C
C               **********************************************************
C               **  STEP 7.1--                                          **
C               **  FIRST, BRANCH TO THE APPROPRIATE SUBCASE            **
C               **  (DEPENDING ON WHETHER UNQUALIFIED, SUBSET OR FOR);  **
C               **  THE DETERMINE THE LENGTH OF THE LONGEST             **
C               **  VARIABLE TO BE PRINTED OUT;                         **
C               **  THEN PRINT OUT THE VARIABLES                        **
C               **  THAT WERE SPECIFIED.                                **
C               **********************************************************
C
      ISTEPN='7.1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WRIT')GOTO6090
      WRITE(ICOUT,6011)NUMV,NIV(1),NIV(2),NIV(3)
 6011 FORMAT('NUMV,NIV(1),NIV(2),NIV(3) = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6012)IVCOL2(1),IVCOL2(2),IVCOL2(3)
 6012 FORMAT('IVCOL2(1),IVCOL2(2),IVCOL2(3) = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6013)ICASEQ,IPR,IPR2
 6013 FORMAT('ICASEQ,IPR,IPR2 = ',A4,2X,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6014)JVNAM1(1),JVNAM2(1)
 6014 FORMAT('JVNAM1(1),JVNAM2(1) = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
 6090 CONTINUE
C
      IF(NUMV.LE.0)GOTO6490
C
      MAXNPR=NIV(1)
      DO6100IV=1,NUMV
      IF(NIV(IV).GT.MAXNPR)MAXNPR=NIV(IV)
 6100 CONTINUE
C
      IF(ICASEQ.EQ.'FULL')GOTO6310
      IF(ICASEQ.EQ.'SUBS')GOTO6320
      IF(ICASEQ.EQ.'FOR')GOTO6330
C
 6310 CONTINUE
      DO6315I=1,MAXNPR
      ISUB(I)=1
 6315 CONTINUE
      NQ=MAXNPR
      GOTO6350
C
 6320 CONTINUE
      NIOLD=MAXNPR
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO6350
C
 6330 CONTINUE
      NIOLD=MAXNPR
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO6350
C
 6350 CONTINUE
      IF(IOFILE.EQ.'YES')GOTO6355
      IF(NCWRIF.GE.1)GOTO6355
      WRITE(IPR2,999)
      IF(IHTMFL.EQ.'ON')THEN
        WRITE(IPR2,6051)
        WRITE(IPR2,999)
        WRITE(IPR2,6061)
        IF(ITABSP.LE.0)THEN
          IF(ITABBR.EQ.'OFF')THEN
            WRITE(IPR2,6053)
          ELSEIF(ITABBR.EQ.'ON')THEN
            WRITE(IPR2,6071)
          ELSEIF(ITABBR.EQ.'COLS')THEN
            WRITE(IPR2,6074)
          ELSE
            WRITE(IPR2,6053)
          ENDIF
        ELSE
          IF(ITABBR.EQ.'OFF')THEN
            WRITE(IPR2,6072)ITABSP
          ELSEIF(ITABBR.EQ.'ON')THEN
            WRITE(IPR2,6073)ITABSP
          ELSEIF(ITABBR.EQ.'COLS')THEN
            WRITE(IPR2,6075)ITABSP
          ELSE
            WRITE(IPR2,6072)ITABSP
          ENDIF
        ENDIF
        WRITE(IPR2,6076)
        WRITE(IPR2,6077)ITABTI(1:NCTABT)
        WRITE(IPR2,6078)
        WRITE(IPR2,6055)
        DO6352I=1,NUMV
          WRITE(IPR2,6057)
          ICOLZZ=IVCOL2(I)
          IF(IVARLB(ICOLZZ).EQ.' ')THEN
            WRITE(IPR2,6059)JVNAM1(I),JVNAM2(I)
          ELSE
            WRITE(IPR2,6069)IVARLB(ICOLZZ)
          ENDIF
          WRITE(IPR2,6058)
 6352   CONTINUE
        WRITE(IPR2,6056)
        IF(ITABBR.EQ.'RULE')THEN
          WRITE(IPR2,6055)
          WRITE(IPR2,7077)NUMV
          WRITE(IPR2,7078)
          WRITE(IPR2,6068)
          WRITE(IPR2,6056)
        ENDIF
      ELSEIF(IHTMFL.EQ.'LATE')THEN
        WRITE(IPR2,6080)IBACSL
        WRITE(IPR2,6081)IBACSL
        IF(NCTABT.GT.0)THEN
          WRITE(IPR2,999)
          WRITE(IPR2,7080)IBACSL
          WRITE(IPR2,7081)IBACSL,(ITABTI(I:I),I=1,NCTABT)
          WRITE(IPR2,7084)IBACSL,IBACSL
          WRITE(IPR2,7082)IBACSL,IBACSL,IBACSL,IBACSL
          WRITE(IPR2,7082)IBACSL,IBACSL,IBACSL,IBACSL
          WRITE(IPR2,7083)IBACSL
          WRITE(IPR2,999)
        ENDIF
        WRITE(IPR2,7080)IBACSL
        WRITE(IPR2,6086)IBACSL
        IFMTTA=' '
        IFMTTA(1:1)='{'
        IF(ITABBR.EQ.'ON')THEN
          NCOUNT=1
          DO6362I=1,NUMV
            IFMTTA(NCOUNT+1:NCOUNT+2)='|c'
            NCOUNT=NCOUNT+2
 6362     CONTINUE
          IFMTTA(NCOUNT+1:NCOUNT+2)='|}'
          NCOUNT=NCOUNT+2
          IFORMT='(A  )'
          WRITE(IFORMT(3:4),'(I2)')NCOUNT
          WRITE(IPR2,IFORMT)IFMTTA
          IFORMT=' '
        ELSE
          DO6367I=1,NUMV
            IFMTTA(I+1:I+1)='c'
 6367     CONTINUE
          NCOUNT=NUMV+2
          IFMTTA(NCOUNT:NCOUNT)='}'
          IFORMT='(A  )'
          WRITE(IFORMT(3:4),'(I2)')NCOUNT
          WRITE(IPR2,IFORMT)IFMTTA
          IFORMT=' '
        ENDIF
C
        IF(ITABBR.EQ.'ON' .OR. ITABBR.EQ.'RULE')THEN
          WRITE(IPR2,7074)IBACSL
        ENDIF
        DO6382I=1,NUMV
          ICOLZZ=IVCOL2(I)
          IF(IVARLB(ICOLZZ).EQ.' ')THEN
            IF(I.LT.NUMV)WRITE(IPR2,7070)JVNAM1(I),JVNAM2(I)
            IF(I.EQ.NUMV)WRITE(IPR2,8070)JVNAM1(I),JVNAM2(I)
          ELSE
            IF(I.LT.NUMV)WRITE(IPR2,7071)IVARLB(ICOLZZ)
            IF(I.EQ.NUMV)WRITE(IPR2,8071)IVARLB(ICOLZZ)
          ENDIF
 6382   CONTINUE
        IF(ITABBR.EQ.'RULE' .OR. ITABBR.EQ.'ON')THEN
          WRITE(IPR2,7073)IBACSL,IBACSL,IBACSL
        ELSE
          WRITE(IPR2,7072)IBACSL,IBACSL
        ENDIF
C
      ELSE
        IF(NUMV.LE.5)THEN
          WRITE(IPR2,6041)(JVNAM1(I),JVNAM2(I),I=1,NUMV)
        ELSE
          WRITE(IPR2,6042)(JVNAM1(I),JVNAM2(I),I=1,NUMV)
        ENDIF
      ENDIF
 6041 FORMAT(1X,'VARIABLES--',2A4,7X,2A4,7X,2A4,7X,2A4,7X,2A4)
 6042 FORMAT(1X,'VARIABLES--',2A4,4X,2A4,4X,2A4,4X,2A4,4X,2A4,
     14X,2A4,4X,2A4,4X,2A4,4X,2A4,4X,2A4)
 6051 FORMAT('
') 6052 FORMAT('
')
 6053 FORMAT('')
 6071 FORMAT('
')
 6072 FORMAT('
')
 6073 FORMAT('
')
 6074 FORMAT('
')
 6075 FORMAT('
')
 6054 FORMAT('
')
 6055 FORMAT('   ')
 6056 FORMAT('   ')
 6057 FORMAT('     ')
 6058 FORMAT('     ')
 6059 FORMAT('        ',A4,A4)
 6061 FORMAT('
    ')
 6062 FORMAT('
')
 6067 FORMAT('     ')
 6068 FORMAT('     ')
 7067 FORMAT('     ')
 7068 FORMAT('     ')
 7069 FORMAT('     ')
 6069 FORMAT('        ',A40)
 6076 FORMAT('   ')
 6077 FORMAT('   ',A80)
 6078 FORMAT('   ')
 7077 FORMAT('     ')
 7078 FORMAT('         
')
C
 7070 FORMAT(5X,2A4,' & ')
 7071 FORMAT(5X,A40,'& ')
 8070 FORMAT(5X,2A4)
 8071 FORMAT(5X,A40)
 7072 FORMAT(5X,A1,A1,' ')
 7073 FORMAT(5X,A1,A1,1X,A1,'hline')
 7074 FORMAT(5X,A1,'hline')
 7080 FORMAT(A1,'begin{center}')
 7081 FORMAT(5X,'{',A1,'bf ',80A1)
 7082 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 7083 FORMAT(A1,'end{center}')
 7084 FORMAT(5X,'} ',A1,A1,' ')
 6080 FORMAT(A1,'end{verbatim}')
 6081 FORMAT(A1,'begin{table}')
 6082 FORMAT(A1,'end{table}')
 6086 FORMAT('   ',A1,'begin{tabular}')
 6087 FORMAT('   ',A1,'end{tabular}')
 6088 FORMAT(A1,'begin{verbatim}')
 6091 FORMAT(' & ')
 6093 FORMAT(1X,A1,A1,1X)
 6094 FORMAT(1X,A1,'hline')
C
      WRITE(IPR2,999)
 6355 CONTINUE
C
CCCCC NOVEMBER 1995.  FOLLOWING SECTION SUBSTANTIALLY SIMPLIFIED.
      J=0
      ILINE=0
      DO6400I=1,MAXNPR
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1WRITE(ICOUT,6401)I,ISUB(I)
 6401 FORMAT('I,ISUB(I) = ',2I8)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL DPWRST('XXX','BUG ')
      IF(ISUB(I).EQ.0)GOTO6400
      J=J+1
C
CCCCC NOTE: LATEX DOES NOT PRINT TABLES BEYOND A SINGLE PAGE.
CCCCC THEREFORE NEED TO BREAK LONG TABLES INTO MULTIPLE TABLES
CCCCC (CURRENT MAXIMUM LINE COUNTER IS 40).
C
      IF(IHTMFL.EQ.'LATE')THEN
        ILINE=ILINE+1
        IF(ILINE.GT.40)THEN
C
C  END CURRENT TABLE
C
          WRITE(IPR2,6087)IBACSL
          WRITE(IPR2,7083)IBACSL
          WRITE(IPR2,6082)IBACSL
          WRITE(IPR2,'(1X)')
C
C  START NEW TABLE
C
          WRITE(IPR2,6081)IBACSL
          IF(NCTABT.GT.0)THEN
            WRITE(IPR2,999)
            WRITE(IPR2,7080)IBACSL
            WRITE(IPR2,7081)IBACSL,(ITABTI(II:II),II=1,NCTABT)
            WRITE(IPR2,7084)IBACSL,IBACSL
            WRITE(IPR2,7082)IBACSL,IBACSL,IBACSL,IBACSL
            WRITE(IPR2,7082)IBACSL,IBACSL,IBACSL,IBACSL
            WRITE(IPR2,7083)IBACSL
            WRITE(IPR2,999)
          ENDIF
          WRITE(IPR2,7080)IBACSL
          WRITE(IPR2,6086)IBACSL
          IFMTTA=' '
          IFMTTA(1:1)='{'
          IF(ITABBR.EQ.'ON')THEN
            NCOUNT=1
            DO16362II=1,NUMV
              IFMTTA(NCOUNT+1:NCOUNT+2)='|c'
              NCOUNT=NCOUNT+2
16362       CONTINUE
            IFMTTA(NCOUNT+1:NCOUNT+2)='|}'
            NCOUNT=NCOUNT+2
            IFORMT='(A  )'
            WRITE(IFORMT(3:4),'(I2)')NCOUNT
            WRITE(IPR2,IFORMT)IFMTTA
            IFORMT=' '
          ELSE
            DO16367II=1,NUMV
              IFMTTA(II+1:II+1)='c'
16367       CONTINUE
            NCOUNT=NUMV+2
            IFMTTA(NCOUNT:NCOUNT)='}'
            IFORMT='(A  )'
            WRITE(IFORMT(3:4),'(I2)')NCOUNT
            WRITE(IPR2,IFORMT)IFMTTA
            IFORMT=' '
          ENDIF
C
          IF(ITABBR.EQ.'ON' .OR. ITABBR.EQ.'RULE')THEN
            WRITE(IPR2,7074)IBACSL
          ENDIF
          DO16382II=1,NUMV
            ICOLZZ=IVCOL2(II)
            IF(IVARLB(ICOLZZ).EQ.' ')THEN
              IF(II.LT.NUMV)WRITE(IPR2,7070)JVNAM1(II),JVNAM2(II)
              IF(II.EQ.NUMV)WRITE(IPR2,8070)JVNAM1(II),JVNAM2(II)
            ELSE
              IF(II.LT.NUMV)WRITE(IPR2,7071)IVARLB(ICOLZZ)
              IF(II.EQ.NUMV)WRITE(IPR2,8071)IVARLB(ICOLZZ)
            ENDIF
16382     CONTINUE
          IF(ITABBR.EQ.'RULE' .OR. ITABBR.EQ.'ON')THEN
            WRITE(IPR2,7073)IBACSL,IBACSL,IBACSL
          ELSE
            WRITE(IPR2,7072)IBACSL,IBACSL
          ENDIF
C
          ILINE=0
C
        ENDIF
      ENDIF
C
      DO6410LL=1,NUMV
      IV=LL
      ICOLVJ=IVCOL2(IV)
      IJ=MAXN*(ICOLVJ-1)+I
      IF(ICOLVJ.LE.MAXCOL)ZLIST(LL)=V(IJ)
      IF(ICOLVJ.EQ.MAXCP1)ZLIST(LL)=PRED(I)
      IF(ICOLVJ.EQ.MAXCP2)ZLIST(LL)=RES(I)
      IF(ICOLVJ.EQ.MAXCP3)ZLIST(LL)=YPLOT(I)
      IF(ICOLVJ.EQ.MAXCP4)ZLIST(LL)=XPLOT(I)
      IF(ICOLVJ.EQ.MAXCP5)ZLIST(LL)=X2PLOT(I)
      IF(ICOLVJ.EQ.MAXCP6)ZLIST(LL)=TAGPLO(I)
 6410 CONTINUE
      IF(NCWRIF.GE.1)THEN
        IF(IFMFLG.EQ.'ON')THEN
          DO6412LL=1,NUMV
          IPTR=(I-1)*NUMV+LL
          XSCRT(IPTR)=ZLIST(LL)
 6412     CONTINUE
        ELSE
          IF(ICWRIF(1:5).EQ.'(UNFO'.OR.ICWRIF(1:5).EQ.'(BINA')THEN
            IF(NUMV.LE.5)THEN
              WRITE(IPR2,6469,ERR=6491)(ZLIST(LL),LL=1,NUMV)
            ELSE
             WRITE(IPR2,6489,ERR=6491)(ZLIST(LL),LL=1,NUMV)
            ENDIF
          ELSE
            IF(IHTMFL.EQ.'ON')THEN
              WRITE(IPR2,6055)
              DO6422LL=1,NUMV
                IF(ITABWD.LE.0 .AND. ITABHT.LE.0)THEN
                  WRITE(IPR2,6067)
                ELSEIF(ITABWD.GT.0 .AND. ITABHT.LE.0)THEN
                  WRITE(IPR2,7067)ITABWD
                ELSEIF(ITABWD.LE.0 .AND. ITABHT.GT.0)THEN
                  WRITE(IPR2,7068)ITABHT
                ELSEIF(ITABWD.GT.0 .AND. ITABHT.GT.0)THEN
                  WRITE(IPR2,7067)ITABWD,ITABHT
                ELSE
                  WRITE(IPR2,6067)
                ENDIF
                WRITE(IPR2,ICWRIF)ZLIST(LL)
                WRITE(IPR2,6068)
 6422         CONTINUE
              WRITE(IPR2,6056)
            ELSEIF(IHTMFL.EQ.'LATE')THEN
              DO6427LL=1,NUMV
                WRITE(IPR2,6091)
                WRITE(IPR2,ICWRIF)ZLIST(LL)
                IF(LL.EQ.NUMV)WRITE(IPR2,6093)IBACSL,IBACSL
 6427         CONTINUE
              WRITE(IPR2,6056)
            ELSE
              WRITE(IPR2,ICWRIF,ERR=6491)(ZLIST(LL),LL=1,NUMV)
            ENDIF
          ENDIF
        ENDIF
      ELSEIF(IFORSW.EQ.'E'.OR.IFORSW.EQ.'EXP'.OR.IFORSW.EQ.'EXPO')THEN
        IF(IHTMFL.EQ.'ON')THEN
          WRITE(IPR2,6055)
          DO6472LL=1,NUMV
            IF(ITABWD.LE.0 .AND. ITABHT.LE.0)THEN
              WRITE(IPR2,6067)
            ELSEIF(ITABWD.GT.0 .AND. ITABHT.LE.0)THEN
              WRITE(IPR2,7067)ITABWD
            ELSEIF(ITABWD.LE.0 .AND. ITABHT.GT.0)THEN
              WRITE(IPR2,7068)ITABHT
            ELSEIF(ITABWD.GT.0 .AND. ITABHT.GT.0)THEN
              WRITE(IPR2,7067)ITABWD,ITABHT
            ELSE
              WRITE(IPR2,6067)
            ENDIF
            WRITE(IPR2,6469)ZLIST(LL)
            WRITE(IPR2,6068)
 6472     CONTINUE
          WRITE(IPR2,6056)
        ELSEIF(IHTMFL.EQ.'LATE')THEN
          DO6474LL=1,NUMV
            IF(LL.LT.NUMV)WRITE(IPR2,16469)ZLIST(LL)
            IF(LL.EQ.NUMV)WRITE(IPR2,26469)ZLIST(LL),IBACSL,IBACSL
 6474     CONTINUE
          IF(ITABBR.EQ.'ON')WRITE(IPR2,6094)IBACSL
        ELSE
          IF(NUMV.LE.5)THEN
            WRITE(IPR2,6469,ERR=6491)(ZLIST(LL),LL=1,NUMV)
          ELSE
            WRITE(IPR2,6489,ERR=6491)(ZLIST(LL),LL=1,NUMV)
          ENDIF
        ENDIF
      ELSEIF(IFORSW.EQ.'0')THEN
        IF(IHTMFL.EQ.'ON')THEN
          WRITE(IPR2,6055)
          DO6477LL=1,NUMV
            IF(ITABWD.LE.0 .AND. ITABHT.LE.0)THEN
              WRITE(IPR2,6067)
            ELSEIF(ITABWD.GT.0 .AND. ITABHT.LE.0)THEN
              WRITE(IPR2,7067)ITABWD
            ELSEIF(ITABWD.LE.0 .AND. ITABHT.GT.0)THEN
              WRITE(IPR2,7068)ITABHT
            ELSEIF(ITABWD.GT.0 .AND. ITABHT.GT.0)THEN
              WRITE(IPR2,7067)ITABWD,ITABHT
            ELSE
              WRITE(IPR2,6067)
            ENDIF
            WRITE(IPR2,6450)ZLIST(LL)
            WRITE(IPR2,6068)
 6477     CONTINUE
          WRITE(IPR2,6056)
        ELSEIF(IHTMFL.EQ.'LATE')THEN
          DO6479LL=1,NUMV
            IF(LL.LT.NUMV)WRITE(IPR2,16450)ZLIST(LL)
            IF(LL.EQ.NUMV)WRITE(IPR2,26450)ZLIST(LL),IBACSL,IBACSL
 6479     CONTINUE
          IF(ITABBR.EQ.'ON')WRITE(IPR2,6094)IBACSL
        ELSE
          IF(NUMV.LE.5)THEN
            WRITE(IPR2,6450,ERR=6491)
     1        (INT(ZLIST(LL)+SIGN(HALF,ZLIST(LL))),LL=1,NUMV)
          ELSE
            WRITE(IPR2,6470,ERR=6491)
     1        (INT(ZLIST(LL)+SIGN(HALF,ZLIST(LL))),LL=1,NUMV)
          ENDIF
        ENDIF
      ELSEIF(NUMDIG.GE.1.AND.NUMDIG.LE.12)THEN
        IF(IHTMFL.EQ.'ON')THEN
          IFORMT='(  F15.  )'
          WRITE(IFORMT(8:9),'(I2)')NUMDIG
          WRITE(IPR2,6055)
          DO6482LL=1,NUMV
            IF(ITABWD.LE.0 .AND. ITABHT.LE.0)THEN
              WRITE(IPR2,6067)
            ELSEIF(ITABWD.GT.0 .AND. ITABHT.LE.0)THEN
              WRITE(IPR2,7067)ITABWD
            ELSEIF(ITABWD.LE.0 .AND. ITABHT.GT.0)THEN
              WRITE(IPR2,7068)ITABHT
            ELSEIF(ITABWD.GT.0 .AND. ITABHT.GT.0)THEN
              WRITE(IPR2,7067)ITABWD,ITABHT
            ELSE
              WRITE(IPR2,6067)
            ENDIF
            WRITE(IPR2,IFORMT,ERR=6491)ZLIST(LL)
            WRITE(IPR2,6068)
 6482     CONTINUE
          WRITE(IPR2,6056)
        ELSEIF(IHTMFL.EQ.'LATE')THEN
          IFORMT='(5X,  F15.  ,  &  )'
          IFORMT(14:14)=IQUOTE
          IFORMT(18:18)=IQUOTE
          WRITE(IFORMT(11:12),'(I2)')NUMDIG
          DO6484LL=1,NUMV
            IF(LL.LT.NUMV)WRITE(IPR2,IFORMT,ERR=6491)ZLIST(LL)
            IF(LL.EQ.NUMV)THEN
              IFORMT(17:17)=IQUOTE
              IFORMT(16:16)=IBACSL
              IFORMT(17:17)=IBACSL
              WRITE(IPR2,IFORMT,ERR=6491)ZLIST(LL)
            ENDIF
 6484     CONTINUE
          IF(ITABBR.EQ.'ON')WRITE(IPR2,6094)IBACSL
        ELSE
          IFORMT='(  F15.  )'
          WRITE(IFORMT(2:3),'(I2)')NUMV
          WRITE(IFORMT(8:9),'(I2)')NUMDIG
          WRITE(IPR2,IFORMT,ERR=6491)(ZLIST(LL),LL=1,NUMV)
        ENDIF
      ELSE
        IF(IHTMFL.EQ.'ON')THEN
          WRITE(IPR2,6055)
          DO6492LL=1,NUMV
            IF(ITABWD.LE.0 .AND. ITABHT.LE.0)THEN
              WRITE(IPR2,6067)
            ELSEIF(ITABWD.GT.0 .AND. ITABHT.LE.0)THEN
              WRITE(IPR2,7067)ITABWD
            ELSEIF(ITABWD.LE.0 .AND. ITABHT.GT.0)THEN
              WRITE(IPR2,7068)ITABHT
            ELSEIF(ITABWD.GT.0 .AND. ITABHT.GT.0)THEN
              WRITE(IPR2,7067)ITABWD,ITABHT
            ELSE
              WRITE(IPR2,6067)
            ENDIF
            WRITE(IPR2,6469)ZLIST(LL)
            WRITE(IPR2,6068)
 6492     CONTINUE
          WRITE(IPR2,6056)
        ELSEIF(IHTMFL.EQ.'LATE')THEN
          DO6494LL=1,NUMV
            IF(LL.LT.NUMV)WRITE(IPR2,16469)ZLIST(LL)
            IF(LL.EQ.NUMV)WRITE(IPR2,26469)ZLIST(LL),IBACSL,IBACSL
 6494     CONTINUE
          IF(ITABBR.EQ.'ON')WRITE(IPR2,6094)IBACSL
        ELSE
          IF(NUMV.LE.5)THEN
            WRITE(IPR2,6469,ERR=6491)(ZLIST(LL),LL=1,NUMV)
          ELSE
            WRITE(IPR2,6489,ERR=6491)(ZLIST(LL),LL=1,NUMV)
          ENDIF
        ENDIF
      ENDIF
C
 6400 CONTINUE
      IF(IFMFLG.EQ.'ON')THEN
        NPTS=MAXNPR*NUMV
        WRITE(IPR2)(XSCRT(I),I=1,NPTS)
      ENDIF
C
 6450 FORMAT(1X,I10,5X,I10,5X,I10,5X,I10,5X,I10,5X)
 6469 FORMAT(1X,5E15.7)
16450 FORMAT(1X,I10,' & ')
26450 FORMAT(1X,I10,1X,A1,A1)
16469 FORMAT(1X,E15.7,' & ')
26469 FORMAT(1X,E15.7,1X,A1,A1)
C
 6470 FORMAT(1X,I10,2X,I10,2X,I10,2X,I10,2X,I10,2X,
     1I10,2X,I10,2X,I10,2X,I10,2X,I10,2X)
 6489 FORMAT(1X,10E12.4)
16489 FORMAT(1X,E12.4,' & ')
26489 FORMAT(1X,E12.4,1X,A1,A1)
C
 6490 CONTINUE
      IF(IHTMFL.EQ.'ON')THEN
        WRITE(IPR2,6054)
        WRITE(IPR2,6062)
        WRITE(IPR2,999)
        WRITE(IPR2,6052)
      ELSEIF(IHTMFL.EQ.'LATE')THEN
        WRITE(IPR2,6087)IBACSL
        WRITE(IPR2,7083)IBACSL
        WRITE(IPR2,6082)IBACSL
        WRITE(IPR2,'(1X)')
        WRITE(IPR2,6088)IBACSL
      ENDIF
      GOTO6499
C
 6491 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6493)
 6493 FORMAT('***** ERROR TRYING TO WRITE DATA TO AN EXTERNAL ',
     1       'FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6495)
 6495 FORMAT('      MOST LIKELY CAUSE IS AN INVALID SET WRITE ',
     1       'FORMAT COMMAND.')
      CALL DPWRST('XXX','BUG ')
      GOTO8800
C
 6499 CONTINUE
C
C               **********************************************************
C               **  STEP 7.2--                                          **
C               **  PRINT OUT MATRICES
C               **  FIRST, BRANCH TO THE APPROPRIATE SUBCASE            **
C               **  (DEPENDING ON WHETHER UNQUALIFIED, SUBSET OR FOR);  **
C               **  THE DETERMINE THE LENGTH OF THE LONGEST             **
C               **  VARIABLE TO BE PRINTED OUT;                         **
C               **  THEN PRINT OUT THE VARIABLES                        **
C               **  THAT WERE SPECIFIED.                                **
C               **********************************************************
C
      ISTEPN='7.2'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WRIT')GOTO7090
      WRITE(ICOUT,7011)NUMM,NIM(1),NIM(2),NIM(3)
 7011 FORMAT('NUMM,NIM(1),NIM(2),NIM(3) = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7012)IMVAL1(1),IMVAL1(2),IMVAL1(3)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7012)IMVAL1(1),IMVAL2(1),IMVAL1(2),IMVAL2(2)
 7012 FORMAT('IMVAL1(1),IMVAL2(1),IMVAL1(2),IMVAL2(2) = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7013)ICASEQ,IPR,IPR2
 7013 FORMAT('ICASEQ,IPR,IPR2 = ',A4,2X,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7014)JMNAM1(1),JMNAM2(1)
 7014 FORMAT('JMNAM1(1),JMNAM2(1) = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
 7090 CONTINUE
C
      IF(NUMM.LE.0)GOTO7590
      DO7100IM=1,NUMM
C
      NR1=NIM(IM)
      NC1=IMVAL2(IM)-IMVAL1(IM)+1
C
      IF(IOFILE.EQ.'YES')GOTO7113
      IF(NCWRIF.GE.1)GOTO7113
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7111)JMNAM1(IM),JMNAM2(IM),NR1
 7111 FORMAT('        MATRIX ',A4,A4,'--     ',I8,' ROWS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7112)NC1
 7112 FORMAT('               ',4X,4X,'--     ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
 7113 CONTINUE
C
      MAXNPR=NR1
      IF(ICASEQ.EQ.'FULL')GOTO7310
      IF(ICASEQ.EQ.'SUBS')GOTO7320
      IF(ICASEQ.EQ.'FOR')GOTO7330
C
 7310 CONTINUE
      DO7315I=1,MAXNPR
      ISUB(I)=1
 7315 CONTINUE
      NQ=MAXNPR
      GOTO7350
C
 7320 CONTINUE
      NIOLD=MAXNPR
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO7350
C
 7330 CONTINUE
      NIOLD=MAXNPR
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO7350
C
 7350 CONTINUE
      IHMAT1=JMNAM1(IM)
      IHMAT2=JMNAM2(IM)
      DO7351I=1,NC1
      CALL DPAPN2(IHMAT1,IHMAT2,I,
     1JMNAM3(I),JMNAM4(I),IBUGS2,ISUBRO,IERROR)
 7351 CONTINUE
C
      IF(IOFILE.EQ.'YES')GOTO7355
      IF(NCWRIF.GE.1)GOTO7355
      WRITE(IPR2,999)
      IF(NC1.LE.5)WRITE(IPR2,7041)(JMNAM3(I),JMNAM4(I),I=1,NC1)
      IF(NC1.GT.5)WRITE(IPR2,7042)(JMNAM3(I),JMNAM4(I),I=1,NC1)
 7041 FORMAT(1X,'VARIABLES--',2A4,7X,2A4,7X,2A4,7X,2A4,7X,2A4)
 7042 FORMAT(1X,'VARIABLES--',2A4,4X,2A4,4X,2A4,4X,2A4,4X,2A4,
     14X,2A4,4X,2A4,4X,2A4,4X,2A4,4X,2A4)
      WRITE(IPR2,999)
 7355 CONTINUE
C
      J=0
      DO7500I=1,MAXNPR
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1WRITE(ICOUT,7501)I,ISUB(I)
 7501 FORMAT('I,ISUB(I) = ',2I8)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL DPWRST('XXX','BUG ')
      IF(ISUB(I).EQ.0)GOTO7500
      J=J+1
C
      DO7510LL=1,NC1
      JM=LL
      ICOLVJ=IMVAL1(IM)+JM-1
      IJ=MAXN*(ICOLVJ-1)+I
      IF(ICOLVJ.LE.MAXCOL)ZLIST(LL)=V(IJ)
      IF(ICOLVJ.EQ.MAXCP1)ZLIST(LL)=PRED(I)
      IF(ICOLVJ.EQ.MAXCP2)ZLIST(LL)=RES(I)
      IF(ICOLVJ.EQ.MAXCP3)ZLIST(LL)=YPLOT(I)
      IF(ICOLVJ.EQ.MAXCP4)ZLIST(LL)=XPLOT(I)
      IF(ICOLVJ.EQ.MAXCP5)ZLIST(LL)=X2PLOT(I)
      IF(ICOLVJ.EQ.MAXCP6)ZLIST(LL)=TAGPLO(I)
 7510 CONTINUE
      IF(NCWRIF.GE.1)THEN
        IF(IFMFLG.EQ.'ON')THEN
          DO7512LL=1,NC1
          IPTR=(I-1)*NC1+LL
          XSCRT(IPTR)=ZLIST(LL)
 7512     CONTINUE
        ELSE
          IF(ICWRIF(1:5).EQ.'(UNFO'.OR.ICWRIF(1:5).EQ.'(BINA')THEN
            IF(NC1.LE.5)THEN
              WRITE(IPR2,7569)(ZLIST(LL),LL=1,NC1)
            ELSE
              WRITE(IPR2,7589)(ZLIST(LL),LL=1,NC1)
            ENDIF
          ELSE
            WRITE(IPR2,ICWRIF)(ZLIST(LL),LL=1,NC1)
          ENDIF
        ENDIF
      ELSEIF(IFORSW.EQ.'E'.OR.IFORSW.EQ.'EXP'.OR.IFORSW.EQ.'EXPO')THEN
        IF(NC1.LE.5)THEN
          WRITE(IPR2,7569)(ZLIST(LL),LL=1,NC1)
        ELSE
          WRITE(IPR2,7589)(ZLIST(LL),LL=1,NC1)
        ENDIF
      ELSEIF(IFORSW.EQ.'0')THEN
        IF(NC1.LE.5)THEN
        WRITE(IPR2,7550)(INT(ZLIST(LL)+SIGN(HALF,ZLIST(LL))),LL=1,NC1)
        ELSE
        WRITE(IPR2,7570)(INT(ZLIST(LL)+SIGN(HALF,ZLIST(LL))),LL=1,NC1)
        ENDIF
      ELSEIF(NUMDIG.GE.1.AND.NUMDIG.LE.12)THEN
        IFORMT='(  F15.  )'
        WRITE(IFORMT(2:3),'(I2)')NC1
        WRITE(IFORMT(8:9),'(I2)')NUMDIG
        WRITE(IPR2,IFORMT)(ZLIST(LL),LL=1,NC1)
      ELSE
        IF(NC1.LE.5)THEN
          WRITE(IPR2,7569)(ZLIST(LL),LL=1,NC1)
        ELSE
          WRITE(IPR2,7589)(ZLIST(LL),LL=1,NC1)
        ENDIF
      ENDIF
C
 7500 CONTINUE
C
      IF(IFMFLG.EQ.'ON')THEN
        NPTS=MAXNPR*NC1
        WRITE(IPR2)(XSCRT(I),I=1,NPTS)
      ENDIF
C
 7550 FORMAT(1X,I10,5X,I10,5X,I10,5X,I10,5X,I10,5X)
 7569 FORMAT(1X,5E15.7)
C
 7570 FORMAT(1X,I10,2X,I10,2X,I10,2X,I10,2X,I10,2X,
     1I10,2X,I10,2X,I10,2X,I10,2X,I10,2X)
 7589 FORMAT(1X,10E12.4)
C
 7100 CONTINUE
 7590 CONTINUE
C
C               **************************************************
C               **  STEP 8A--                                   **
C               **  PRINT OUT THE LIST OF UNDEFINED NAMES.      **
C               **************************************************
C
      ISTEPN='8A'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMU.LE.0)GOTO8190
      WRITE(IPR2,999)
      WRITE(IPR2,8111)
 8111 FORMAT(1X,'UNDEFINED NAMES--')
      WRITE(IPR2,999)
      DO8120I=1,NUMU
      WRITE(IPR2,8121)JUNAM1(I),JUNAM2(I)
 8121 FORMAT(1X,2A4)
 8120 CONTINUE
      WRITE(IPR2,999)
 8190 CONTINUE
      GOTO8800
C
C               ***************************************
C               **  STEP 88--                        **
C               **  FOR THE FILE CASE,               **
C               **  CLOSE THE FILE.                  **
C               ***************************************
C
 8800 CONTINUE
      ISTEPN='88'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'WRIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES'.AND.ICURST.EQ.'OPEN')GOTO8810
      GOTO8890
 8810 CONTINUE
      IENDFI='ON'
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT AND THE  (DECEMBER 1988)
CCCCC SUBSEQUENT 2 LINES ADDED     DECEMBER 1988
CCCCC IREWIN='ON'  DECEMBER 1988
CCCCC IREWIN='OFF'
      IREWIN='ON'
      IF(IWRIRW.EQ.'ON')
     1CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
CCCCC THE FOLLOWING LINE WAS ADDED  DECEMBER 1988
      IF(IWRIRW.EQ.'ON')IWRICS='CLOSED'
 8890 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'WRIT')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IBUGS2,IBUGQ
 9014 FORMAT('IBUGS2,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFOUND,IERROR
 9015 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IMACRO,IMACNU,IMACCS
 9016 FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IPR,IPR2
 9017 FORMAT('IPR,IPR2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IOFILE,IOTERM
 9018 FORMAT('IOFILE,IOTERM = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGS2,ISUBRO,IERROR
 9019 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFORSW
 9020 FORMAT('IFORSW = ',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,9061)NCWRIF
 9061 FORMAT('NCWRIF = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCWRIF.GE.1)WRITE(ICOUT,9062)(ICWRIF(I:I),I=1,NCWRIF)
 9062 FORMAT('(ICWRIF(I:I),I=1,NCWRIF) = ',80A1)
      IF(NCWRIF.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9071)IWRIRW
 9071 FORMAT('IWRIRW = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWRLA(PXMIN,PYMIN,PXMAX,PYMAX,
     1ITITTE,NCTITL,ITITCV,PTITRV,
     1IX1LTE,NCX1LA,IX1LCV,PX1LRV,
     1IX2LTE,NCX2LA,IX2LCV,PX2LRV,
     1IX3LTE,NCX3LA,IX3LCV,PX3LRV,
     1IY1LTE,NCY1LA,IY1LCV,PY1LRV,
     1IY2LTE,NCY2LA,IY2LCV,PY2LRV,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,ISEQSW,NUMSEQ)
C
C     PURPOSE--WRITE OUT LABELS, AND THE TITLE
C              ON A PLOT.
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 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--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --FEBRUARY   1989.  VERTICAL JUST. OF Y...LABEL (ALAN)
C     UPDATED         --FEBRUARY   1989.  VERTICAL SIZE OF Y...LABEL (ALAN)
C     UPDATED         --OCTOBER    1999.  JUSTIFICATION AND OFFSET FOR
C                                         LABELS
C     UPDATED         --NOVEMBER   1999.  DIRECTION AND ANGLE FOR
C                                         LABELS
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ITITTE
      CHARACTER*4 ITITFO
      CHARACTER*4 ITITCA
      CHARACTER*4 ITITFI
      CHARACTER*4 ITITCO
C
      CHARACTER*4 IX1LTE
      CHARACTER*4 IX1LFO
      CHARACTER*4 IX1LCA
      CHARACTER*4 IX1LFI
      CHARACTER*4 IX1LCO
      CHARACTER*4 IX1LJU
      CHARACTER*4 IX1LDI
C
      CHARACTER*4 IX2LTE
      CHARACTER*4 IX2LFO
      CHARACTER*4 IX2LCA
      CHARACTER*4 IX2LFI
      CHARACTER*4 IX2LCO
      CHARACTER*4 IX2LJU
      CHARACTER*4 IX2LDI
C
      CHARACTER*4 IX3LTE
      CHARACTER*4 IX3LFO
      CHARACTER*4 IX3LCA
      CHARACTER*4 IX3LFI
      CHARACTER*4 IX3LCO
      CHARACTER*4 IX3LJU
      CHARACTER*4 IX3LDI
C
      CHARACTER*4 IY1LTE
      CHARACTER*4 IY1LFO
      CHARACTER*4 IY1LCA
      CHARACTER*4 IY1LFI
      CHARACTER*4 IY1LCO
      CHARACTER*4 IY1LJU
      CHARACTER*4 IY1LDI
C
      CHARACTER*4 IY2LTE
      CHARACTER*4 IY2LFO
      CHARACTER*4 IY2LCA
      CHARACTER*4 IY2LFI
      CHARACTER*4 IY2LCO
      CHARACTER*4 IY2LJU
      CHARACTER*4 IY2LDI
C
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILL
      CHARACTER*4 ICOL
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
      CHARACTER*4 IMPSW2
C
      CHARACTER*4 ICTEXT
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IFUNC
C
      CHARACTER*1 IREPCH
C
      CHARACTER*4 ISEQSW
C
      CHARACTER*4 ITITCV
      CHARACTER*4 IX1LCV
      CHARACTER*4 IX2LCV
      CHARACTER*4 IX3LCV
      CHARACTER*4 IY1LCV
      CHARACTER*4 IY2LCV
C
      DIMENSION ITITTE(*)
      DIMENSION IX1LTE(*)
      DIMENSION IX2LTE(*)
      DIMENSION IX3LTE(*)
      DIMENSION IY1LTE(*)
      DIMENSION IY2LTE(*)
C
      DIMENSION ICTEXT(130)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IFUNC(*)
C
      DIMENSION ITITCV(*)
      DIMENSION PTITRV(*)
      DIMENSION IX1LCV(*)
      DIMENSION PX1LRV(*)
      DIMENSION IX2LCV(*)
      DIMENSION PX2LRV(*)
      DIMENSION IX3LCV(*)
      DIMENSION PX3LRV(*)
      DIMENSION IY1LCV(*)
      DIMENSION PY1LRV(*)
      DIMENSION IY2LCV(*)
      DIMENSION PY2LRV(*)
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
      ITITFO=ITITCV(1)
      ITITCA=ITITCV(2)
      ITITFI=ITITCV(3)
      ITITCO=ITITCV(4)
      PTITHE=PTITRV(1)
      PTITWI=PTITRV(2)
      PTITVG=PTITRV(3)
      PTITHG=PTITRV(4)
      PTITTH=PTITRV(5)
      PTITDS=PTITRV(6)
C
      IX1LFO=IX1LCV(1)
      IX1LCA=IX1LCV(2)
      IX1LFI=IX1LCV(3)
      IX1LCO=IX1LCV(4)
      IX1LJU=IX1LCV(5)
      IX1LDI=IX1LCV(6)
      PX1LHE=PX1LRV(1)
      PX1LWI=PX1LRV(2)
      PX1LVG=PX1LRV(3)
      PX1LHG=PX1LRV(4)
      PX1LTH=PX1LRV(5)
      PX1LDS=PX1LRV(6)
      PX1LOF=PX1LRV(7)
      PX1LAN=PX1LRV(8)
C
      IX2LFO=IX2LCV(1)
      IX2LCA=IX2LCV(2)
      IX2LFI=IX2LCV(3)
      IX2LCO=IX2LCV(4)
      IX2LJU=IX2LCV(5)
      IX2LDI=IX2LCV(6)
      PX2LHE=PX2LRV(1)
      PX2LWI=PX2LRV(2)
      PX2LVG=PX2LRV(3)
      PX2LHG=PX2LRV(4)
      PX2LTH=PX2LRV(5)
      PX2LDS=PX2LRV(6)
      PX2LOF=PX2LRV(7)
      PX2LAN=PX2LRV(8)
C
      IX3LFO=IX3LCV(1)
      IX3LCA=IX3LCV(2)
      IX3LFI=IX3LCV(3)
      IX3LCO=IX3LCV(4)
      IX3LJU=IX3LCV(5)
      IX3LDI=IX3LCV(6)
      PX3LHE=PX3LRV(1)
      PX3LWI=PX3LRV(2)
      PX3LVG=PX3LRV(3)
      PX3LHG=PX3LRV(4)
      PX3LTH=PX3LRV(5)
      PX3LDS=PX3LRV(6)
      PX3LOF=PX3LRV(7)
      PX3LAN=PX3LRV(8)
C
      IY1LFO=IY1LCV(1)
      IY1LCA=IY1LCV(2)
      IY1LFI=IY1LCV(3)
      IY1LCO=IY1LCV(4)
      IY1LJU=IY1LCV(5)
      IY1LDI=IY1LCV(6)
      PY1LHE=PY1LRV(1)
      PY1LWI=PY1LRV(2)
      PY1LVG=PY1LRV(3)
      PY1LHG=PY1LRV(4)
      PY1LTH=PY1LRV(5)
      PY1LDS=PY1LRV(6)
      PY1LOF=PY1LRV(7)
      PY1LAN=PY1LRV(8)
C
      IY2LFO=IY2LCV(1)
      IY2LCA=IY2LCV(2)
      IY2LFI=IY2LCV(3)
      IY2LCO=IY2LCV(4)
      IY2LJU=IY2LCV(5)
      IY2LDI=IY2LCV(6)
      PY2LHE=PY2LRV(1)
      PY2LWI=PY2LRV(2)
      PY2LVG=PY2LRV(3)
      PY2LHG=PY2LRV(4)
      PY2LTH=PY2LRV(5)
      PY2LDS=PY2LRV(6)
      PY2LOF=PY2LRV(7)
      PY2LAN=PY2LRV(8)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRLA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWRLA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL
   52 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMNAM
   55 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ISEQSW,NUMSEQ
   56 FORMAT('ISEQSW,NUMSEQ = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IREPCH
   61 FORMAT('IREPCH = ',A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  WRITE OUT THE TITLE  **
C               ***************************
C
      IF(NCTITL.LE.0)GOTO1190
C
      PX1=(PXMIN+PXMAX)/2.0
      PY1=PYMAX+PTITDS
C
      NCTEXT=NCTITL
      DO1110I=1,NCTEXT
      ICTEXT(I)=ITITTE(I)
 1110 CONTINUE
C
      IFONT=ITITFO
      ICASE=ITITCA
      IJUST='CEBO'
      IDIR='HORI'
      ANGLE=0.0
      IFILL=ITITFI
      ICOL=ITITCO
C
      PHEIGH=PTITHE
      PWIDTH=PTITWI
      PVEGAP=PTITVG
      PHOGAP=PTITHG
      PTHICK=PTITTH
C
      IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGG4,IERRG4)
C
      CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
 1190 CONTINUE
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  WRITE OUT THE FIRST HORIZONTAL AXIS LABEL  **
C               *************************************************
C
      IF(NCX1LA.LE.0)GOTO1290
C
      PX1=((PXMIN+PXMAX)/2.0)+PX1LOF
      PY1=PYMIN-PX1LDS-PX1LHE
C
      NCTEXT=NCX1LA
      DO1210I=1,NCTEXT
      ICTEXT(I)=IX1LTE(I)
 1210 CONTINUE
C
      IFONT=IX1LFO
      ICASE=IX1LCA
CCCCC IJUST='CEBO'
      IJUST=IX1LJU
CCCCC IDIR='HORI'
      IDIR=IX1LDI
CCCCC ANGLE=0.0
      ANGLE=PX1LAN
      IFILL=IX1LFI
      ICOL=IX1LCO
C
      PHEIGH=PX1LHE
      PWIDTH=PX1LWI
      PVEGAP=PX1LVG
      PHOGAP=PX1LHG
      PTHICK=PX1LTH
C
      IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGG4,IERRG4)
C
      CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
 1290 CONTINUE
C
C               **************************************************
C               **  STEP 3--                                    **
C               **  WRITE OUT THE SECOND HORIZONTAL AXIS LABEL  **
C               **************************************************
C
      IF(NCX2LA.LE.0)GOTO1390
C
      PX1=((PXMIN+PXMAX)/2.0)+PX2LOF
      PY1=PYMIN-PX2LDS-PX2LHE
C
      NCTEXT=NCX2LA
      DO1310I=1,NCTEXT
      ICTEXT(I)=IX2LTE(I)
 1310 CONTINUE
C
      IFONT=IX2LFO
      ICASE=IX2LCA
      IJUST='CEBO'
CCCCC IJUST=IX2LJU
CCCCC IDIR='HORI'
      IDIR=IX2LDI
CCCCC ANGLE=0.0
      ANGLE=PX2LAN
      IFILL=IX2LFI
      ICOL=IX2LCO
C
      PHEIGH=PX2LHE
      PWIDTH=PX2LWI
      PVEGAP=PX2LVG
      PHOGAP=PX2LHG
      PTHICK=PX2LTH
C
      IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGG4,IERRG4)
C
      CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
 1390 CONTINUE
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  WRITE OUT THE THIRD  HORIZONTAL AXIS LABEL  **
C               **************************************************
C
      IF(NCX3LA.LE.0)GOTO1490
C
      PX1=((PXMIN+PXMAX)/2.0)+PX3LOF
      PY1=PYMIN-PX3LDS-PX3LHE
C
      NCTEXT=NCX3LA
      DO1410I=1,NCTEXT
      ICTEXT(I)=IX3LTE(I)
 1410 CONTINUE
C
      IFONT=IX3LFO
      ICASE=IX3LCA
CCCCC IJUST='CEBO'
      IJUST=IX3LJU
CCCCC IDIR='HORI'
      IDIR=IX3LDI
CCCCC ANGLE=0.0
      ANGLE=PX3LAN
      IFILL=IX3LFI
      ICOL=IX3LCO
C
      PHEIGH=PX3LHE
      PWIDTH=PX3LWI
      PVEGAP=PX3LVG
      PHOGAP=PX3LHG
      PTHICK=PX3LTH
C
      IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGG4,IERRG4)
C
      CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
 1490 CONTINUE
C
C               ***********************************************
C               **  STEP 5--                                 **
C               **  WRITE OUT THE LEFT  VERTICAL AXIS LABEL  **
C               ***********************************************
C
      IF(NCY1LA.LE.0)GOTO1590
C
      PX1=PXMIN-PY1LDS-PY1LWI
      PY1=((PYMIN+PYMAX)/2.0)+PY1LOF
C
      NCTEXT=NCY1LA
      DO1510I=1,NCTEXT
      ICTEXT(I)=IY1LTE(I)
 1510 CONTINUE
C
      IFONT=IY1LFO
      ICASE=IY1LCA
CCCCC THE FOLLOWING 1-LINE FIX WAS DONE                     FEBRUARY 1989
CCCCC TO USE THE CENTER FOR VERTICAL JUST. OF Y1LABEL.      FEBRUARY 1989
CCCCC THE CENTER IS THE NEEDED CHOICE FOR METAFILE DEVICES  FEBRUARY 1989
CCCCC AND FOR DEVICES THAT SUPPORT ROTATED TEXT (ALAN)      FEBRUARY 1989
CCCCC IJUST='CEBO'
CCCCC IJUST='CECE'
      IJUST=IY1LJU
CCCCC IDIR='VERT'
CCCCC ANGLE=90.0
      IDIR=IY1LDI
      ANGLE=PY1LAN
      IFILL=IY1LFI
      ICOL=IY1LCO
C
CCCCC START OF FIX  AUGUST 1989 (& FEBRUARY 1989 FOR VAX)
CCCCC KEY THE SIZE TO HORIZONTAL CHARACTER SIZE.  THIS WILL MAKE THE
CCCCC SIZE OF THE Y1LABEL THE SAME AS THE SIZE OF THE XLABEL
CCCCC UPDATE FIX: JANUARY, 1987  (& FEBRUARY 1989 FOR VAX)
CCCCC IF HARDWARE CHARACTERS, APPLY THE FIX.  IF SOFTWARE CHARACTERS,
CCCCC DO NOT APPLY THE FIX.
C
      IF(IFONT.EQ.'TEKT')GOTO1520
      PHEIGH=PY1LHE*(ANUMVP/ANUMHP)
      PWIDTH=PY1LWI*(ANUMHP/ANUMVP)
      PVEGAP=PY1LVG*(ANUMVP/ANUMHP)
      PHOGAP=PY1LHG*(ANUMHP/ANUMVP)
      GOTO1530
 1520 CONTINUE
      PHEIGH=PY1LHE
      PWIDTH=PY1LWI
      PVEGAP=PY1LVG
      PHOGAP=PY1LHG
 1530 CONTINUE
      PTHICK=PY1LTH
C
CCCCC END OF FIX
C
      IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGG4,IERRG4)
C
      CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
 1590 CONTINUE
C
C               ***********************************************
C               **  STEP 6--                                 **
C               **  WRITE OUT THE RIGHT VERTICAL AXIS LABEL  **
C               ***********************************************
C
      IF(NCY2LA.LE.0)GOTO1690
C
      PX1=PXMAX+PY2LDS
      PY1=((PYMIN+PYMAX)/2.0)+PY2LOF
C
      NCTEXT=NCY2LA
      DO1610I=1,NCTEXT
      ICTEXT(I)=IY2LTE(I)
 1610 CONTINUE
C
      IFONT=IY2LFO
      ICASE=IY2LCA
CCCCC THE FOLLOWING 1-LINE FIX WAS DONE                     FEBRUARY 1989
CCCCC TO USE THE CENTER FOR VERTICAL JUST. OF Y2LABEL.      FEBRUARY 1989
CCCCC THE CENTER IS THE NEEDED CHOICE FOR METAFILE DEVICES  FEBRUARY 1989
CCCCC AND FOR DEVICES THAT SUPPORT ROTATED TEXT (ALAN)      FEBRUARY 1989
CCCCC IJUST='CEBO'
CCCCC IJUST='CECE'
      IJUST=IY2LJU
CCCCC IDIR='VERT'
CCCCC ANGLE=90.0
      IDIR=IY2LDI
      ANGLE=PY2LAN
      IFILL=IY2LFI
      ICOL=IY2LCO
C
CCCCC START OF FIX   (FEBRUARY 1989 FOR VAX)
CCCCC KEY THE SIZE TO HORIZONTAL CHARACTER SIZE.  THIS WILL MAKE THE
CCCCC SIZE OF THE Y2LABEL THE SAME AS THE SIZE OF THE XLABEL
CCCCC UPDATE FIX: JANUARY, 1987 (& FEBRUARY 1989 FOR VAX)
CCCCC IF HARDWARE CHARACTERS, APPLY THE FIX.  IF SOFTWARE CHARACTERS,
CCCCC DO NOT APPLY THE FIX.
C
      IF(IFONT.EQ.'TEKT')GOTO1620
      PHEIGH=PY2LHE*(ANUMVP/ANUMHP)
      PWIDTH=PY2LWI*(ANUMHP/ANUMVP)
      PVEGAP=PY2LVG*(ANUMVP/ANUMHP)
      PHOGAP=PY2LHG*(ANUMHP/ANUMVP)
      GOTO1630
 1620 CONTINUE
      PHEIGH=PY2LHE
      PWIDTH=PY2LWI
      PVEGAP=PY2LVG
      PHOGAP=PY2LHG
 1630 CONTINUE
C
CCCCC END OF FIX
C
      PTHICK=PY2LTH
C
      IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGG4,IERRG4)
C
      CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
 1690 CONTINUE
C
C               *************************************
C               **  STEP 7--                       **
C               **  WRITE OUT THE SEQUENCE NUMBER  **
C               *************************************
C
      IF(ISEQSW.EQ.'OFF')GOTO1790
C
      PX1=PXMAX+10.0
      IF(PX1.GT.95.0)PX1=95.0
      PY1=PYMAX+5.0
      IF(PY1.GT.94.0)PY1=94.0
C
      ANUMSE=NUMSEQ
      CALL DPCONH(NUMSEQ,ANUMSE,ICTEXT,NCTEXT,IBUGG4,IERRG4)
C
      IFONT=ITITFO
      ICASE=ITITCA
      IJUST='CEBO'
      IDIR='HORI'
      ANGLE=0.0
      IFILL=ITITFI
      ICOL=ITITCO
C
      PHEIGH=PTITHE
      PWIDTH=PTITWI
      PVEGAP=PTITVG
      PHOGAP=PTITHG
      PTHICK=PTITTH
C
CCCCC IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
CCCCC1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
CCCCC1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
CCCCC1IBUGG4,IERRG4)
C
      CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
C     THE FOLLOWING LINE +
C     SOME ADDITIONAL LOGIC
C     WAS MOVED TO PLOTG2 (NOV. 1986)
C
CCCCC NUMSEQ=NUMSEQ+1
C
 1790 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRLA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWRLA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL
 9012 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NCTEXT
 9013 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCTEXT.GE.1.AND.NCTEXT.LE.1000)
     1WRITE(ICOUT,9014)(ICTEXT(I),I=1,NCTEXT)
 9014 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',80A1)
      IF(NCTEXT.GE.1.AND.NCTEXT.LE.1000)
     1CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ISEQSW,NUMSEQ
 9016 FORMAT('ISEQSW,NUMSEQ = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IREPCH
 9021 FORMAT('IREPCH = ',A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWRLE(ILEGTE,ILEGST,ILEGSP,
CCCCC AUGUST 1995.  ADD LEGEND NAME TO LIST.
     1ILEGNA,
     1PLEGXC,PLEGYC,
     1ILEGFO,ILEGCA,ILEGJU,ILEGDI,ALEGAN,ILEGFI,ILEGCO,ILEGUN,
     1PLEGHE,PLEGWI,PLEGVG,PLEGHG,PLEGTH,NUMLEG,
     1PBOXXC,PBOXYC,
     1IBOBCO,
CCCCC THE FOLLOWING LINE WAS MODIFIED AUGUST 1992
CCCCC1IBOPPA,IBOPCO,
     1IBOPPA,IBOBPA,
     1PBOPTH,PBOPGA,
     1IBOFPA,IBOFCO,
CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1992
CCCCC1PBOFTH,NUMBOX,
     1PBOFTH,PBOSHE,PBOSWI,NUMBOX,
     1PARRXC,PARRYC,
     1IARRPA,IARRCO,
     1PARRTH,
     1PARHLE,PARHWI,NUMARR,
     1PSEGXC,PSEGYC,
     1ISEGPA,ISEGCO,
     1PSEGTH,NUMSEG,
     1IMPSW2,AMPSCH,AMPSCW,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,ISYMBL,ISPAC)
C  BUG FIX: ADDED PLEGTH PARAMETER TO CALL LIST AUGUST, 1987
C           ALSO USE DPCOPA INCLUDE FILE TO DIMENSION
C           ALONG WITH "*" NOTATION
C
C
C     PURPOSE--WRITE OUT LEGENDS, AND
C              BOXES, ARROWS, AND SEGMENTS (IF CALLED FOR)
C              ON A PLOT.
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 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--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY   1989.  ADD PARAMETER TO ARGUMENT LIST (ALAN)
C     UPDATED         --JANUARY   1989.  DIMENSION STATEMENTS SHOULD REFLECT
C                                        THE USE OF PARAMETER STATEMENTS
C                                        IN THE DPCOPA.INC FILE (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C     UPDATED         --JANUARY   1989.  XX
C     UPDATED         --AUGUST    1992.  ELIMINATE BOX SOLID FILL
C     UPDATED         --AUGUST    1992.  ADD SHADOW TO BOX
C     UPDATED         --AUGUST    1992.  FIX ARROW COORDINATES (ALAN)
C     UPDATED         --AUGUST    1992.  FIX BOX FILL (ALAN)
C     UPDATED         --MARCH     1993.  DISTINGUISH BETWEEN BORDER
C                                        & FILL THICKNESS (ALAN)
C     UPDATED         --AUGUST    1995.  BUG FOR LEGENDS NOT ENTERED
C                                        IN NUMERICAL ORDER
C     UPDATED         --SEPTEMBER 1999.  ARGUMENT LIST FOR DPWRTE
C     UPDATED         --DECEMBER  1999.  ADD ILEGUN (ALLOW LEGENDS
C                                        TO BE DEFINED IN EITHER
C                                        SCREEN OR DATA UNITS)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IFLAG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ISEGPA
      CHARACTER*4 ISEGCO
C
      CHARACTER*4 IARRPA
      CHARACTER*4 IARRCO
C
      CHARACTER*4 IBOBCO
C
      CHARACTER*4 IBOPPA
CCCCC AUGUST 1992.  FOLLOWING LINE MODIFIED
CCCCC CHARACTER*4 IBOPCO
      CHARACTER*4 IBOBPA
C
      CHARACTER*4 IBOFPA
      CHARACTER*4 IBOFCO
C
      CHARACTER*4 ILEGTE
      CHARACTER*4 ILEGFO
      CHARACTER*4 ILEGCA
      CHARACTER*4 ILEGJU
      CHARACTER*4 ILEGDI
      CHARACTER*4 ILEGFI
      CHARACTER*4 ILEGCO
CCCCC AUGUST 1995.  ADD FOLLOWING LINE.
      CHARACTER*4 ILEGNA
CCCCC DECEMBER 1999.  ADD FOLLOWING LINE.
      CHARACTER*4 ILEGUN
C
      CHARACTER*4 ICTEXT
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILL
      CHARACTER*4 ICOL
      CHARACTER*4 ICOLB
      CHARACTER*4 ICOLP
      CHARACTER*4 IMPSW2
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IFUNC
C
      CHARACTER*1 IREPCH
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
      CHARACTER*4 ITRCSW
C
      INCLUDE 'DPCOPA.INC'
      DIMENSION PSEGXC(MAXSG,2)
      DIMENSION PSEGYC(MAXSG,2)
      DIMENSION ISEGPA(*)
      DIMENSION PSEGTH(*)
      DIMENSION ISEGCO(*)
C
      DIMENSION PARRXC(MAXAR,2)
      DIMENSION PARRYC(MAXAR,2)
      DIMENSION IARRPA(*)
      DIMENSION PARRTH(*)
      DIMENSION IARRCO(*)
      DIMENSION PARHLE(*)
      DIMENSION PARHWI(*)
C
      DIMENSION PBOXXC(MAXBX,2)
      DIMENSION PBOXYC(MAXBX,2)
C
      DIMENSION IBOBCO(*)
C
      DIMENSION IBOPPA(*)
      DIMENSION PBOPTH(*)
      DIMENSION PBOPGA(*)
CCCCC AUGUST 1992.  FOLLOWING LINE MODIFIED
CCCCC DIMENSION IBOPCO(*)
      DIMENSION IBOBPA(*)
C
      DIMENSION IBOFPA(*)
      DIMENSION PBOFTH(*)
      DIMENSION IBOFCO(*)
CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1992
      DIMENSION PBOSHE(*)
      DIMENSION PBOSWI(*)
C
      DIMENSION ILEGTE(*)
      DIMENSION ILEGST(*)
      DIMENSION ILEGSP(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE.
      DIMENSION ILEGNA(*)
      DIMENSION PLEGXC(*)
      DIMENSION PLEGYC(*)
      DIMENSION ILEGFO(*)
      DIMENSION ILEGCA(*)
      DIMENSION ILEGJU(*)
      DIMENSION ILEGDI(*)
      DIMENSION ALEGAN(*)
      DIMENSION ILEGFI(*)
      DIMENSION ILEGCO(*)
      DIMENSION ILEGUN(*)
      DIMENSION PLEGWI(*)
      DIMENSION PLEGHE(*)
      DIMENSION PLEGHG(*)
      DIMENSION PLEGVG(*)
      DIMENSION PLEGTH(*)
C
      DIMENSION ICTEXT(130)
C
CCCCC DIMENSION PX(100)
CCCCC DIMENSION PY(100)
CCCCC DIMENSION PX3(100)
CCCCC DIMENSION PY3(100)
C
      DIMENSION PX(MAXSG)
      DIMENSION PY(MAXSG)
CCCCC DIMENSION PX3(MAXSG)
CCCCC DIMENSION PY3(MAXSG)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IFUNC(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRLE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWRLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL
   52 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGG4,ISUBG4,IERRG4
   55 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IREPCH
   61 FORMAT('IREPCH = ',A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  DRAW OUT THE LINE SEGMENTS  **
C               **********************************
C
      IF(NUMSEG.LE.0)GOTO1190
      DO1100ISEG=1,NUMSEG
C
      PX(1)=PSEGXC(ISEG,1)
      PY(1)=PSEGYC(ISEG,1)
      PX(2)=PSEGXC(ISEG,2)
      PY(2)=PSEGYC(ISEG,2)
      NP=2
      IFIG='LINE'
      IPATT=ISEGPA(ISEG)
      ICOL=ISEGCO(ISEG)
      PTHICK=PSEGTH(ISEG)
      IF(PX(1).LT.0.0.OR.PX(1).GT.100.0)GOTO1100
      IF(PX(2).LT.0.0.OR.PX(2).GT.100.0)GOTO1100
      IF(PX(3).LT.0.0.OR.PX(3).GT.100.0)GOTO1100
      IF(PX(4).LT.0.0.OR.PX(4).GT.100.0)GOTO1100
      IF(PY(1).LT.0.0.OR.PY(1).GT.100.0)GOTO1100
      IF(PY(2).LT.0.0.OR.PY(2).GT.100.0)GOTO1100
      IF(PY(3).LT.0.0.OR.PY(3).GT.100.0)GOTO1100
      IF(PY(4).LT.0.0.OR.PY(4).GT.100.0)GOTO1100
      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)
C
 1100 CONTINUE
 1190 CONTINUE
C
C               ***************************
C               **  STEP 2--             **
C               **  DRAW OUT THE ARROWS  **
C               ***************************
C
C  AUGUST 1992.  USE DPARR2 ROUTINE TO DRAW THE ARROW (I COULD NOT
C  GET THE POSITIONING RIGHT TRYING TO DRAW IT WITH THE POLYMARKER
C  ROUTINE.
C
      IF(NUMARR.LE.0)GOTO1290
      DO1200IARR=1,NUMARR
C
      PX1=PARRXC(IARR,1)
      PY1=PARRYC(IARR,1)
      PX2=PARRXC(IARR,2)
      PY2=PARRYC(IARR,2)
      PX(1)=PX1
      PY(1)=PY1
      PX(2)=PX2
      PY(2)=PY2
      NP=2
CCCCC IFIG='LINE'
      IFIG='ARRO'
      IPATT=IARRPA(IARR)
      ICOL=IARRCO(IARR)
      PTHICK=PARRTH(IARR)
      IF(PX(1).LT.0.0.OR.PX(1).GT.100.0)GOTO1200
      IF(PX(2).LT.0.0.OR.PX(2).GT.100.0)GOTO1200
      IF(PX(3).LT.0.0.OR.PX(3).GT.100.0)GOTO1200
      IF(PX(4).LT.0.0.OR.PX(4).GT.100.0)GOTO1200
      IF(PY(1).LT.0.0.OR.PY(1).GT.100.0)GOTO1200
      IF(PY(2).LT.0.0.OR.PY(2).GT.100.0)GOTO1200
      IF(PY(3).LT.0.0.OR.PY(3).GT.100.0)GOTO1200
      IF(PY(4).LT.0.0.OR.PY(4).GT.100.0)GOTO1200
CCCCC IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
CCCCC CALL DPDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
CCCCC PLENSQ=(DELX)**2+(DELY)**2
CCCCC PLENGT=0.0
CCCCC IF(PLENSQ.GT.0.0)PLENGT=SQRT(PLENSQ)
CCCCC P=PARHLE(IARR)/PLENGT
CCCCC PX(1)=PX2-P*(PX2-PX1)
CCCCC PY(1)=PY2-P*(PY2-PY1)
CCCCC IF(ANGLE.LE.0.)ANGLE=ANGLE+360.
CCCCC ANGLE=360.0-ANGLE
CCCCC IF(PX1.EQ.PX2.AND.PY2.GE.PY1)ANGLE=90.0
CCCCC IF(PX1.EQ.PX2.AND.PY2.LE.PY1)ANGLE=270.0
CCCCC IF(PX1.NE.PX2)ANGLE=ATAN((PY2-PY1)/(PX2-PX1))
CCCCC IF(PX1.NE.PX2)ANGLE=180.0*(ANGLE/3.1415926)
CCCCC IF(ANGLE.LT.0.0)ANGLE=ANGLE+360.0
      NP=1
CCCCC IFIG='ARRO'
CCCCC IPATT='ARRH'
CCCCC IFONT='SIMP'
CCCCC ICASE='UPPE'
CCCCC IJUST='CECE'
CCCCC IDIR='GENE'
      IFILL='ON'
C  SET THICKNESS FOR ARROW HEAD TO DEFAULT
C  OTHERWISE, GET SCREWY RESULTS WHEN PLOT THE ARROW
CCCCC PTHICK=0.1
      PREPTH=0.1
      PREPSP=0.1
C  END CHANGE
CCCCC ICOL=IARRCO(IARR)
      PHEIGH=PARHWI(IARR)
      PWIDTH=PARHLE(IARR)
      PHOGAP=0.1
      PVEGAP=0.1
      ITRCSW='ON'
CCCCC CALL DPDRPM(PX,PY,NP,
CCCCC1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
CCCCC1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
CCCCC1ISYMBL,ISPAC)
      CALL DPARR3(PX1,PY1,PX2,PY2,
     1IFIG,
     1ITRCSW,
     1IPATT,ICOL,PTHICK,
     1IFILL,ICOL,
     1ICOL,PREPTH,PREPSP,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP)
C
 1200 CONTINUE
 1290 CONTINUE
C
C               *******************************
C               **  STEP 3--                 **
C               **  FILL THE BOX BACKGROUND  **
C               *******************************
C
CCCCC THE FOLLOWING SECTION WAS SKIPPED AROUND AUGUST 1992
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
CCCCC FOLLOWING CODE WAS FIXED TO WORK CORRECTLY AUGUST 1992.
CCCCC GOTO1390
C
      IF(NUMBOX.LE.0)GOTO1390
      DO1300IBOX=1,NUMBOX
C
      PX1=PBOXXC(IBOX,1)
      PY1=PBOXYC(IBOX,1)
      PX2=PBOXXC(IBOX,2)
      PY2=PBOXYC(IBOX,2)
      PX(1)=PX1
      PY(1)=PY1
      PX(2)=PX2
      PY(2)=PY1
      PX(3)=PX2
      PY(3)=PY2
      PX(4)=PX1
      PY(4)=PY2
      PX(5)=PX1
      PY(5)=PY1
      NP=5
      IFIG='BOX'
CCCCC IPATT='EMPT'
      IPATT=IBOFPA(IBOX)
      IF(IPATT.EQ.'OFF')GOTO1300
      IF(IPATT.EQ.'EMPT')GOTO1300
      IF(IPATT.EQ.'    ')GOTO1300
      IF(IPATT.EQ.'NONE')GOTO1300
      IF(IPATT.EQ.'BLAN')GOTO1300
      IF(IPATT.EQ.'ON')IPATT='SOLI'
      IPATT2=IBOPPA(IBOX)
CCCCC ICOLB=IBOBCO(IBOX)
CCCCC PTHICK=0.0
CCCCC PXGAP=0.0
CCCCC PYGAP=0.0
CCCCC ICOLP='JUNK'
      ICOLB=IBOFCO(IBOX)
CCCCC THE FOLLOWING LINE WAS FIXED     MARCH 1993
CCCCC SO AS TO DISTINGUISH BETWEEN     MARCH 1993
CCCCC BORDER AND FILL THICKNESS        MARCH 1993
CCCCC PTHICK=PBOPTH(IBOX)
      PTHICK=PBOFTH(IBOX)
      PXGAP=PBOPGA(IBOX)
      PYGAP=PBOPGA(IBOX)
      ICOLP=ICOLB
      IF(PX(1).LT.0.0.OR.PX(1).GT.100.0)GOTO1300
      IF(PX(2).LT.0.0.OR.PX(2).GT.100.0)GOTO1300
      IF(PX(3).LT.0.0.OR.PX(3).GT.100.0)GOTO1300
      IF(PX(4).LT.0.0.OR.PX(4).GT.100.0)GOTO1300
      IF(PX(5).LT.0.0.OR.PX(5).GT.100.0)GOTO1300
      IF(PY(1).LT.0.0.OR.PY(1).GT.100.0)GOTO1300
      IF(PY(2).LT.0.0.OR.PY(2).GT.100.0)GOTO1300
      IF(PY(3).LT.0.0.OR.PY(3).GT.100.0)GOTO1300
      IF(PY(4).LT.0.0.OR.PY(4).GT.100.0)GOTO1300
      IF(PY(5).LT.0.0.OR.PY(5).GT.100.0)GOTO1300
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLB,ICOLP,IPATT2)
C
 1300 CONTINUE
 1390 CONTINUE
C
C               ********************************
C               **  STEP 4--                  **
C               **  DRAW OUT THE BOX PATTERN  **
C               ********************************
C
CCCCC THE FOLLOWING SECTION WAS SKIPPED AROUND AUGUST 1992
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
      GOTO1490
C
CCCCC IF(NUMBOX.LE.0)GOTO1490
CCCCC DO1400IBOX=1,NUMBOX
C
CCCCC PX1=PBOXXC(IBOX,1)
CCCCC PY1=PBOXYC(IBOX,1)
CCCCC PX2=PBOXXC(IBOX,2)
CCCCC PY2=PBOXYC(IBOX,2)
CCCCC PX(1)=PX1
CCCCC PY(1)=PY1
CCCCC PX(2)=PX2
CCCCC PY(2)=PY1
CCCCC PX(3)=PX2
CCCCC PY(3)=PY2
CCCCC PX(4)=PX1
CCCCC PY(4)=PY2
CCCCC PX(5)=PX1
CCCCC PY(5)=PY1
CCCCC NP=5
CCCCC IFIG='BOX'
CCCCC IPATT=IBOPPA(IBOX)
CCCCC IPATT2='SOLI'
CCCCC ICOLB=IBOBCO(IBOX)
CCCCC PTHICK=PBOPTH(IBOX)
CCCCC PXSPA=PBOPGA(IBOX)
CCCCC PYSPA=PBOPGA(IBOX)
CCCCC ICOLP=IBOPCO(IBOX)
CCCCC ICOLP=ICOLB
CCCCC IF(PX(1).LT.0.0.OR.PX(1).GT.100.0)GOTO1400
CCCCC IF(PX(2).LT.0.0.OR.PX(2).GT.100.0)GOTO1400
CCCCC IF(PX(3).LT.0.0.OR.PX(3).GT.100.0)GOTO1400
CCCCC IF(PX(4).LT.0.0.OR.PX(4).GT.100.0)GOTO1400
CCCCC IF(PX(5).LT.0.0.OR.PX(5).GT.100.0)GOTO1400
CCCCC IF(PY(1).LT.0.0.OR.PY(1).GT.100.0)GOTO1400
CCCCC IF(PY(2).LT.0.0.OR.PY(2).GT.100.0)GOTO1400
CCCCC IF(PY(3).LT.0.0.OR.PY(3).GT.100.0)GOTO1400
CCCCC IF(PY(4).LT.0.0.OR.PY(4).GT.100.0)GOTO1400
CCCCC IF(PY(5).LT.0.0.OR.PY(5).GT.100.0)GOTO1400
CCCCC CALL DPFIRE(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,PXSPA,PYSPA,ICOLB,ICOLP,IPATT2)
C
C1400 CONTINUE
 1490 CONTINUE
C
C               ******************************
C               **  STEP 5--                **
C               **  DRAW OUT THE BOX FRAME  **
C               ******************************
C
CCCCC AUGUST 1992.  GET THE BORDER SETTINGS FROM DIFFERENT VARIABLES.
      IF(NUMBOX.LE.0)GOTO1590
      DO1500IBOX=1,NUMBOX
C
      PX1=PBOXXC(IBOX,1)
      PY1=PBOXYC(IBOX,1)
      PX2=PBOXXC(IBOX,2)
      PY2=PBOXYC(IBOX,2)
      PX(1)=PX1
      PY(1)=PY1
      PX(2)=PX2
      PY(2)=PY1
      PX(3)=PX2
      PY(3)=PY2
      PX(4)=PX1
      PY(4)=PY2
      PX(5)=PX1
      PY(5)=PY1
      NP=5
      IFIG='BOX'
CCCCC AUGUST 1992.
CCCCC IPATT=IBOFPA(IBOX)
CCCCC ICOL=IBOFCO(IBOX)
CCCCC PTHICK=PBOFTH(IBOX)
      IPATT=IBOBPA(IBOX)
      ICOL=IBOBCO(IBOX)
      PTHICK=PBOPTH(IBOX)
      IF(PX(1).LT.0.0.OR.PX(1).GT.100.0)GOTO1500
      IF(PX(2).LT.0.0.OR.PX(2).GT.100.0)GOTO1500
      IF(PX(3).LT.0.0.OR.PX(3).GT.100.0)GOTO1500
      IF(PX(4).LT.0.0.OR.PX(4).GT.100.0)GOTO1500
      IF(PX(5).LT.0.0.OR.PX(5).GT.100.0)GOTO1500
      IF(PY(1).LT.0.0.OR.PY(1).GT.100.0)GOTO1500
      IF(PY(2).LT.0.0.OR.PY(2).GT.100.0)GOTO1500
      IF(PY(3).LT.0.0.OR.PY(3).GT.100.0)GOTO1500
      IF(PY(4).LT.0.0.OR.PY(4).GT.100.0)GOTO1500
      IF(PY(5).LT.0.0.OR.PY(5).GT.100.0)GOTO1500
      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)
C
CCCCC THE FOLLOWING 2 SECTIONS WERE ADDED AUGUST 1992
CCCCC TO ADD A SHADOW TO THE BOX   AUGUST 1992
      PSH=PBOSHE(IBOX)
      PSW=PBOSWI(IBOX)
      EPSBS=0.000001
      IF(PSH.LT.EPSBS.AND.PSW.LT.EPSBS)GOTO1500
      PLEFT=PX1
      PRIGHT=PX2
      IF(PX2.LT.PX1)THEN
         PLEFT=PX2
         PRIGHT=PX1
      ENDIF
      PBOTTO=PY1
      PTOP=PY2
      IF(PY2.LT.PY1)THEN
         PBOTTO=PY2
         PTOP=PY1
      ENDIF
      PX(1)=PLEFT+PSW
      PY(1)=PBOTTO-PSH
      PX(2)=PRIGHT+PSW
      PY(2)=PBOTTO-PSH
      PX(3)=PRIGHT+PSW
      PY(3)=PBOTTO
      PX(4)=PLEFT+PSW
      PY(4)=PBOTTO
      PX(5)=PLEFT+PSW
      PY(5)=PBOTTO-PSH
      IPATT='SOLI'
      IPATT2='SOLI'
      ICOLB=IBOBCO(IBOX)
      ICOLP=ICOLB
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXSPA,PYSPA,ICOLB,ICOLP,IPATT2)
C
      PX(1)=PRIGHT
      PY(1)=PBOTTO-PSH
      PX(2)=PRIGHT+PSW
      PY(2)=PBOTTO-PSH
      PX(3)=PRIGHT+PSW
      PY(3)=PTOP-PSH
      PX(4)=PRIGHT
      PY(4)=PTOP-PSH
      PX(5)=PRIGHT
      PY(5)=PBOTTO-PSH
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXSPA,PYSPA,ICOLB,ICOLP,IPATT2)
C
 1500 CONTINUE
 1590 CONTINUE
C
C               *****************************
C               **  STEP 6--               **
C               **  WRITE OUT THE LEGENDS  **
C               *****************************
C
      IF(NUMLEG.LE.0)GOTO1690
      DO1600ILEG=1,NUMLEG
CCCCC AUGUST 1995.  BUG IF LEGENDS NOT ENTERED IN PROPER ORDER.
CCCCC INDEX BY VALUE IN ILEGNA.
      READ(ILEGNA(ILEG),'(I4)')INDX
      IF(INDX.LT.1.OR.INDX.GT.100)INDX=ILEG
C
CCCCC AUGUST 1995.  REPLACE ILEG WITH INDX IN FOLLOWING ARRAY INDICES.
      IFONT=ILEGFO(ILEG)
      ICASE=ILEGCA(ILEG)
      IJUST=ILEGJU(ILEG)
      IDIR=ILEGDI(ILEG)
      ANGLE=ALEGAN(ILEG)
      IFILL=ILEGFI(ILEG)
      ICOL=ILEGCO(ILEG)
      PHEIGH=PLEGHE(ILEG)
      PWIDTH=PLEGWI(ILEG)
      PHOGAP=PLEGHG(ILEG)
      PVEGAP=PLEGVG(ILEG)
      PX1=PLEGXC(ILEG)
      PY1=PLEGYC(ILEG)
      IF(ILEGUN(ILEG).EQ.'DATA')THEN
        CALL DPCODS('X',PX1,PX1,IBUGG4,ISUBG4,IERRG4)
        CALL DPCODS('Y',PY1,PY1,IBUGG4,ISUBG4,IERRG4)
      ENDIF
C  SEPTEMBER, 1987  SET LEGEND THICKNESS
CCCCC PTHICK=PLEGTH(ILEG)
      PTHICK=PLEGTH(INDX)
C  END CHANGE
C
CCCCC ISTART=ILEGST(ILEG)
CCCCC ISTOP=ILEGSP(ILEG)
      ISTART=ILEGST(INDX)
      ISTOP=ILEGSP(INDX)
C
      NCTEXT=ISTOP-ISTART+1
      IF(NCTEXT.LE.0)GOTO1600
      J=0
      DO1610I=ISTART,ISTOP
      J=J+1
      ICTEXT(J)=ILEGTE(I)
 1610 CONTINUE
      IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGG4,IERRG4)
      IF(ILEGUN(ILEG).EQ.'SCRE')THEN
        IF(PX1.LT.0.0.OR.PX1.GT.100.0)GOTO1600
        IF(PY1.LT.0.0.OR.PY1.GT.100.0)GOTO1600
      ENDIF
      CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
 1600 CONTINUE
 1690 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRLE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWRLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL
 9012 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IBUGG4,ISUBG4,IERRG4
 9015 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IREPCH
 9021 FORMAT('IREPCH = ',A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWRSG(ISUBN0,TYPE,IREPCH,IMPLSW,IFLAG,ICAPNM,ICAPBX,
     1                  ILINE)
C
C     PURPOSE--WRITE OUT THE NCOUT ELEMENTS OF THE
C              CHARACTER*240 STRING ICOUT(.:.)
C              TO A GENERAL GRAPHICS DEVICE.
C     NOTE   --THIS IS A MODIFIED VERSION OF DPWRST.  IT
C              IS USED TO PRINT THE TEXT OUTPUT ON THE GRAPHICS
C              DEVICES USING THE TEXT COMMAND (CAN"T CALL DPWRST
C              DIRECTLY SINCE THIS LEADS TO RECURSION, WHICH IS
C              NOT ALLOWED.
C
C              THE VALUE OF THE VARIABLE    NCOUT
C     ICOUT AND NCOUT RESIDE IN COMMON   /TEXTOU/
C     INPUT ARGUMENTS--ICOUT (IN COMMON)
C     ISUBN0 = 6-CHARACTER NAME OF SUBROUTINE WHICH CALLED DPWRST.
C              (AND THEREBY HAVE WALKBACK INFORMATION).
C     TYPE--4 CHARACTER DEFINITION OF TYPE OF INPUT
C              1) TEXT
C              2) BUG
C              3) ERRO
C              4) LIST
C              5) HELP
C              6) WRIT (= ALWAYS WRITE EVEN IF FEEDBACK OFF)
C              7) ...
C     OUTPUT ARGUMENTS--NCOUT (DETERMINED HEREIN)
C     NOTE--ALL DATAPLOT TEXT OUTPUT IS FUNNELED THROUGH
C           THIS ONE SUBROUTINE.
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 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--93.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1993.
C     UPDATED            --SEPTEMBER 1993. ALWAYS WRITE IF TYPE = WRIT
C     UPDATED            --SEPTEMBER 1993. OMIT IBUGG4 AS BUG SWITCH
C     UPDATED            --JUNE      2002. SUPPORT FOR A
C                                          "CAPTURE GRAPHICS" OPTION.
C                                          THIS WRITES TEXT OUTPUT
C                                          TO GRAPHICS UNIT RATHER
C                                          THAN SCREEN.  IMPLEMENT
C                                          VIA "TEXT" COMMAND.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CCCCC MUST EVENTUALLY CHANGE THE FOLLOWING LINE FORM *3 TO *?
      CHARACTER*4 ISUBN0
      CHARACTER*4 TYPE
C
      CHARACTER*4 IBRANC
C
      CHARACTER*4 IFLAG
      CHARACTER*4 ICAPNM
      CHARACTER*4 ICAPBX
      CHARACTER*4 IREPCH
      CHARACTER*4 IMPLSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 IBUGXX
C
      CHARACTER*4 UNITSW
C
      PARAMETER(MAXLEN=130)
      CHARACTER*4 IANST
      CHARACTER*4 IANLCT
      CHARACTER*4 ITXTET
      DIMENSION IANST(MAXLEN)
      DIMENSION IANLCT(MAXLEN)
      DIMENSION ITXTET(MAXLEN)
C
      CHARACTER*4 ITEXCV
      DIMENSION PRV(6)
      DIMENSION PDIARV(4)
      DIMENSION ITEXCV(10)
      DIMENSION PTEXRV(5)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOTR.INC'
CCCCC JUNE 2002.  ADD FOLLOWING LINES.
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOSU.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
      SAVE PXTEMP
      SAVE PYTEMP
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(ISUBG4.EQ.'WRSG')THEN
         WRITE(IPR,999)
  999    FORMAT(1H )
         WRITE(IPR,51)
   51    FORMAT(1H ,'***** AT THE BEGINNING OF DPWRSG--')
         WRITE(IPR,52)ISUBN0
   52    FORMAT(1H ,'THE CALLING ROUTINE (ISUBN0) WAS ',A4)
         WRITE(IPR,53)TYPE
   53    FORMAT(1H ,'TYPE = ',A4)
         WRITE(IPR,55)IFEEDB,IHOST1
   55    FORMAT(1H ,'IFEEDB,IHOST1 = ',A4,2X,A4)
         WRITE(IPR,56)NCOUT,ILOUT
   56    FORMAT(1H ,'NCOUT,ILOUT = ',2I8)
         WRITE(IPR,61)
   61    FORMAT(1H ,'          123456789.123456789.123456789.123456')
         WRITE(IPR,62)ICOUT(1:40)
   62    FORMAT(1H ,'ICOUT = ',40A1)
         WRITE(IPR,63)ICOUT
   63    FORMAT(1H ,'ICOUT = ',A230)
         WRITE(IPR,65)ICAPTY
   65    FORMAT(1H ,'ICAPTY = ',A4)
   90    CONTINUE
      ENDIF
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  DETERMINE THE LENGTH OF THE STRING          **
C               **  (BY IGNORING BLANK CHARACTERS AT THE END)   **
C               **************************************************
C
         DO1200I=1,240
            J=240-I+1
            IF(ICOUT(J:J).NE.' ')GOTO1250
 1200    CONTINUE
         NCOUT=1
         GOTO1290
 1250    CONTINUE
         NCOUT=J
 1290    CONTINUE
C
C               ******************************
C               **  STEP 15--               **
C               **  SEND TO GRAPHICS OUTPUT **
C               **  VIA TEXT COMMAND.       **
C               ******************************
C
      IF((IFLAG.EQ.'INIT'.OR.IFLAG.EQ.'NEW').AND.ICAPBX.EQ.'ON')THEN
        PXSAVE=PXEND
        PYSAVE=PYEND
C
        NUMARG=4
        ARG(1)=PBOXXC(1,1)
        ARG(2)=PBOXYC(1,1)
        ARG(3)=PBOXXC(1,2)
        ARG(4)=PBOXYC(1,2)
        IARG(1)=INT(PBOXXC(1,1))
        IARG(2)=INT(PBOXYC(1,1))
        IARG(3)=INT(PBOXXC(1,2))
        IARG(4)=INT(PBOXYC(1,2))
        IARGT(1)='NUMB'
        IARGT(2)='NUMB'
        IARGT(3)='NUMB'
        IARGT(4)='NUMB'
C 
        IBUGXX='OFF'
        UNITSW='ABSO'
        CALL DPBX(IHARG,IARGT,ARG,NUMARG,
     1            PXSTAR,PYSTAR,
     1            PXEND,PYEND,
     1            IBOBPA,IBOBCO,PBOPTH,
     1            AREGBA,
     1            IREBLI,IREBCO,PREBTH,
     1            IBOFPA,IBOFCO,
     1            IBOFPA,IBOPPA,IBOFCO,PBOFTH,PBOPGA,
     1            PBOSHE,PBOSWI,
     1            PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1            IGRASW,IDIASW,
     1            PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1            PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1            NUMDEV,
     1            IDMANU,IDMODE,IDMOD2,IDMOD3,
     1            IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1            IDNVOF,IDNHOF,
     1            IDFONT,
     1            UNITSW,
     1            IBUGXX,IFOUND,IERROR)
C
        PXEND=PXSAVE
        PYEND=PYSAVE
      ENDIF
C
      DO1510I=1,MAXLEN
        IANST(I)='    '
        IANLCT(I)='    '
        ITXTET(I)='    '
 1510 CONTINUE
C
      IANST(1)='T'
      IANST(2)='E'
      IANST(3)='X'
      IANST(4)='T'
      IANST(5)=' '
      IFACT=5
C
      IF(ICAPNM.EQ.'ON')THEN
        IF(ILINE.LE.9)THEN
          WRITE(IANST(6)(1:1),'(I1)')ILINE
          IFACT=6
        ELSEIF(ILINE.LE.99)THEN
          IJUNK=INT(ILINE/10)
          WRITE(IANST(6)(1:1),'(I1)')IJUNK
          IJUNK=MOD(ILINE,10)
          WRITE(IANST(7)(1:1),'(I1)')IJUNK
          IFACT=7
        ENDIF
      ENDIF
C
      DO1520I=1,NCOUT
        J=I+IFACT
        IANST(J)(1:1)=ICOUT(I:I)
        ITXTET(I)(1:1)=ICOUT(I:I)
 1520 CONTINUE
      IWDTHT=NCOUT+IFACT
      NCTEX=NCOUT
C
      DO1530I=1,MAXLEN
        IANLCT(I)=IANST(I)
 1530 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IFLAG.EQ.'INIT')THEN
        PXSTAR=PXEND
        PYSTAR=PYEND
        PXTEMP=PXSTAR
        PYTEMP=PYSTAR
      ELSEIF(IFLAG.EQ.'NEW')THEN
        PXSTAR=PXTEMP
        PYSTAR=PYTEMP
      ELSE
        PXSTAR=PXEND
        PYSTAR=PYEND
      ENDIF
C
      PRV(1)=PGRAXF
      PRV(2)=PGRAYF
      PRV(3)=PDIAXC
      PRV(4)=PDIAYC
      PRV(5)=PDIAX2
      PRV(6)=PDIAY2
C
      PDIARV(1)=PDIAHE
      PDIARV(2)=PDIAWI
      PDIARV(3)=PDIAVG
      PDIARV(4)=PDIAHG
C
      ITEXCV(1)=ITEXFO
      ITEXCV(2)=ITEXCA
      ITEXCV(3)=ITEXJU
      ITEXCV(4)=ITEXDI
      ITEXCV(5)=ITEXCR
      ITEXCV(6)=ITEXLF
      ITEXCV(7)=ITEXSY
      ITEXCV(8)=ITEXSP
      ITEXCV(9)=ITEXFI
      ITEXCV(10)=ITEXCO
C
      PTEXRV(1)=PTEXHE
      PTEXRV(2)=PTEXWI
      PTEXRV(3)=PTEXVG
      PTEXRV(4)=PTEXHG
      PTEXRV(5)=PTEXTH
C
      IBUGXX='OFF'
      CALL DPTEXT(IANST,IANLCT,IWDTHT,
     1ITXTET,NCTEX,
     1PXSTAR,PYSTAR,PXEND,PYEND,
     1IGRASW,IDIASW,PRV,PDIARV,
     1ILINPA,ILINCO,PLINTH,
     1ATEXBA,
     1ITEBLI,ITEBCO,PTEBTH,
     1ITEFSW,ITEFCO,
     1ITEPTY,ITEPLI,ITEPCO,PTEPTH,PTEPSP,
     1PTEXMR,ITEXCV,ATEXAN,PTEXRV,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1NUMDEV,IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1IDFONT,
     1IMPLSW,AMPSCH,AMPSCW,
     1IBUGXX,IFOUND,IERROR)
CCCCC PXEND=PTEXMR
CCCCC PYEND=PYSTAR-PTEXHE-PTEXVG
C
      IF(ISUBG4.EQ.'WRSG')THEN
        WRITE(IPR,1591)
 1591   FORMAT(1H ,'***** AFTER CALL TO DPTEXT')
        WRITE(IPR,1593)IFOUND,IERROR
 1593   FORMAT(1H ,'IFOUND,IERROR,NCOUT = ',A4,2X,A4,2X,I4)
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(ISUBG4.EQ.'WRSG')THEN
         WRITE(IPR,999)
         WRITE(IPR,9011)
 9011    FORMAT(1H ,'***** AT THE END       OF DPWRST--')
         WRITE(IPR,9012)ISUBN0
 9012    FORMAT(1H ,'THE CALLING ROUTINE (ISUBN0) WAS ',A3)
         WRITE(IPR,9013)TYPE
 9013    FORMAT(1H ,'TYPE = ',A4)
         WRITE(IPR,9015)IFEEDB,IHOST1
 9015    FORMAT(1H ,'IFEEDB,IHOST1 = ',A4,2X,A4)
         WRITE(IPR,9016)NCOUT,ILOUT
 9016    FORMAT(1H ,'NCOUT,ILOUT = ',2I8)
         WRITE(IPR,9021)
 9021    FORMAT(1H ,'          123456789.123456789.123456789.123456')
         WRITE(IPR,9022)ICOUT(1:40)
 9022    FORMAT(1H ,'ICOUT = ',40A1)
         WRITE(IPR,9023)ICOUT
 9023    FORMAT(1H ,'ICOUT = ',A230)
C
         WRITE(IPR,9032)IBRANC
 9032    FORMAT(1H ,'IBRANC = ',A4)
         WRITE(IPR,9034)NCOUT
 9034    FORMAT(1H ,'NCOUT = ',I8)
         IF(NCOUT.LE.0)GOTO9037
         IF(NCOUT.LE.0)GOTO9037
         DO9035I=1,NCOUT
CCCCC    IASCNE=ICHAR(ICOUT(I:I))
         CALL DPCOAN(ICOUT(I:I),IASCNE)
         WRITE(IPR,9036)I,ICOUT(I:I),IASCNE
 9036    FORMAT(1H ,'I,ICOUT(I:I),IASCNE = ',I8,2X,A1,I8)
 9035    CONTINUE
 9037    CONTINUE
         WRITE(IPR,9039)IBUGG4,ISUBG4,IERRG4
 9039    FORMAT(1H ,'IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
         IF(NUMTRA.LE.0)GOTO9049
 9042    CONTINUE
 9049    CONTINUE
 9090    CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
C              WRITE A GENERAL TEXT STRING
C              WITH SPECIFIED FONT, CASE, JUSTIFICATION, ,
C              DIRECTION, FILL, COLOR,
C              CHARACTER HEIGHT, WIDHT, VERTICAL GAP,
C              HORIZONTAL GAP, AND THICKNESS.
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 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--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY   1989.  CHECK FOR UPPER & LOWER CASE SHIFTS
C                                        WHEN HARDWARE CHAR USED (ALAN)
C     UPDATED  --MARCH       1993.  STRIP SP()OUT OF HARDWARE TEXT
C                                   VIA CALL TO GRSTRI.
C     UPDATED  --AUGUST      1993.  CHECK FOR CASE LOWER FOR HARDWARE
C                                   TEXT
C     UPDATED  --OCTOBER     1993.  UPPER, LOWER, ASIS CASE
C     UPDATED  --MAY         1995.  ICTEXT BEING CHANGED CAUSES PROBLEM
C                                   WITH TEXT (WHICH LOOPS THROUGH DEVICE)
C     UPDATED  --SEPTEMBER   1999.  ARGUMENT LIST TO GRWRTE
C     UPDATED  --NOVEMBER    1999.  CONVERT SP() TO HARD SPACE (BUG
C                                   FOR SIMPLEX FONT)
C     UPDATED  --NOVEMBER    1999.  SUPPORT CR() FOR MULTIPLE LINES
C                                   (I.E., LOOP THROUGH STRING IF
C                                   PRESENT)
C     UPDATED  --MARCH       2001.  WHEN CHECK FOR SP(), NEED TO
C                                   CHECK THAT IT IS NOT IN FACT
C                                   UNSP() (WHICH TERMINATES SUPER
C                                   SCRIPTING)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICTEXT
C
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILL
      CHARACTER*4 ICOL
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
      CHARACTER*4 IMPSW2
C
      CHARACTER*4 IPATT
      CHARACTER*4 ITYPE
C
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
      DIMENSION ICTEXT(*)
CCCCC MAY 1995.  ADD FOLLOWING 3 LINES
      PARAMETER (NMAX=300)
      CHARACTER*4 ICTEX2
      CHARACTER*4 ICTEX3
      DIMENSION ICTEX2(NMAX)
      DIMENSION ICTEX3(NMAX)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C  FIX: CHECK FOR UPPER AND LOWER CASE SHIFTS IN HARDWARE CHARACTERS
CCCCC CHARACTER*4 IFLAG
CCCCC CHARACTER*1 ICTEMP
C  END FIX
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWRTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PX1,PY1
   53 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)PX99,PY99
   54 FORMAT('PX99,PY99 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NCTEXT
   55 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)(ICTEXT(I),I=1,NCTEXT)
   56 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)IFONT,JFONT
   60 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICASE,JCASE
   61 FORMAT('ICASE,JCASE = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IJUST
   62 FORMAT('IJUST= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IDIR
   63 FORMAT('IDIR= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ANGLE
   64 FORMAT('ANGLE= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IFILL
   65 FORMAT('IFILL= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICOL
   66 FORMAT('ICOL= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)PHEIGH
   67 FORMAT('PHEIGH= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)PWIDTH
   68 FORMAT('PWIDTH= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PVEGAP
   69 FORMAT('PVEGAP= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PHOGAP
   70 FORMAT('PHOGAP= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)PTHICK
   71 FORMAT('PTHICK= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ISYMBL,ISPAC
   72 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
CCCCC MAY 1995.  COPY ICTEXT OVER TO ICTEX2.  USE ICTEX2 IN SUBSEQUENT
CCCCC CODE.
      DO111I=1,NMAX
        ICTEX2(I)=' '
        ICTEX3(I)=' '
  111 CONTINUE
      DO112I=1,NCTEXT
        ICTEX3(I)=ICTEXT(I)
  112 CONTINUE
CCCCC CONVERT SP() TO HARD SPACE (BUG WITH FONT).  NOVEMBER 1999.
CCCCC SP(): CONFLICT WITH UNSP().  MARCH 2001
      J=0
      ISKIP=0
      ICRFLG=0
      ISPFLG=0
      DO113I=1,NCTEXT
        IF(ISKIP.GT.0)THEN
          ISKIP=ISKIP+1
          IF(ISKIP.EQ.4)ISKIP=0
          GOTO113
        ENDIF
C
        IF(I+3.GT.NCTEXT)GOTO115
        IF(
     1     (ICTEXT(I).EQ.'C'.OR.ICTEXT(I).EQ.'c').AND.
     1     (ICTEXT(I+1).EQ.'R'.OR.ICTEXT(I+1).EQ.'r').AND.
     1     ICTEXT(I+2).EQ.'('.AND.
     1     ICTEXT(I+3).EQ.')')THEN
             ICRFLG=1
             GOTO115
        ENDIF
        IF(
     1     (ICTEXT(I).EQ.'S'.OR.ICTEXT(I).EQ.'s').AND.
     1     (ICTEXT(I+1).EQ.'P'.OR.ICTEXT(I+1).EQ.'p').AND.
     1     ICTEXT(I+2).EQ.'('.AND.
     1     ICTEXT(I+3).EQ.')')THEN
             IF(ISPFLG.EQ.1.AND.I.GE.3)THEN
               IF((ICTEXT(I-2).EQ.'U'.OR.ICTEXT(I-2).EQ.'u').AND.
     1            (ICTEXT(I-1).EQ.'N'.OR.ICTEXT(I-1).EQ.'n'))THEN
                 ISPFLG=0
                 GOTO115
               ENDIF
             ENDIF
             J=J+1
             ICTEX3(J)=' '
             ISKIP=1
             GOTO113
        ENDIF
        IF(I+4.GT.NCTEXT)GOTO115
        IF(
     1     (ICTEXT(I).EQ.'S'.OR.ICTEXT(I).EQ.'s').AND.
     1     (ICTEXT(I+1).EQ.'U'.OR.ICTEXT(I+1).EQ.'u').AND.
     1     (ICTEXT(I+2).EQ.'P'.OR.ICTEXT(I+2).EQ.'p').AND.
     1     ICTEXT(I+3).EQ.'('.AND.
     1     ICTEXT(I+4).EQ.')')THEN
             ISPFLG=1
             GOTO115
        ENDIF
  115   CONTINUE
        J=J+1
        ICTEX3(J)=ICTEXT(I)
  113 CONTINUE
C
      NCTEX3=J
      NSTART=0
      NLAST=0
      ILINE=0
      PYTEMP=PY1
C
  199 CONTINUE
      ILINE=ILINE+1
      IF(ICRFLG.EQ.0)THEN
        NCTEX2=NCTEX3
        DO201I=1,NCTEX2
          ICTEX2(I)=ICTEX3(I)
  201   CONTINUE
      ELSE
        NSTART=NLAST+1
        IF(NSTART.GT.NCTEX3)GOTO9000
        J=0
        ISKIP=0
        ICRFLG=0
        DO213I=NSTART,NCTEX3
          IF(ISKIP.GT.0)THEN
            ISKIP=ISKIP+1
            IF(ISKIP.EQ.4)ISKIP=0
            GOTO213
          ENDIF
C
          IF(I+3.GT.NCTEX3)GOTO215
          IF(
     1       (ICTEX3(I).EQ.'C'.OR.ICTEX3(I).EQ.'c').AND.
     1       (ICTEX3(I+1).EQ.'R'.OR.ICTEX3(I+1).EQ.'r').AND.
     1       ICTEX3(I+2).EQ.'('.AND.
     1       ICTEX3(I+3).EQ.')')THEN
             ICRFLG=1
             NLAST=I+3
             GOTO219
          ENDIF
  215     CONTINUE
          J=J+1
          ICTEX2(J)=ICTEX3(I)
  213   CONTINUE
  219   CONTINUE
        NCTEX2=J
      ENDIF
C
      IF(NCTEX2.LT.1)GOTO9000
      IF(ILINE.GT.1)THEN
        PYTEMP=PYTEMP-(PHEIGH+PVEGAP)
      ELSE
        PYTEMP=PY1
      ENDIF
C
      ITYPE='LINE'
C
C               **********************************************
C               **  STEP 1--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE LINE TYPE (= SOLID)              **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      IPATT='SOLI'
      CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               *******************************
C               **  STEP 2--                 **
C               **  SET THE PATTERN TYPE     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
      ITYPE='TEXT'
C
C               **********************************************
C               **  STEP 1--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE FONT TYPE                        **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRFO(ITYPE,IFONT,JFONT)
C
C               *******************************
C               **  STEP 2--                 **
C               **  SET THE FONT TYPE        **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEFO(ITYPE,IFONT,JFONT)
C
C               **********************************************
C               **  STEP 3--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE CASE TYPE (UPPER/LOWER)          **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRCA(ITYPE,ICASE,JCASE)
C
C               *******************************
C               **  STEP 4--                 **
C               **  SET THE CASE TYPE        **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSECA(ITYPE,ICASE,JCASE)
C
C               **********************************************
C               **  STEP 5--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE TEXT JUSTIFICATION               **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRJU(ITYPE,IJUST,JJUST)
C
C               **********************************
C               **  STEP 6--                    **
C               **  SET THE TEXT JUSTIFICATION  **
C               **  ON THE GRAPHICS DEVICE.     **
C               **********************************
C
      CALL GRSEJU(ITYPE,IJUST,JJUST)
C
C               **********************************************
C               **  STEP 7--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE TEXT DIRECTION                   **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
C
C               *******************************
C               **  STEP 8--                 **
C               **  SET THE TEXT DIRECTION   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
C
C               **********************************************
C               **  STEP 9--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE TEXT FILL (ON/OFF)               **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRFI(ITYPE,IFILL,JFILL)
C
C               *******************************
C               **  STEP 10--                **
C               **  SET THE TEXT FILL        **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEFI(ITYPE,IFILL,JFILL)
C
C               **********************************************
C               **  STEP 11--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE TEXT COLOR                       **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      ITYPE='TEXT'
      IF(IFONT.NE.'TEKT')ITYPE='LINE'
      IF(IDIR.NE.'HORI'.AND.IDIR.NE.'VERT')ITYPE='LINE'
C
      CALL GRTRCO(ITYPE,ICOL,JCOL)
C
C               *******************************
C               **  STEP 12--                **
C               **  SET THE TEXT COLOR       **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
      ITYPE='TEXT'
C
C               **********************************************
C               **  STEP 13--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE TEXT SIZE                        **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRSI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
C               *******************************
C               **  STEP 14--                **
C               **  SET THE TEXT SIZE        **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSESI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
C               **********************************************
C               **  STEP 15--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE TEXT THICKNESS                   **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 16--                **
C               **  SET THE TEXT THICKNESS   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
C  FIX:  CHECK FOR UPPER AND LOWER CASE SHIFTS WITH HARDWARE CHARACTERS
C  MARCH 1993.  CHECK FOR SP().  REPLACE FOLLOWING CODE WITH CALL TO
C  GRSTRI.
C  AUGUST 1993.  FOR HARDWARE CHARACTERS, CHECK FOR CASE LOWER OPTION.
C  CONVERT STRING TO LOWER CASE IF NEEDED (DO THIS BEFORE GRSTRI SO
C  ANY UC() SHIFTS WILL BE RECOGNIZED!).
C
C  OCTOBER 1993.  RECODE FOLLOWING SECTION BASED ON 
C  FONT (HARDWARE OR SOFTWARE) AND CASE (UPPER, LOWER, ASIS).
      IF(IFONT.EQ.'TEKT')THEN
        IF(ICASE.EQ.'LOWE')THEN
          DO110I=1,NCTEX2
            CALL DPCOAN(ICTEX2(I)(1:1),IVALT)
            IF(IVALT.GE.65.AND.IVALT.LE.90)IVALT=IVALT+32
            CALL DPCONA(IVALT,ICTEX2(I)(1:1))
 110      CONTINUE
          DO120I=1,4
            ISYMBL(I:I)=ICTEX2(I)(1:1)
 120      CONTINUE
        ELSE IF(ICASE.EQ.'UPPE')THEN
          DO210I=1,NCTEX2
            CALL DPCOAN(ICTEX2(I)(1:1),IVALT)
            IF(IVALT.GE.97.AND.IVALT.LE.122)IVALT=IVALT-32
            CALL DPCONA(IVALT,ICTEX2(I)(1:1))
 210      CONTINUE
          DO220I=1,4
            ISYMBL(I:I)=ICTEX2(I)(1:1)
 220      CONTINUE
        ELSE IF(ICASE.EQ.'ASIS')THEN
          CONTINUE
        ENDIF
        CALL GRSTRI(ICTEX2,NCTEX2)
      ELSE
        IF(ICASE.EQ.'LOWE')THEN
          DO310I=1,NCTEX2
            CALL DPCOAN(ICTEX2(I)(1:1),IVALT)
            IF(IVALT.GE.65.AND.IVALT.LE.90)IVALT=IVALT+32
            CALL DPCONA(IVALT,ICTEX2(I)(1:1))
 310      CONTINUE
          DO320I=1,4
            ISYMBL(I:I)=ICTEX2(I)(1:1)
 320      CONTINUE
        ELSE IF(ICASE.EQ.'UPPE')THEN
          DO410I=1,NCTEX2
            CALL DPCOAN(ICTEX2(I)(1:1),IVALT)
            IF(IVALT.GE.97.AND.IVALT.LE.122)IVALT=IVALT-32
            CALL DPCONA(IVALT,ICTEX2(I)(1:1))
 410      CONTINUE
          DO420I=1,4
            ISYMBL(I:I)=ICTEX2(I)(1:1)
 420      CONTINUE
        ELSE IF(ICASE.EQ.'ASIS')THEN
          CONTINUE
        ENDIF
      ENDIF
C  END FIX
C
C               ***********************************************
C               **  STEP 21--                                **
C               **  DETERMINE THE LENGTH OF THE TEXT STRING  **
C               ***********************************************
C
      CALL GRDETL(ICTEX2,NCTEX2,
     1IFONT,IDIR,ANGLE,
     1JFONT,JDIR,ANGLE2,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1PXLEC,PXLECG,PYLEC,PYLECG)
C
C               **************************
C               **  STEP 22--           **
C               **  WRITE OUT THE TEXT  **
C               **************************
C
CCCCC CALL GRWRTE(PX1,PY1,ICTEX2,NCTEX2,
      CALL GRWRTE(PX1,PYTEMP,ICTEX2,NCTEX2,
     1IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1JTHICK,PTHIC2,
     1PXLEC,PXLECG,PYLEC,PYLECG,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
CCCCC SUPPORT FOR CR(), CHECK FOR POSSIBLE ADDITIONAL LINES.
      IF(ICRFLG.EQ.1)GOTO199
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWRTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ITYPE
 9012 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PX1,PY1
 9013 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)PX99,PY99
 9014 FORMAT('PX99,PY99 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NCTEXT
 9015 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(ICTEXT(I),I=1,NCTEXT)
 9016 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9115)NCTEX2
 9115 FORMAT('NCTEX2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9116)(ICTEX2(I),I=1,NCTEX2)
 9116 FORMAT('(ICTEX2(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)JSIZE
 9017 FORMAT('JSIZE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFONT,JFONT
 9020 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICASE,JCASE
 9021 FORMAT('ICASE,JCASE= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IJUST,JJUST
 9022 FORMAT('IJUST,JJUST= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IDIR,JDIR
 9023 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ANGLE,ANGLE2
 9024 FORMAT('ANGLE,ANGLE2= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IFILL,JFILL
 9025 FORMAT('IFILL,JFILL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)ICOL,JCOL
 9026 FORMAT('ICOL,JCOL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)PHEIGH,JHEIG2,PHEIG2
 9027 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)PWIDTH,JWIDT2,PWIDT2
 9028 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)PVEGAP,JVEGA2,PVEGA2
 9029 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)PHOGAP,JHOGA2,PHOGA2
 9030 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)PTHICK,JTHICK,PTHIC2
 9031 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)PXLEC,PXLECG
 9033 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PYLEC,PYLECG
 9034 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)ISYMBL,ISPAC
 9035 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWRTL(ICASPL,ICAS3D)
C
C     PURPOSE--WRITE TIC LABELS ON ALL 4 FRAME LINES.
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 TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONCTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1988. ALLOW TIC LABELS WITH NO TICS
C     UPDATED         --JANUARY  1988. ALPHABETIC TIC LABELS
C     UPDATED         --JANUARY  1988. LOG SCALE EXPONENTIAL TIC LABELS
C     UPDATED         --JANUARY  1988. LOG SCALE REAL TIC LABELS
C     UPDATED         --FEBRUARY 1988. STAR PLOT
C     UPDATED         --FEBRUARY 1989. ADDED DPCOPA.INC (ALAN)
C     UPDATED         --MARCH    1993. ADD CALLS TO GRSTRI FOR
C                                      HARDWARE TEXT.
C     UPDATED         --JULY     1997. SUPPORT EXPONENTIAL SCALE FOR
C                                      LINEAR SCALE.
C     UPDATED         --SEPTEMBER1999. ARGUMENT LIST TO GRWRTE
C     UPDATED         --NOVEMBER 1999. FOR ALPHA LABELS, GO THROUGH
C                                      DPWRTE INSTEAD OF GRWRTE
C     UPDATED         --JANUARY  2004. SUPPORT FOR:
C                                      1) ROW LABELS
C                                      2) GROUP LABELS
C                                      3) NUMERIC LABELS
C     UPDATED         --JANUARY  2006. ALLOW VARIABLE, ROWLABEL AND
C                                      GROUP LABELS TO BE
C                                      INDEXED (E.G., USE WITH
C                                      SORT BY MEAN)
C
C-----NON-COMMON VARIABLES (GRAPHICS)--------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 IPATTT
      CHARACTER*4 ITYPE
C
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILLT
      CHARACTER*4 ICOL
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHIND
      CHARACTER*4 IHIND2
      CHARACTER*4 IHWUSE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICTEXT
C
      CHARACTER*130 ISTRI2
      CHARACTER*1 IC1
      CHARACTER*4 IC4
      CHARACTER*4 MESSAG
CCCCC FOLLOWING LINE   JULY 1997
      CHARACTER*10 ICTEMP
C
      DIMENSION ICTEXT(130)
C
C-----COMMON----------------------------------------------------------
C
CCCCC THE FOLLOWING LINE WAS INSERTED FEBRUARY 1989
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.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
      MESSAG='OFF'
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'WRTL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPWRTL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)PXMIN,PYMIN,PXMAX,PYMAX
   52   FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICASPL,ICAS3D
   53   FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)NX1COO,NX2COO,NY1COO,NY2COO
   54   FORMAT('NX1COO,NX2COO,NY1COO,NY2COO = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW
   55   FORMAT('IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,56)IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO
   56   FORMAT('IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,57)IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA
   57   FORMAT('IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,58)IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU
   58   FORMAT('IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,59)PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS
   59   FORMAT('PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,60)IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI
   60   FORMAT('IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,64)AX1ZAN,AX2ZAN,AY1ZAN,AY2ZAN
   64   FORMAT('AX1ZAN,AX2ZAN,AY1ZAN,AY2ZAN = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,65)IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI
   65   FORMAT('IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,66)IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO
   66   FORMAT('IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,63)IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP
   63   FORMAT('IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,73)PX1ZHE,PX2ZHE,PY1ZHE,PY2ZHE
   73   FORMAT('PX1ZHE,PX2ZHE,PY1ZHE,PY2ZHE = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,74)PX1ZWI,PX2ZWI,PY1ZWI,PY2ZWI
   74   FORMAT('PX1ZWI,PX2ZWI,PY1ZWI,PY2ZWI = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,75)PX1ZVG,PX2ZVG,PY1ZVG,PY2ZVG
   75   FORMAT('PX1ZVG,PX2ZVG,PY1ZVG,PY2ZVG = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,76)PX1ZHG,PX2ZHG,PY1ZHG,PY2ZHG
   76   FORMAT('PX1ZHG,PX2ZHG,PY1ZHG,PY2ZHG = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,77)PTIZTH
   77   FORMAT('PTIZTH = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,83)IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM
   83   FORMAT('IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,84)(IX1ZCN(I:I),I=1,100)
   84   FORMAT('(IX1ZCN(I:I) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,85)(IX2ZCN(I:I),I=1,100)
   85   FORMAT('(IX2ZCN(I:I) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,86)(IY1ZCN(I:I),I=1,100)
   86   FORMAT('(IY1ZCN(I:I) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,87)(IY2ZCN(I:I),I=1,100)
   87   FORMAT('(IY2ZCN(I:I) = ',100A1)
        CALL DPWRST('XXX','BUG ')
C
        IF(NX1COO.GT.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          DO61I=1,NX1COO
            WRITE(ICOUT,62)I,PX1COO(I),X1COOR(I)
   62       FORMAT('I,PX1COO(I),X1COOR(I) = ',I8,2E15.7)
            CALL DPWRST('XXX','BUG ')
   61     CONTINUE
        ENDIF
C
        IF(NX2COO.GT.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          DO71I=1,NX2COO
           WRITE(ICOUT,72)I,PX2COO(I),X2COOR(I)
   72      FORMAT('I,PX2COO(I),X2COOR(I) = ',I8,2E15.7)
           CALL DPWRST('XXX','BUG ')
   71    CONTINUE
        ENDIF
C
        IF(NY1COO.GT.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          DO81I=1,NY1COO
            WRITE(ICOUT,82)I,PY1COO(I),Y1COOR(I)
   82       FORMAT('I,PY1COO(I),Y1COOR(I) = ',I8,2E15.7)
            CALL DPWRST('XXX','BUG ')
   81     CONTINUE
        ENDIF
C
        IF(NY2COO.GT.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          DO91I=1,NY2COO
            WRITE(ICOUT,92)I,PY2COO(I),Y2COOR(I)
   92       FORMAT('I,PY2COO(I),Y2COOR(I) = ',I8,2E15.7)
            CALL DPWRST('XXX','BUG ')
   91     CONTINUE
        ENDIF
C
        WRITE(ICOUT,97)IBUGG4,ISUBG4,IERRG4
   97   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
C
      IF(ICASPL.EQ.'PIEC')GOTO9000
      IF(ICASPL.EQ.'STAR')GOTO9000
      IF(ICAS3D.EQ.'ON')GOTO9000
C
      ITYPE='LINE'
      ISYMBL=ITEXSY
      ISPAC=ITEXSP
C
C               **********************************************
C               **  STEP 1--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE TIC LABEL TYPE (= SOLID)         **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      IPATTT='SOLI'
      CALL GRTRPA(ICASE,IPATTT,PXSPA,PYSPA,
     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               *******************************
C               **  STEP 2--                 **
C               **  SET THE PATTERN TYPE     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEPA(ICASE,IPATTT,PXSPA,PYSPA,
     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
      ITYPE='TEXT'
C
C               **********************************************
C               **  STEP 11--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE TEXT THICKNESS                   **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      PTHICK=PTIZTH
      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 12--                **
C               **  SET THE TEXT THICKNESS   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               ****************************************************************
C               **  STEP 13--
C               **  WRITE OUT TIC LABELS ON THE 4 AXES.
C               **  THE FIRST STEP IN EACH OF THE 4 AXES IS TO
C               **  TRANSLATE THE CHARACTER REPRESENTATION
C               **  OF THE TEXT JUSTIFICATION
C               **  INTO A NUMERIC REPRESENTATION
C               **  WHICH CAN BE UNDERSTOOD BY THE
C               **  GRAPHICS DEVICE.
C               **  THE SECOND STEP IS TO ACTUALLY SET THE TEXT JUSTIFICATION.
C               **  THE THIRD STEP IN EACH OF THE 4 AXES IS TO
C               **  TRANSLATE THE CHARACTER REPRESENTATION
C               **  OF THE TEXT DIRECTION
C               **  INTO A NUMERIC REPRESENTATION
C               **  WHICH CAN BE UNDERSTOOD BY THE
C               **  GRAPHICS DEVICE.
C               **  THE FOURTH STEP IS TO ACTUALLY SET THE TEXT DIRECTION.
C               **  THE FIFTH STEP IS TO SPECIFY REFERENCE
C               **  COORDINATES FOR THE TIC LABEL.
C               **  THE SIXTH STEP IS TO WRITE OUT THE TIC LABEL.
C               ****************************************************************
C
C               ******************************************************
C               **  STEP 21.1--                                      **
C               **  WRITE TIC LABELS     ON BOTTOM HORIZONTAL AXIS  **
C               ******************************************************
C
      IF(IX1FSW.EQ.'OFF')GOTO1190
CCCCC IF(IX1TSW.EQ.'OFF')GOTO1190
      IF(IX1ZSW.EQ.'OFF')GOTO1190
      IF(NX1COO.LE.0)GOTO1190
C
      IFONT=IX1ZFO
      CALL GRTRFO(ITYPE,IFONT,JFONT)
      CALL GRSEFO(ITYPE,IFONT,JFONT)
C
      ICASE=IX1ZCA
      CALL GRTRCA(ITYPE,ICASE,JCASE)
      CALL GRSECA(ITYPE,ICASE,JCASE)
C
      IJUST=IX1ZJU
      CALL GRTRJU(ITYPE,IJUST,JJUST)
      CALL GRSEJU(ITYPE,IJUST,JJUST)
C
      IDIR=IX1ZDI
      ANGLE=AX1ZAN
      CALL GRTRDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
      CALL GRSEDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
C
      IFILLT=IX1ZFI
      CALL GRTRFI(ITYPE,IFILLT,JFILLT)
      CALL GRSEFI(ITYPE,IFILLT,JFILLT)
C
      ICOL=IX1ZCO
      CALL GRTRCO(ITYPE,ICOL,JCOL)
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
      PHEIGH=PX1ZHE
      PWIDTH=PX1ZWI
      PVEGAP=PX1ZVG
      PHOGAP=PX1ZHG
      CALL GRTRSI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
      CALL GRSESI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
      PY1=PYMIN-PX1ZDS
CCCCC PY1=PY1-PHEIG2
C
      ISTART=1
      ISTOP=130
C
CCCCC JANUARY 2004.  FOR VARIABLE OR GROUP LABEL CASE, NEED
CCCCC TO EXTRACT RELEVANT VARIABLE.
C
      IF(IX1ZFM.EQ.'VARI')THEN
C
        I=1
        CALL DPUPPE(IX1ZCN,ISTOP,IX1ZCN,IBUGG4,IERROR)
        MESSAG='OFF'
        CALL DPEXS1(IX1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11102)
11102     FORMAT('***** WARNING--FOR X1TIC MARK LABEL FORMAT ',
     1           '"VARIABLE"')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11104)
11104     FORMAT('      NO VARIABLE NAME SPECIFIED ON ',
     1           'X1TIC MARK LABEL CONTENT COMMAND.')
          CALL DPWRST('XXX','BUG ')
        ELSE
          IH='    '
          IH2='    '
          IH(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)IH2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
        ENDIF
C
        MAXCP1=MAXCOL+1
        MAXCP2=MAXCOL+2
        MAXCP3=MAXCOL+3
        MAXCP4=MAXCOL+4
        MAXCP5=MAXCOL+5
        MAXCP6=MAXCOL+6
C
        IHWUSE='V'
        MESSAG='NO'
        CALL CHECKN(IH,IH2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')THEN
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,11106)IH,IH2
11106      FORMAT('***** WARNING--UNABLE TO DETERMINE VARIABLE ',
     1            A4,A4,' FOR X1TIC MARK LABELS.')
           CALL DPWRST('XXX','BUG ')
          GOTO1190
        ENDIF
        ICOLL=IVALUE(ILOCV)
        NLEFT=IN(ILOCV)
C
C  1/2006: IF VARIABLE LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        IVLIND=0
        I=2
        MESSAG='OFF'
        CALL DPEXS1(IX1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11116)IHIND,IHIND2
11116       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1            'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11117)
11117       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(VARIABLE FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1190
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IVLIND=1
        ENDIF
      ELSEIF(IX1ZFM.EQ.'GLAB')THEN
        CALL DPUPPE(IX1ZCN,ISTOP,IX1ZCN,IBUGG4,IERROR)
        I=1
        MESSAG='OFF'
        CALL DPEXS1(IX1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11122)
11122     FORMAT('***** WARNING--FOR X1TIC MARK LABEL FORMAT ',
     1           '"GROUP LABEL"')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11124)
11124     FORMAT('      NO GROUP LABEL VARIABLE NAME SPECIFIED ON ',
     1           'X1TIC MARK LABEL CONTENT COMMAND.')
          CALL DPWRST('XXX','BUG ')
          GOTO1190
        ELSE
          IH='    '
          IH2='    '
          IH(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)IH2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
        ENDIF
C
        IGVAR=0
        DO11120I=1,MAXGRP
          IF(IH(1:4).EQ.IGRPVN(I)(1:4) .AND.
     1       IH2(1:4).EQ.IGRPVN(I)(5:8))THEN
            IGVAR=I
            GOTO11129
          ENDIF
11120   CONTINUE
11129   CONTINUE
C
C  1/2006: IF GROUP LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        IGLIND=0
        I=2
        MESSAG='OFF'
        CALL DPEXS1(IX1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11136)IHIND,IHIND2
11136       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1             'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11137)
11137       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(GROUP LABEL FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1190
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IGLIND=1
        ENDIF
C
      ELSEIF(IX1ZFM.EQ.'ROWL')THEN
C
C  1/2006: IF ROW LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        CALL DPUPPE(IX1ZCN,ISTOP,IX1ZCN,IBUGG4,IERROR)
        IRLIND=0
        I=1
        MESSAG='OFF'
        CALL DPEXS1(IX1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          IERROR='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11138)IHIND,IHIND2
11138       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1             'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11139)
11139       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(ROW LABEL FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1190
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IRLIND=1
        ENDIF
C
      ENDIF
C
      DO1100I=1,NX1COO
C
        PX1=PX1COO(I)
        IF(IX1ZFM.EQ.'VARI')THEN
          IF(IVLIND.EQ.1)THEN
            IJ=MAXN*(ICOLI-1)+I
            IF(ICOLI.LE.MAXCOL)AVALU2=V(IJ)
            IF(ICOLI.EQ.MAXCP1)AVALU2=PRED(I)
            IF(ICOLI.EQ.MAXCP2)AVALU2=RES(I)
            IF(ICOLI.EQ.MAXCP3)AVALU2=YPLOT(I)
            IF(ICOLI.EQ.MAXCP4)AVALU2=XPLOT(I)
            IF(ICOLI.EQ.MAXCP5)AVALU2=X2PLOT(I)
            IF(ICOLI.EQ.MAXCP6)AVALU2=TAGPLO(I)
            INDX=INT(AVALU2+0.5)
            IF(INDX.LT.1 .OR. INDX.GT.NX1COO)THEN
              INDX=I
            ENDIF
          ELSE
            INDX=I
          ENDIF
          IJ=MAXN*(ICOLL-1)+INDX
          IF(ICOLL.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLL.EQ.MAXCP1)AVALUE=PRED(INDX)
          IF(ICOLL.EQ.MAXCP2)AVALUE=RES(INDX)
          IF(ICOLL.EQ.MAXCP3)AVALUE=YPLOT(INDX)
          IF(ICOLL.EQ.MAXCP4)AVALUE=XPLOT(INDX)
          IF(ICOLL.EQ.MAXCP5)AVALUE=X2PLOT(INDX)
          IF(ICOLL.EQ.MAXCP6)AVALUE=TAGPLO(INDX)
          IVALU9=INT(AVALUE+0.5)
          IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        ELSEIF(IX1ZFM.EQ.'GLAB' .AND. IGLIND.EQ.1)THEN
          IJ=MAXN*(ICOLI-1)+I
          IF(ICOLI.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLI.EQ.MAXCP1)AVALUE=PRED(I)
          IF(ICOLI.EQ.MAXCP2)AVALUE=RES(I)
          IF(ICOLI.EQ.MAXCP3)AVALUE=YPLOT(I)
          IF(ICOLI.EQ.MAXCP4)AVALUE=XPLOT(I)
          IF(ICOLI.EQ.MAXCP5)AVALUE=X2PLOT(I)
          IF(ICOLI.EQ.MAXCP6)AVALUE=TAGPLO(I)
          IVALU9=INT(AVALUE+0.5)
        ELSEIF(IX1ZFM.EQ.'ROWL' .AND. IRLIND.EQ.1)THEN
          IJ=MAXN*(ICOLI-1)+I
          IF(ICOLI.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLI.EQ.MAXCP1)AVALUE=PRED(I)
          IF(ICOLI.EQ.MAXCP2)AVALUE=RES(I)
          IF(ICOLI.EQ.MAXCP3)AVALUE=YPLOT(I)
          IF(ICOLI.EQ.MAXCP4)AVALUE=XPLOT(I)
          IF(ICOLI.EQ.MAXCP5)AVALUE=X2PLOT(I)
          IF(ICOLI.EQ.MAXCP6)AVALUE=TAGPLO(I)
          IVALU9=INT(AVALUE+0.5)
        ELSE
          AVALUE=X1COOR(I)
          IVALU9=INT(AVALUE+0.5)
          IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        ENDIF
C
        IF(IX1ZFM.EQ.'ROWL')GOTO1160
        IF(IX1ZFM.EQ.'GLAB')GOTO1170
        IF(IX1ZFM.EQ.'ALPH')GOTO1150
        IF(IX1TSC.EQ.'LOG'.AND.IX1ZFM.EQ.'REAL')GOTO1120
        IF(IX1TSC.EQ.'LOG'.AND.IX1ZFM.EQ.'FIXE')GOTO1120
        IF(IX1TSC.EQ.'LOG'.AND.IX1ZFM.EQ.'DECI')GOTO1120
        IF(IX1TSC.EQ.'LOG'.AND.IX1ZFM.EQ.'INTE')GOTO1120
        IF(IX1TSC.EQ.'LOG'.AND.IX1ZFM.EQ.'EXPO')GOTO1130
        IF(IX1TSC.EQ.'LOG'.AND.IX1ZFM.EQ.'EXP')GOTO1130
CCCCC ADD FOLLOWING 2 LINES.  JULY 1997.
        IF(IX1TSC.EQ.'LINE'.AND.IX1ZFM.EQ.'EXP')GOTO1140
        IF(IX1TSC.EQ.'LINE'.AND.IX1ZFM.EQ.'EXPO')GOTO1140
        GOTO1110
C
 1110   CONTINUE
        NMDID0=IX1ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        GOTO1180
C
 1120   CONTINUE
CCCCC   AVALUE=X1COOR(I)
        AVALUE=10.0**AVALUE
        IVALU9=INT(AVALUE+0.5)
        IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        NMDID0=IX1ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        GOTO1180
C
 1130   CONTINUE
        NMDID0=IX1ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        IF(NCTEXT.LE.0)GOTO1139
        DO1131J=1,NCTEXT
          JREV=NCTEXT-J+1
          J2=JREV+7
          ICTEXT(J2)=ICTEXT(JREV)
 1131   CONTINUE
        ICTEXT(1)='1   '
        ICTEXT(2)='0   '
        ICTEXT(3)='S   '
        ICTEXT(4)='U   '
        ICTEXT(5)='P   '
        ICTEXT(6)='(   '
        ICTEXT(7)=')   '
        NCTEXT=NCTEXT+7
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='U   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='N   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='S   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='P   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='(   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)=')   '
 1139   CONTINUE
        GOTO1180
C
CCCCC ADD FOLLOWING SECTION (FOR EXPONENTIAL NUMBERS ON LINEAR
CCCCC SCALE) JULY 1997
 1140   CONTINUE
        NMDID0=IX1ZDP
        ISTRI2=' '
        ICTEMP='(E15.7 )'
        NTEMP2=7
        IF(NMDID0.GE.1)NTEMP2=NMDID0
        NTEMP1=NTEMP2+8
        IF(NTEMP2.LE.9)THEN
          WRITE(ICTEMP(6:6),'(I1)')NTEMP2
        ELSE
          WRITE(ICTEMP(6:7),'(I2)')NTEMP2
        ENDIF
        WRITE(ICTEMP(3:4),'(I2)')NTEMP1
        WRITE(ISTRI2,ICTEMP)AVALUE
        DO1142KK=1,NTEMP1
          IF(ISTRI2(KK:KK).NE.' ')THEN
             NCTEXT=KK
             ICTEXT(KK)=ISTRI2(KK:KK)
          ELSE
             ICTEXT(KK)=' '
          ENDIF
 1142   CONTINUE
C
        GOTO1180
C
 1150   CONTINUE
        MESSAG='OFF'
        CALL DPEXS1(IX1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)GOTO1159
        DO1152J=1,NCSTR2
          IC1=ISTRI2(J:J)
          IC4='    '
          IC4(1:1)=IC1
          ICTEXT(J)=IC4
 1152   CONTINUE
 1159   CONTINUE
        NCTEXT=NCSTR2
        GOTO1185
C
 1160   CONTINUE
        INDX=I
        IF(IRLIND.EQ.1)THEN
          IF(IVALU9.GE.1 .AND. IVALU9.LE.NX1COO)INDX=IVALU9
        ENDIF
C
        DO1161J=1,24
          ICTEXT(J)=IROWLB(INDX)(J:J)
 1161   CONTINUE
        NCTEXT=1
        DO1163J=24,1,-1
          IF(ICTEXT(J).NE.'    ')THEN
            NCTEXT=J
            GOTO1185
          ENDIF
 1163   CONTINUE
        GOTO1185
C
 1170   CONTINUE
        IF(IGVAR.EQ.0)THEN
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,1176)
 1176      FORMAT('***** WARNING--UNABLE TO DETERMINE GROUP LABEL ',
     1            'VARIABLE FOR X1TIC MARK LABELS.')
           CALL DPWRST('XXX','BUG ')
           GOTO1190
        ENDIF
C
C       JANUARY 2006.  DETERMINE THE INDEX IF REQUESTED.
C
        INDX=I
        IF(IGLIND.EQ.1)THEN
          IF(IVALU9.GE.1 .AND. IVALU9.LE.NX1COO)INDX=IVALU9
        ENDIF
C
        DO1171J=1,24
          ICTEXT(J)=IGRPLA(INDX,IGVAR)(J:J)
 1171   CONTINUE
        NCTEXT=1
        DO1173J=24,1,-1
          IF(ICTEXT(J).NE.'    ')THEN
            NCTEXT=J
            GOTO1185
          ENDIF
 1173   CONTINUE
        GOTO1185
C
 1180   CONTINUE
CCCCC   MARCH 1993.  STRIP OUT UC(), LC(), AND SP() FOR HARDWARE TEXT.
        IF(IFONT.EQ.'TEKT')CALL GRSTRI(ICTEXT,NCTEXT)
        IF(NCTEXT.GE.1)
     1    CALL GRDETL(ICTEXT,NCTEXT,
     1                IFONT,IDIR,ANGLE,
     1                JFONT,JDIR,ANGLE2,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1                JSIZE,
     1                JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1                PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1                PXLEC,PXLECG,PYLEC,PYLECG)
C
        IF(NCTEXT.GE.1)
     1    CALL GRWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1         IPATTT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1         JPATTT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILLT,JCOL,
     1         PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1         JSIZE,
     1         JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1         PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1         JTHICK,PTHIC2,
     1         PXLEC,PXLECG,PYLEC,PYLECG,
     1         ISYMBL,ISPAC,
     1         IMPSW2,AMPSCH,AMPSCW,
     1         PX99,PY99)
        GOTO1100
C
 1185   CONTINUE
        IF(NCTEXT.GE.1)
     1    CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1                ISYMBL,ISPAC,
     1                IMPSW2,AMPSCH,AMPSCW,
     1                PX99,PY99)
        GOTO1100
C
 1100 CONTINUE
 1190 CONTINUE
C
C               ******************************************************
C               **  STEP 21.2--                                      **
C               **  WRITE TIC LABELS     ON TOP    HORIZONTAL AXIS  **
C               ******************************************************
C
      IF(IX2FSW.EQ.'OFF')GOTO1290
CCCCC IF(IX2TSW.EQ.'OFF')GOTO1290
      IF(IX2ZSW.EQ.'OFF')GOTO1290
      IF(NX2COO.LE.0)GOTO1290
C
      IFONT=IX2ZFO
      CALL GRTRFO(ITYPE,IFONT,JFONT)
      CALL GRSEFO(ITYPE,IFONT,JFONT)
C
      ICASE=IX2ZCA
      CALL GRTRCA(ITYPE,ICASE,JCASE)
      CALL GRSECA(ITYPE,ICASE,JCASE)
C
      IJUST=IX2ZJU
      CALL GRTRJU(ITYPE,IJUST,JJUST)
      CALL GRSEJU(ITYPE,IJUST,JJUST)
C
      IDIR=IX2ZDI
      ANGLE=AX2ZAN
      CALL GRTRDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
      CALL GRSEDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
C
      IFILLT=IX2ZFI
      CALL GRTRFI(ITYPE,IFILLT,JFILLT)
      CALL GRSEFI(ITYPE,IFILLT,JFILLT)
C
      ICOL=IX2ZCO
      CALL GRTRCO(ITYPE,ICOL,JCOL)
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
      PHEIGH=PX2ZHE
      PWIDTH=PX2ZWI
      PVEGAP=PX2ZVG
      PHOGAP=PX2ZHG
      CALL GRTRSI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
      CALL GRSESI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
      PY1=PYMAX+PX2ZDS
C
      ISTART=1
      ISTOP=130
C
CCCCC JANUARY 2004.  FOR VARIABLE OR GROUP LABEL CASE, NEED
CCCCC TO EXTRACT RELEVANT VARIABLE.
C
      IF(IX2ZFM.EQ.'VARI')THEN
C
        I=1
        CALL DPUPPE(IX2ZCN,ISTOP,IX2ZCN,IBUGG4,IERROR)
        MESSAG='OFF'
        CALL DPEXS1(IX2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,12102)
12102     FORMAT('***** WARNING--FOR X2TIC MARK LABEL FORMAT ',
     1           '"VARIABLE"')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,12104)
12104     FORMAT('      NO VARIABLE NAME SPECIFIED ON ',
     1           'X1TIC MARK LABEL CONTENT COMMAND.')
          CALL DPWRST('XXX','BUG ')
        ELSE
          IH='    '
          IH2='    '
          IH(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)IH2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
        ENDIF
C
        MAXCP1=MAXCOL+1
        MAXCP2=MAXCOL+2
        MAXCP3=MAXCOL+3
        MAXCP4=MAXCOL+4
        MAXCP5=MAXCOL+5
        MAXCP6=MAXCOL+6
C
        IHWUSE='V'
        MESSAG='NO'
        CALL CHECKN(IH,IH2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,12106)IH,IH2
12106     FORMAT('***** WARNING--UNABLE TO DETERMINE VARIABLE ',
     1           A4,A4,' FOR X2TIC MARK LABELS.')
          CALL DPWRST('XXX','BUG ')
          GOTO1290
        ENDIF
        ICOLL=IVALUE(ILOCV)
        NLEFT=IN(ILOCV)
C
C  1/2006: IF VARIABLE LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        IVLIND=0
        I=2
        MESSAG='OFF'
        CALL DPEXS1(IX2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,12116)IHIND,IHIND2
12116       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1            'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,12117)
12117       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(VARIABLE FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1290
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IVLIND=1
        ENDIF
      ELSEIF(IX2ZFM.EQ.'GLAB')THEN
        CALL DPUPPE(IX2ZCN,ISTOP,IX2ZCN,IBUGG4,IERROR)
        I=1
        MESSAG='OFF'
        CALL DPEXS1(IX2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,12122)
12122     FORMAT('***** WARNING--FOR X2TIC MARK LABEL FORMAT ',
     1           '"GROUP LABEL"')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,12124)
12124     FORMAT('      NO GROUP LABEL VARIABLE NAME SPECIFIED ON ',
     1           'X2TIC MARK LABEL CONTENT COMMAND.')
          CALL DPWRST('XXX','BUG ')
          GOTO1290
        ELSE
          IH='    '
          IH2='    '
          IH(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)IH2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
        ENDIF
C
        IGVAR=0
        DO12120I=1,MAXGRP
          IF(IH(1:4).EQ.IGRPVN(I)(1:4) .AND.
     1       IH2(1:4).EQ.IGRPVN(I)(5:8))THEN
            IGVAR=I
            GOTO12129
          ENDIF
12120   CONTINUE
12129   CONTINUE
C
C  1/2006: IF GROUP LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        IGLIND=0
        I=2
        MESSAG='OFF'
        CALL DPEXS1(IX2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,12136)IHIND,IHIND2
12136       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1             'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,12137)
12137       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(GROUP LABEL FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1290
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IGLIND=1
        ENDIF
C
      ELSEIF(IX2ZFM.EQ.'ROWL')THEN
C
C  1/2006: IF ROW LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        CALL DPUPPE(IX2ZCN,ISTOP,IX2ZCN,IBUGG4,IERROR)
        IRLIND=0
        I=1
        MESSAG='OFF'
        CALL DPEXS1(IX2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,12138)IHIND,IHIND2
12138       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1             'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,12139)
12139       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(ROW LABEL FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1290
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IRLIND=1
        ENDIF
C
      ENDIF
C
      DO1200I=1,NX2COO
C
        PX1=PX2COO(I)
        IF(IX2ZFM.EQ.'VARI')THEN
          IF(IVLIND.EQ.1)THEN
            IJ=MAXN*(ICOLI-1)+I
            IF(ICOLI.LE.MAXCOL)AVALU2=V(IJ)
            IF(ICOLI.EQ.MAXCP1)AVALU2=PRED(I)
            IF(ICOLI.EQ.MAXCP2)AVALU2=RES(I)
            IF(ICOLI.EQ.MAXCP3)AVALU2=YPLOT(I)
            IF(ICOLI.EQ.MAXCP4)AVALU2=XPLOT(I)
            IF(ICOLI.EQ.MAXCP5)AVALU2=X2PLOT(I)
            IF(ICOLI.EQ.MAXCP6)AVALU2=TAGPLO(I)
            INDX=INT(AVALU2+0.5)
            IF(INDX.LT.1 .OR. INDX.GT.NX2COO)THEN
              INDX=I
            ENDIF
          ELSE
            INDX=I
          ENDIF
          IJ=MAXN*(ICOLL-1)+INDX
          IF(ICOLL.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLL.EQ.MAXCP1)AVALUE=PRED(INDX)
          IF(ICOLL.EQ.MAXCP2)AVALUE=RES(INDX)
          IF(ICOLL.EQ.MAXCP3)AVALUE=YPLOT(INDX)
          IF(ICOLL.EQ.MAXCP4)AVALUE=XPLOT(INDX)
          IF(ICOLL.EQ.MAXCP5)AVALUE=X2PLOT(INDX)
          IF(ICOLL.EQ.MAXCP6)AVALUE=TAGPLO(INDX)
          IVALU9=INT(AVALUE+0.5)
          IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        ELSEIF(IX2ZFM.EQ.'GLAB' .AND. IGLIND.EQ.1)THEN
          IJ=MAXN*(ICOLI-1)+I
          IF(ICOLI.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLI.EQ.MAXCP1)AVALUE=PRED(I)
          IF(ICOLI.EQ.MAXCP2)AVALUE=RES(I)
          IF(ICOLI.EQ.MAXCP3)AVALUE=YPLOT(I)
          IF(ICOLI.EQ.MAXCP4)AVALUE=XPLOT(I)
          IF(ICOLI.EQ.MAXCP5)AVALUE=X2PLOT(I)
          IF(ICOLI.EQ.MAXCP6)AVALUE=TAGPLO(I)
          IVALU9=INT(AVALUE+0.5)
        ELSEIF(IX2ZFM.EQ.'ROWL' .AND. IRLIND.EQ.1)THEN
          IJ=MAXN*(ICOLI-1)+I
          IF(ICOLI.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLI.EQ.MAXCP1)AVALUE=PRED(I)
          IF(ICOLI.EQ.MAXCP2)AVALUE=RES(I)
          IF(ICOLI.EQ.MAXCP3)AVALUE=YPLOT(I)
          IF(ICOLI.EQ.MAXCP4)AVALUE=XPLOT(I)
          IF(ICOLI.EQ.MAXCP5)AVALUE=X2PLOT(I)
          IF(ICOLI.EQ.MAXCP6)AVALUE=TAGPLO(I)
          IVALU9=INT(AVALUE+0.5)
        ELSE
          AVALUE=X2COOR(I)
          IVALU9=INT(AVALUE+0.5)
          IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        ENDIF
C
        IF(IX2ZFM.EQ.'ROWL')GOTO1260
        IF(IX2ZFM.EQ.'GLAB')GOTO1270
        IF(IX2ZFM.EQ.'ALPH')GOTO1250
        IF(IX2TSC.EQ.'LOG'.AND.IX2ZFM.EQ.'REAL')GOTO1220
        IF(IX2TSC.EQ.'LOG'.AND.IX2ZFM.EQ.'FIXE')GOTO1220
        IF(IX2TSC.EQ.'LOG'.AND.IX2ZFM.EQ.'DECI')GOTO1220
        IF(IX2TSC.EQ.'LOG'.AND.IX2ZFM.EQ.'INTE')GOTO1220
        IF(IX2TSC.EQ.'LOG'.AND.IX2ZFM.EQ.'EXPO')GOTO1230
        IF(IX2TSC.EQ.'LOG'.AND.IX2ZFM.EQ.'EXP')GOTO1230
CCCCC ADD FOLLOWING 2 LINES.  JULY 1997.
        IF(IX2TSC.EQ.'LINE'.AND.IX2ZFM.EQ.'EXP')GOTO1240
        IF(IX2TSC.EQ.'LINE'.AND.IX2ZFM.EQ.'EXPO')GOTO1240
        GOTO1210
C
 1210   CONTINUE
        NMDID0=IX2ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        GOTO1280
C
 1220   CONTINUE
CCCCC   AVALUE=X2COOR(I)
        AVALUE=10.0**AVALUE
        IVALU9=AVALUE+0.5
        IF(AVALUE.LT.0.0)IVALU9=AVALUE-0.5
        NMDID0=IX2ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        GOTO1280
C
 1230   CONTINUE
        NMDID0=IX2ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        IF(NCTEXT.LE.0)GOTO1239
        DO1231J=1,NCTEXT
        JREV=NCTEXT-J+1
        J2=JREV+7
        ICTEXT(J2)=ICTEXT(JREV)
 1231   CONTINUE
        ICTEXT(1)='1   '
        ICTEXT(2)='0   '
        ICTEXT(3)='S   '
        ICTEXT(4)='U   '
        ICTEXT(5)='P   '
        ICTEXT(6)='(   '
        ICTEXT(7)=')   '
        NCTEXT=NCTEXT+7
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='U   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='N   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='S   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='P   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='(   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)=')   '
 1239   CONTINUE
        GOTO1280
C
CCCCC ADD FOLLOWING SECTION (FOR EXPONENTIAL NUMBERS ON LINEAR
CCCCC SCALE) JULY 1997
 1240   CONTINUE
        NMDID0=IX2ZDP
        ISTRI2=' '
        ICTEMP='(E15.7 )'
        NTEMP2=7
        IF(NMDID0.GE.1)NTEMP2=NMDID0
        NTEMP1=NTEMP2+8
        IF(NTEMP2.LE.9)THEN
          WRITE(ICTEMP(6:6),'(I1)')NTEMP2
        ELSE
          WRITE(ICTEMP(6:7),'(I2)')NTEMP2
        ENDIF
        WRITE(ICTEMP(3:4),'(I2)')NTEMP1
        WRITE(ISTRI2,ICTEMP)AVALUE
        DO1242KK=1,NTEMP1
          IF(ISTRI2(KK:KK).NE.' ')THEN
             NCTEXT=KK
             ICTEXT(KK)=ISTRI2(KK:KK)
          ELSE
             ICTEXT(KK)=' '
          ENDIF
 1242   CONTINUE
C
        GOTO1280
C
 1250   CONTINUE
        MESSAG='OFF'
        CALL DPEXS1(IX2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)GOTO1259
        DO1252J=1,NCSTR2
          IC1=ISTRI2(J:J)
          IC4='    '
          IC4(1:1)=IC1
          ICTEXT(J)=IC4
 1252   CONTINUE
 1259   CONTINUE
        NCTEXT=NCSTR2
CCCCC   GOTO1280
        GOTO1285
C
 1260   CONTINUE
        INDX=I
        IF(IRLIND.EQ.1)THEN
          IF(IVALU9.GE.1 .AND. IVALU9.LE.NX2COO)INDX=IVALU9
        ENDIF
C
        DO1261J=1,24
          ICTEXT(J)=IROWLB(INDX)(J:J)
 1261   CONTINUE
        NCTEXT=1
        DO1263J=24,1,-1
          IF(ICTEXT(J).NE.'    ')THEN
            NCTEXT=J
            GOTO1285
          ENDIF
 1263   CONTINUE
        GOTO1285
C
 1270   CONTINUE
C
C       JANUARY 2006.  DETERMINE THE INDEX IF REQUESTED.
C
        INDX=I
        IF(IGLIND.EQ.1)THEN
          IF(IVALU9.GE.1 .AND. IVALU9.LE.NX2COO)INDX=IVALU9
        ENDIF
C
        IF(IGVAR.EQ.0)THEN
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,1276)
 1276      FORMAT('***** WARNING--UNABLE TO DETERMINE GROUP LABEL ',
     1            'VARIABLE FOR X2TIC MARK LABELS.')
           CALL DPWRST('XXX','BUG ')
           GOTO1290
        ENDIF
        DO1271J=1,24
          ICTEXT(J)=IGRPLA(INDX,IGVAR)(J:J)
 1271   CONTINUE
        NCTEXT=1
        DO1273J=24,1,-1
          IF(ICTEXT(J).NE.'    ')THEN
            NCTEXT=J
            GOTO1285
          ENDIF
 1273   CONTINUE
        GOTO1285
C
 1280   CONTINUE
CCCCC   MARCH 1993.  STRIP OUT UC(), LC(), AND SP() FOR HARDWARE TEXT.
        IF(IFONT.EQ.'TEKT')CALL GRSTRI(ICTEXT,NCTEXT)
        IF(NCTEXT.GE.1)
     1    CALL GRDETL(ICTEXT,NCTEXT,
     1                IFONT,IDIR,ANGLE,
     1                JFONT,JDIR,ANGLE2,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1                JSIZE,
     1                JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1                PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1                PXLEC,PXLECG,PYLEC,PYLECG)
C
        IF(NCTEXT.GE.1)
     1    CALL GRWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1      IPATTT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1      JPATTT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILLT,JCOL,
     1      PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1      JSIZE,
     1      JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1      PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1      JTHICK,PTHIC2,
     1      PXLEC,PXLECG,PYLEC,PYLECG,
     1      ISYMBL,ISPAC,
     1      IMPSW2,AMPSCH,AMPSCW,
     1      PX99,PY99)
        GOTO1200
C
 1285   CONTINUE
        IF(NCTEXT.GE.1)
     1    CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1                ISYMBL,ISPAC,
     1                IMPSW2,AMPSCH,AMPSCW,
     1                PX99,PY99)
        GOTO1200
C
 1200 CONTINUE
 1290 CONTINUE
C
C               ******************************************************
C               **  STEP 21.3--                                      **
C               **  WRITE TIC LABELS     ON LEFT   VERTICAL   AXIS  **
C               ******************************************************
C
      IF(IY1FSW.EQ.'OFF')GOTO1390
CCCCC IF(IY1TSW.EQ.'OFF')GOTO1390
      IF(IY1ZSW.EQ.'OFF')GOTO1390
      IF(NY1COO.LE.0)GOTO1390
C
      IFONT=IY1ZFO
      CALL GRTRFO(ITYPE,IFONT,JFONT)
      CALL GRSEFO(ITYPE,IFONT,JFONT)
C
      ICASE=IY1ZCA
      CALL GRTRCA(ITYPE,ICASE,JCASE)
      CALL GRSECA(ITYPE,ICASE,JCASE)
C
      IJUST=IY1ZJU
      CALL GRTRJU(ITYPE,IJUST,JJUST)
      CALL GRSEJU(ITYPE,IJUST,JJUST)
C
      IDIR=IY1ZDI
      ANGLE=AY1ZAN
      CALL GRTRDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
      CALL GRSEDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
C
      IFILLT=IY1ZFI
      CALL GRTRFI(ITYPE,IFILLT,JFILLT)
      CALL GRSEFI(ITYPE,IFILLT,JFILLT)
C
      ICOL=IY1ZCO
      CALL GRTRCO(ITYPE,ICOL,JCOL)
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
      PHEIGH=PY1ZHE
      PWIDTH=PY1ZWI
      PVEGAP=PY1ZVG
      PHOGAP=PY1ZHG
      CALL GRTRSI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
      CALL GRSESI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
      ISTART=1
      ISTOP=130
C
CCCCC JANUARY 2004.  FOR VARIABLE OR GROUP LABEL CASE, NEED
CCCCC TO EXTRACT RELEVANT VARIABLE.
C
      IF(IY1ZFM.EQ.'VARI')THEN
C
        I=1
        CALL DPUPPE(IY1ZCN,ISTOP,IY1ZCN,IBUGG4,IERROR)
        MESSAG='OFF'
        CALL DPEXS1(IY1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,13102)
13102     FORMAT('***** WARNING--FOR Y1TIC MARK LABEL FORMAT ',
     1           '"VARIABLE"')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,13104)
13104     FORMAT('      NO VARIABLE NAME SPECIFIED ON ',
     1           'Y1TIC MARK LABEL CONTENT COMMAND.')
          CALL DPWRST('XXX','BUG ')
        ELSE
          IH='    '
          IH2='    '
          IH(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)IH2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
        ENDIF
C
        MAXCP1=MAXCOL+1
        MAXCP2=MAXCOL+2
        MAXCP3=MAXCOL+3
        MAXCP4=MAXCOL+4
        MAXCP5=MAXCOL+5
        MAXCP6=MAXCOL+6
C
        IHWUSE='V'
        MESSAG='NO'
        CALL CHECKN(IH,IH2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')THEN
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,13106)IH,IH2
13106      FORMAT('***** WARNING--UNABLE TO DETERMINE VARIABLE ',
     1            A4,A4,' FOR Y1TIC MARK LABELS.')
           CALL DPWRST('XXX','BUG ')
          GOTO1390
        ENDIF
        ICOLL=IVALUE(ILOCV)
        NLEFT=IN(ILOCV)
C
C  1/2006: IF VARIABLE LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        IVLIND=0
        I=2
        MESSAG='OFF'
        CALL DPEXS1(IY1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,13116)IHIND,IHIND2
13116       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1            'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,13117)
13117       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(VARIABLE FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1390
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IVLIND=1
        ENDIF
      ELSEIF(IY1ZFM.EQ.'GLAB')THEN
        CALL DPUPPE(IY1ZCN,ISTOP,IY1ZCN,IBUGG4,IERROR)
        I=1
        MESSAG='OFF'
        CALL DPEXS1(IY1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,13122)
13122     FORMAT('***** WARNING--FOR Y1TIC MARK LABEL FORMAT ',
     1           '"GROUP LABEL"')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,13124)
13124     FORMAT('      NO GROUP LABEL VARIABLE NAME SPECIFIED ON ',
     1           'Y1TIC MARK LABEL CONTENT COMMAND.')
          CALL DPWRST('XXX','BUG ')
          GOTO1390
        ELSE
          IH='    '
          IH2='    '
          IH(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)IH2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
        ENDIF
C
        IGVAR=0
        DO13120I=1,MAXGRP
          IF(IH(1:4).EQ.IGRPVN(I)(1:4) .AND.
     1       IH2(1:4).EQ.IGRPVN(I)(5:8))THEN
            IGVAR=I
            GOTO13129
          ENDIF
13120   CONTINUE
13129   CONTINUE
C
C  1/2006: IF GROUP LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        IGLIND=0
        I=2
        MESSAG='OFF'
        CALL DPEXS1(IY1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,13136)IHIND,IHIND2
13136       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1             'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,13137)
13137       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(GROUP LABEL FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1390
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IGLIND=1
        ENDIF
C
      ELSEIF(IY1ZFM.EQ.'ROWL')THEN
C
C  1/2006: IF ROW LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        CALL DPUPPE(IY1ZCN,ISTOP,IY1ZCN,IBUGG4,IERROR)
        IRLIND=0
        I=1
        MESSAG='OFF'
        CALL DPEXS1(IY1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,13138)IHIND,IHIND2
13138       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1             'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,13139)
13139       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(ROW LABEL FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1390
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IRLIND=1
        ENDIF
C
      ENDIF
C
      DO1300I=1,NY1COO
C
        PX1=PXMIN-PY1ZDS
        PY1=PY1COO(I)
CCCCC   PY1=PY1-PHEIG2/2.0
        IF(IY1ZFM.EQ.'VARI')THEN
          IF(IVLIND.EQ.1)THEN
            IJ=MAXN*(ICOLI-1)+I
            IF(ICOLI.LE.MAXCOL)AVALU2=V(IJ)
            IF(ICOLI.EQ.MAXCP1)AVALU2=PRED(I)
            IF(ICOLI.EQ.MAXCP2)AVALU2=RES(I)
            IF(ICOLI.EQ.MAXCP3)AVALU2=YPLOT(I)
            IF(ICOLI.EQ.MAXCP4)AVALU2=XPLOT(I)
            IF(ICOLI.EQ.MAXCP5)AVALU2=X2PLOT(I)
            IF(ICOLI.EQ.MAXCP6)AVALU2=TAGPLO(I)
            INDX=INT(AVALU2+0.5)
            IF(INDX.LT.1 .OR. INDX.GT.NY1COO)THEN
              INDX=I
            ENDIF
          ELSE
            INDX=I
          ENDIF
          IJ=MAXN*(ICOLL-1)+INDX
          IF(ICOLL.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLL.EQ.MAXCP1)AVALUE=PRED(INDX)
          IF(ICOLL.EQ.MAXCP2)AVALUE=RES(INDX)
          IF(ICOLL.EQ.MAXCP3)AVALUE=YPLOT(INDX)
          IF(ICOLL.EQ.MAXCP4)AVALUE=XPLOT(INDX)
          IF(ICOLL.EQ.MAXCP5)AVALUE=X2PLOT(INDX)
          IF(ICOLL.EQ.MAXCP6)AVALUE=TAGPLO(INDX)
          IVALU9=INT(AVALUE+0.5)
          IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        ELSEIF(IY1ZFM.EQ.'GLAB' .AND. IGLIND.EQ.1)THEN
          IJ=MAXN*(ICOLI-1)+I
          IF(ICOLI.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLI.EQ.MAXCP1)AVALUE=PRED(I)
          IF(ICOLI.EQ.MAXCP2)AVALUE=RES(I)
          IF(ICOLI.EQ.MAXCP3)AVALUE=YPLOT(I)
          IF(ICOLI.EQ.MAXCP4)AVALUE=XPLOT(I)
          IF(ICOLI.EQ.MAXCP5)AVALUE=X2PLOT(I)
          IF(ICOLI.EQ.MAXCP6)AVALUE=TAGPLO(I)
          IVALU9=INT(AVALUE+0.5)
        ELSEIF(IY1ZFM.EQ.'ROWL' .AND. IRLIND.EQ.1)THEN
          IJ=MAXN*(ICOLI-1)+I
          IF(ICOLI.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLI.EQ.MAXCP1)AVALUE=PRED(I)
          IF(ICOLI.EQ.MAXCP2)AVALUE=RES(I)
          IF(ICOLI.EQ.MAXCP3)AVALUE=YPLOT(I)
          IF(ICOLI.EQ.MAXCP4)AVALUE=XPLOT(I)
          IF(ICOLI.EQ.MAXCP5)AVALUE=X2PLOT(I)
          IF(ICOLI.EQ.MAXCP6)AVALUE=TAGPLO(I)
          IVALU9=INT(AVALUE+0.5)
        ELSE
          AVALUE=Y1COOR(I)
          IVALU9=INT(AVALUE+0.5)
          IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        ENDIF
C
        IF(IY1ZFM.EQ.'ROWL')GOTO1360
        IF(IY1ZFM.EQ.'GLAB')GOTO1370
        IF(IY1ZFM.EQ.'ALPH')GOTO1350
        IF(IY1TSC.EQ.'LOG'.AND.IY1ZFM.EQ.'REAL')GOTO1320
        IF(IY1TSC.EQ.'LOG'.AND.IY1ZFM.EQ.'FIXE')GOTO1320
        IF(IY1TSC.EQ.'LOG'.AND.IY1ZFM.EQ.'DECI')GOTO1320
        IF(IY1TSC.EQ.'LOG'.AND.IY1ZFM.EQ.'INTE')GOTO1320
        IF(IY1TSC.EQ.'LOG'.AND.IY1ZFM.EQ.'EXPO')GOTO1330
        IF(IY1TSC.EQ.'LOG'.AND.IY1ZFM.EQ.'EXP')GOTO1330
CCCCC   ADD FOLLOWING 2 LINES.  JULY 1997.
        IF(IY1TSC.EQ.'LINE'.AND.IY1ZFM.EQ.'EXP')GOTO1340
        IF(IY1TSC.EQ.'LINE'.AND.IY1ZFM.EQ.'EXPO')GOTO1340
        GOTO1310
C
 1310   CONTINUE
        NMDID0=IY1ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        GOTO1380
C
 1320   CONTINUE
CCCCC   AVALUE=Y1COOR(I)
        AVALUE=10.0**AVALUE
        IVALU9=INT(AVALUE+0.5)
        IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        NMDID0=IX1ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        GOTO1380
C
 1330   CONTINUE
        NMDID0=IY1ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        IF(NCTEXT.LE.0)GOTO1339
        DO1331J=1,NCTEXT
          JREV=NCTEXT-J+1
          J2=JREV+7
          ICTEXT(J2)=ICTEXT(JREV)
 1331   CONTINUE
        ICTEXT(1)='1   '
        ICTEXT(2)='0   '
        ICTEXT(3)='S   '
        ICTEXT(4)='U   '
        ICTEXT(5)='P   '
        ICTEXT(6)='(   '
        ICTEXT(7)=')   '
        NCTEXT=NCTEXT+7
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='U   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='N   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='S   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='P   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='(   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)=')   '
 1339   CONTINUE
        GOTO1380
C
CCCCC   ADD FOLLOWING SECTION (FOR EXPONENTIAL NUMBERS ON LINEAR
CCCCC   SCALE) JULY 1997
 1340   CONTINUE
        NMDID0=IY1ZDP
        ISTRI2=' '
        ICTEMP='(E15.7 )'
        NTEMP2=7
        IF(NMDID0.GE.1)NTEMP2=NMDID0
        NTEMP1=NTEMP2+8
        IF(NTEMP2.LE.9)THEN
          WRITE(ICTEMP(6:6),'(I1)')NTEMP2
        ELSE
          WRITE(ICTEMP(6:7),'(I2)')NTEMP2
        ENDIF
        WRITE(ICTEMP(3:4),'(I2)')NTEMP1
        WRITE(ISTRI2,ICTEMP)AVALUE
        DO1342KK=1,NTEMP1
          IF(ISTRI2(KK:KK).NE.' ')THEN
             NCTEXT=KK
             ICTEXT(KK)=ISTRI2(KK:KK)
          ELSE
             ICTEXT(KK)=' '
          ENDIF
 1342   CONTINUE
C
        GOTO1380
C
 1350   CONTINUE
        MESSAG='OFF'
        CALL DPEXS1(IY1ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)GOTO1359
        DO1352J=1,NCSTR2
          IC1=ISTRI2(J:J)
          IC4='    '
          IC4(1:1)=IC1
          ICTEXT(J)=IC4
 1352   CONTINUE
 1359   CONTINUE
        NCTEXT=NCSTR2
CCCCC   GOTO1380
        GOTO1385
C
 1360   CONTINUE
        INDX=I
        IF(IRLIND.EQ.1)THEN
          IF(IVALU9.GE.1 .AND. IVALU9.LE.NY1COO)INDX=IVALU9
        ENDIF
C
        DO1361J=1,24
          ICTEXT(J)=IROWLB(INDX)(J:J)
 1361   CONTINUE
        NCTEXT=1
        DO1363J=24,1,-1
          IF(ICTEXT(J).NE.'    ')THEN
            NCTEXT=J
            GOTO1385
          ENDIF
 1363   CONTINUE
        GOTO1385
C
 1370   CONTINUE
C
C       JANUARY 2006.  DETERMINE THE INDEX IF REQUESTED.
C
        INDX=I
        IF(IGLIND.EQ.1)THEN
          IF(IVALU9.GE.1 .AND. IVALU9.LE.NY1COO)INDX=IVALU9
        ENDIF
C
        IF(IGVAR.EQ.0)THEN
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,1376)
 1376      FORMAT('***** WARNING--UNABLE TO DETERMINE GROUP LABEL ',
     1            'VARIABLE FOR X1TIC MARK LABELS.')
           CALL DPWRST('XXX','BUG ')
           GOTO1390
        ENDIF
        DO1371J=1,24
          ICTEXT(J)=IGRPLA(INDX,IGVAR)(J:J)
 1371   CONTINUE
        NCTEXT=1
        DO1373J=24,1,-1
          IF(ICTEXT(J).NE.'    ')THEN
            NCTEXT=J
            GOTO1385
          ENDIF
 1373   CONTINUE
        GOTO1385
C
 1380   CONTINUE
CCCCC   MARCH 1993.  STRIP OUT UC(), LC(), AND SP() FOR HARDWARE TEXT.
        IF(IFONT.EQ.'TEKT')CALL GRSTRI(ICTEXT,NCTEXT)
        IF(NCTEXT.GE.1)
     1    CALL GRDETL(ICTEXT,NCTEXT,
     1                IFONT,IDIR,ANGLE,
     1                JFONT,JDIR,ANGLE2,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1                JSIZE,
     1                JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1                PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1                PXLEC,PXLECG,PYLEC,PYLECG)
C
        IF(NCTEXT.GE.1)
     1    CALL GRWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1      IPATTT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1      JPATTT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILLT,JCOL,
     1      PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1      JSIZE,
     1      JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1      PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1      JTHICK,PTHIC2,
     1      PXLEC,PXLECG,PYLEC,PYLECG,
     1      ISYMBL,ISPAC,
     1      IMPSW2,AMPSCH,AMPSCW,
     1      PX99,PY99)
        GOTO1300
C
 1385   CONTINUE
        IF(NCTEXT.GE.1)
     1    CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1      IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1      PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1      ISYMBL,ISPAC,
     1      IMPSW2,AMPSCH,AMPSCW,
     1      PX99,PY99)
            GOTO1300
C
 1300 CONTINUE
 1390 CONTINUE
C
C               ******************************************************
C               **  STEP 21.4--                                      **
C               **  WRITE TIC LABELS     ON RIGHT  VERTICAL   AXIS  **
C               ******************************************************
C
      IF(IY2FSW.EQ.'OFF')GOTO1490
CCCCC IF(IY2TSW.EQ.'OFF')GOTO1490
      IF(IY2ZSW.EQ.'OFF')GOTO1490
      IF(NY2COO.LE.0)GOTO1490
C
      IFONT=IY2ZFO
      CALL GRTRFO(ITYPE,IFONT,JFONT)
      CALL GRSEFO(ITYPE,IFONT,JFONT)
C
      ICASE=IY2ZCA
      CALL GRTRCA(ITYPE,ICASE,JCASE)
      CALL GRSECA(ITYPE,ICASE,JCASE)
C
      IJUST=IY2ZJU
      CALL GRTRJU(ITYPE,IJUST,JJUST)
      CALL GRSEJU(ITYPE,IJUST,JJUST)
C
      IDIR=IY2ZDI
      ANGLE=AY2ZAN
      CALL GRTRDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
      CALL GRSEDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
C
      IFILLT=IY2ZFI
      CALL GRTRFI(ITYPE,IFILLT,JFILLT)
      CALL GRSEFI(ITYPE,IFILLT,JFILLT)
C
      ICOL=IY2ZCO
      CALL GRTRCO(ITYPE,ICOL,JCOL)
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
      PHEIGH=PY2ZHE
      PWIDTH=PY2ZWI
      PVEGAP=PY2ZVG
      PHOGAP=PY2ZHG
      CALL GRTRSI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
      CALL GRSESI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
      ISTART=1
      ISTOP=130
C
CCCCC JANUARY 2004.  FOR VARIABLE OR GROUP LABEL CASE, NEED
CCCCC TO EXTRACT RELEVANT VARIABLE.
C
      IF(IY2ZFM.EQ.'VARI')THEN
C
        I=1
        CALL DPUPPE(IY2ZCN,ISTOP,IY2ZCN,IBUGG4,IERROR)
        MESSAG='OFF'
        CALL DPEXS1(IY2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,14102)
14102     FORMAT('***** WARNING--FOR Y2TIC MARK LABEL FORMAT ',
     1           '"VARIABLE"')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,14104)
14104     FORMAT('      NO VARIABLE NAME SPECIFIED ON ',
     1           'Y2TIC MARK LABEL CONTENT COMMAND.')
          CALL DPWRST('XXX','BUG ')
        ELSE
          IH='    '
          IH2='    '
          IH(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)IH2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
        ENDIF
C
        MAXCP1=MAXCOL+1
        MAXCP2=MAXCOL+2
        MAXCP3=MAXCOL+3
        MAXCP4=MAXCOL+4
        MAXCP5=MAXCOL+5
        MAXCP6=MAXCOL+6
C
        IHWUSE='V'
        MESSAG='NO'
        CALL CHECKN(IH,IH2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')THEN
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,14106)IH,IH2
14106      FORMAT('***** WARNING--UNABLE TO DETERMINE VARIABLE ',
     1            A4,A4,' FOR Y2TIC MARK LABELS.')
           CALL DPWRST('XXX','BUG ')
          GOTO1190
        ENDIF
        ICOLL=IVALUE(ILOCV)
        NLEFT=IN(ILOCV)
C
C  1/2006: IF VARIABLE LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        IVLIND=0
        I=2
        MESSAG='OFF'
        CALL DPEXS1(IY2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14116)IHIND,IHIND2
14116       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1            'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14117)
14117       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(VARIABLE FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1490
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IVLIND=1
        ENDIF
      ELSEIF(IY2ZFM.EQ.'GLAB')THEN
        CALL DPUPPE(IY2ZCN,ISTOP,IY2ZCN,IBUGG4,IERROR)
        I=1
        MESSAG='OFF'
        CALL DPEXS1(IY2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,14122)
14122     FORMAT('***** WARNING--FOR Y2TIC MARK LABEL FORMAT ',
     1           '"GROUP LABEL"')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,14124)
14124     FORMAT('      NO GROUP LABEL VARIABLE NAME SPECIFIED ON ',
     1           'Y2TIC MARK LABEL CONTENT COMMAND.')
          CALL DPWRST('XXX','BUG ')
          GOTO1190
        ELSE
          IH='    '
          IH2='    '
          IH(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)IH2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
        ENDIF
C
        IGVAR=0
        DO14120I=1,MAXGRP
          IF(IH(1:4).EQ.IGRPVN(I)(1:4) .AND.
     1       IH2(1:4).EQ.IGRPVN(I)(5:8))THEN
            IGVAR=I
            GOTO14129
          ENDIF
14120   CONTINUE
14129   CONTINUE
C
C  1/2006: IF GROUP LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        IGLIND=0
        I=2
        MESSAG='OFF'
        CALL DPEXS1(IY2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14136)IHIND,IHIND2
14136       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1             'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14137)
14137       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(GROUP LABEL FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1490
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IGLIND=1
        ENDIF
C
      ELSEIF(IY2ZFM.EQ.'ROWL')THEN
C
C  1/2006: IF ROW LABEL SPECIFIED, THEN CHECK TO SEE IF
C          INDEX VARIABLE ALSO SPECIFIED.
C
        CALL DPUPPE(IY2ZCN,ISTOP,IY2ZCN,IBUGG4,IERROR)
        IRLIND=0
        I=1
        MESSAG='OFF'
        CALL DPEXS1(IY2ZCN,ISTART,ISTOP,I,MESSAG,
     1              ICOL1,ICOL2,ISTRI2,NCSTR2,
     1              IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.GT.0)THEN
          IHIND='    '
          IHIND2='    '
          IHIND(1:MIN(4,NCSTR2))=ISTRI2(1:MIN(4,NCSTR2))
          IF(NCSTR2.GE.5)
     1      IHIND2(1:MIN(8,NCSTR2)-4)=ISTRI2(5:MIN(8,NCSTR2))
          MAXCP1=MAXCOL+1
          MAXCP2=MAXCOL+2
          MAXCP3=MAXCOL+3
          MAXCP4=MAXCOL+4
          MAXCP5=MAXCOL+5
          MAXCP6=MAXCOL+6
C
          IHWUSE='V'
          MESSAG='NO'
          CALL CHECKN(IHIND,IHIND2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14138)IHIND,IHIND2
14138       FORMAT('***** WARNING--UNABLE TO DETERMINE INDEX ',
     1             'VARIABLE, ',A4,A4,',')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14139)
14139       FORMAT('      FOR TIC MARK LABEL CONTENTS ',
     1             '(ROW LABEL FORM).')
            CALL DPWRST('XXX','BUG ')
            GOTO1490
          ENDIF
          ICOLI=IVALUE(ILOCV)
          NLEFI=IN(ILOCV)
          IRLIND=1
        ENDIF
C
      ENDIF
C
        DO1400I=1,NY2COO
C
        PX1=PXMAX+PY2ZDS
        PY1=PY2COO(I)
CCCCC PY1=PY1-PHEIG2/2.0
        IF(IY2ZFM.EQ.'VARI')THEN
          IF(IVLIND.EQ.1)THEN
            IJ=MAXN*(ICOLI-1)+I
            IF(ICOLI.LE.MAXCOL)AVALU2=V(IJ)
            IF(ICOLI.EQ.MAXCP1)AVALU2=PRED(I)
            IF(ICOLI.EQ.MAXCP2)AVALU2=RES(I)
            IF(ICOLI.EQ.MAXCP3)AVALU2=YPLOT(I)
            IF(ICOLI.EQ.MAXCP4)AVALU2=XPLOT(I)
            IF(ICOLI.EQ.MAXCP5)AVALU2=X2PLOT(I)
            IF(ICOLI.EQ.MAXCP6)AVALU2=TAGPLO(I)
            INDX=INT(AVALU2+0.5)
            IF(INDX.LT.1 .OR. INDX.GT.NY2COO)THEN
              INDX=I
            ENDIF
          ELSE
            INDX=I
          ENDIF
          IJ=MAXN*(ICOLL-1)+INDX
          IF(ICOLL.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLL.EQ.MAXCP1)AVALUE=PRED(INDX)
          IF(ICOLL.EQ.MAXCP2)AVALUE=RES(INDX)
          IF(ICOLL.EQ.MAXCP3)AVALUE=YPLOT(INDX)
          IF(ICOLL.EQ.MAXCP4)AVALUE=XPLOT(INDX)
          IF(ICOLL.EQ.MAXCP5)AVALUE=X2PLOT(INDX)
          IF(ICOLL.EQ.MAXCP6)AVALUE=TAGPLO(INDX)
          IVALU9=INT(AVALUE+0.5)
          IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        ELSEIF(IY2ZFM.EQ.'GLAB' .AND. IGLIND.EQ.1)THEN
          IJ=MAXN*(ICOLI-1)+I
          IF(ICOLI.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLI.EQ.MAXCP1)AVALUE=PRED(I)
          IF(ICOLI.EQ.MAXCP2)AVALUE=RES(I)
          IF(ICOLI.EQ.MAXCP3)AVALUE=YPLOT(I)
          IF(ICOLI.EQ.MAXCP4)AVALUE=XPLOT(I)
          IF(ICOLI.EQ.MAXCP5)AVALUE=X2PLOT(I)
          IF(ICOLI.EQ.MAXCP6)AVALUE=TAGPLO(I)
          IVALU9=INT(AVALUE+0.5)
        ELSEIF(IY2ZFM.EQ.'ROWL' .AND. IRLIND.EQ.1)THEN
          IJ=MAXN*(ICOLI-1)+I
          IF(ICOLI.LE.MAXCOL)AVALUE=V(IJ)
          IF(ICOLI.EQ.MAXCP1)AVALUE=PRED(I)
          IF(ICOLI.EQ.MAXCP2)AVALUE=RES(I)
          IF(ICOLI.EQ.MAXCP3)AVALUE=YPLOT(I)
          IF(ICOLI.EQ.MAXCP4)AVALUE=XPLOT(I)
          IF(ICOLI.EQ.MAXCP5)AVALUE=X2PLOT(I)
          IF(ICOLI.EQ.MAXCP6)AVALUE=TAGPLO(I)
          IVALU9=INT(AVALUE+0.5)
        ELSE
          AVALUE=Y2COOR(I)
          IVALU9=INT(AVALUE+0.5)
          IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        ENDIF
C
        IF(IY2ZFM.EQ.'ROWL')GOTO1460
        IF(IY2ZFM.EQ.'GLAB')GOTO1470
        IF(IY2ZFM.EQ.'ALPH')GOTO1450
        IF(IY2TSC.EQ.'LOG'.AND.IY2ZFM.EQ.'REAL')GOTO1420
        IF(IY2TSC.EQ.'LOG'.AND.IY2ZFM.EQ.'FIXE')GOTO1420
        IF(IY2TSC.EQ.'LOG'.AND.IY2ZFM.EQ.'DECI')GOTO1420
        IF(IY2TSC.EQ.'LOG'.AND.IY2ZFM.EQ.'INTE')GOTO1420
        IF(IY2TSC.EQ.'LOG'.AND.IY2ZFM.EQ.'EXPO')GOTO1430
        IF(IY2TSC.EQ.'LOG'.AND.IY2ZFM.EQ.'EXP')GOTO1430
CCCCC   ADD FOLLOWING 2 LINES.  JULY 1997.
        IF(IY2TSC.EQ.'LINE'.AND.IY2ZFM.EQ.'EXP')GOTO1440
        IF(IY2TSC.EQ.'LINE'.AND.IY2ZFM.EQ.'EXPO')GOTO1440
        GOTO1410
C
 1410   CONTINUE
        NMDID0=IY2ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        GOTO1480
C
 1420   CONTINUE
CCCCC   AVALUE=Y2COOR(I)
        AVALUE=10.0**AVALUE
        IVALU9=INT(AVALUE+0.5)
        IF(AVALUE.LT.0.0)IVALU9=INT(AVALUE-0.5)
        NMDID0=IX1ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        GOTO1480
C
 1430   CONTINUE
        NMDID0=IY2ZDP
        CALL DPCON2(IVALU9,AVALUE,ICTEXT,NCTEXT,NMDID0,IBUGG4,IERRG4)
        IF(NCTEXT.LE.0)GOTO1439
        DO1431J=1,NCTEXT
          JREV=NCTEXT-J+1
          J2=JREV+7
          ICTEXT(J2)=ICTEXT(JREV)
 1431   CONTINUE
        ICTEXT(1)='1   '
        ICTEXT(2)='0   '
        ICTEXT(3)='S   '
        ICTEXT(4)='U   '
        ICTEXT(5)='P   '
        ICTEXT(6)='(   '
        ICTEXT(7)=')   '
        NCTEXT=NCTEXT+7
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='U   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='N   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='S   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='P   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)='(   '
        NCTEXT=NCTEXT+1
        ICTEXT(NCTEXT)=')   '
 1439   CONTINUE
        GOTO1480
C
CCCCC   ADD FOLLOWING SECTION (FOR EXPONENTIAL NUMBERS ON LINEAR
CCCCC   SCALE) JULY 1997
 1440   CONTINUE
        NMDID0=IY2ZDP
        ISTRI2=' '
        ICTEMP='(E15.7 )'
        NTEMP2=7
        IF(NMDID0.GE.1)NTEMP2=NMDID0
        NTEMP1=NTEMP2+8
        IF(NTEMP2.LE.9)THEN
          WRITE(ICTEMP(6:6),'(I1)')NTEMP2
        ELSE
          WRITE(ICTEMP(6:7),'(I2)')NTEMP2
        ENDIF
        WRITE(ICTEMP(3:4),'(I2)')NTEMP1
        WRITE(ISTRI2,ICTEMP)AVALUE
        DO1442KK=1,NTEMP1
          IF(ISTRI2(KK:KK).NE.' ')THEN
             NCTEXT=KK
             ICTEXT(KK)=ISTRI2(KK:KK)
          ELSE
             ICTEXT(KK)=' '
          ENDIF
 1442 CONTINUE
C
        GOTO1480
C
 1450 CONTINUE
        MESSAG='OFF'
        CALL DPEXS1(IY2ZCN,ISTART,ISTOP,I,MESSAG,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGG4,ISUBG4,IERRG4)
        IF(NCSTR2.LE.0)GOTO1459
        DO1452J=1,NCSTR2
        IC1=ISTRI2(J:J)
        IC4='    '
        IC4(1:1)=IC1
        ICTEXT(J)=IC4
 1452 CONTINUE
 1459 CONTINUE
        NCTEXT=NCSTR2
CCCCC GOTO1480
        GOTO1485
C
 1460   CONTINUE
        INDX=I
        IF(IRLIND.EQ.1)THEN
          IF(IVALU9.GE.1 .AND. IVALU9.LE.NY2COO)INDX=IVALU9
        ENDIF
C
        DO1461J=1,24
          ICTEXT(J)=IROWLB(INDX)(J:J)
 1461   CONTINUE
        NCTEXT=1
        DO1463J=24,1,-1
          IF(ICTEXT(J).NE.'    ')THEN
            NCTEXT=J
            GOTO1485
          ENDIF
 1463   CONTINUE
        GOTO1485
C
 1470   CONTINUE
C
C       JANUARY 2006.  DETERMINE THE INDEX IF REQUESTED.
C
        INDX=I
        IF(IGLIND.EQ.1)THEN
          IF(IVALU9.GE.1 .AND. IVALU9.LE.NY2COO)INDX=IVALU9
        ENDIF
C
        IF(IGVAR.EQ.0)THEN
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,1476)
 1476      FORMAT('***** WARNING--UNABLE TO DETERMINE GROUP LABEL ',
     1            'VARIABLE FOR X1TIC MARK LABELS.')
           CALL DPWRST('XXX','BUG ')
           GOTO1490
        ENDIF
        DO1471J=1,24
          ICTEXT(J)=IGRPLA(INDX,IGVAR)(J:J)
 1471   CONTINUE
        NCTEXT=1
        DO1473J=24,1,-1
          IF(ICTEXT(J).NE.'    ')THEN
            NCTEXT=J
            GOTO1485
          ENDIF
 1473   CONTINUE
        GOTO1485
C
 1480   CONTINUE
CCCCC   MARCH 1993.  STRIP OUT UC(), LC(), AND SP() FOR HARDWARE TEXT.
        IF(IFONT.EQ.'TEKT')CALL GRSTRI(ICTEXT,NCTEXT)
        IF(NCTEXT.GE.1)
     1    CALL GRDETL(ICTEXT,NCTEXT,
     1                IFONT,IDIR,ANGLE,
     1                JFONT,JDIR,ANGLE2,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1                JSIZE,
     1                JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1                PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1                PXLEC,PXLECG,PYLEC,PYLECG)
C
        IF(NCTEXT.GE.1)
     1    CALL GRWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1      IPATTT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1      JPATTT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILLT,JCOL,
     1      PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1      JSIZE,
     1      JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1      PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1      JTHICK,PTHIC2,
     1      PXLEC,PXLECG,PYLEC,PYLECG,
     1      ISYMBL,ISPAC,
     1      IMPSW2,AMPSCH,AMPSCW,
     1      PX99,PY99)
        GOTO1400
C
 1485   CONTINUE
        IF(NCTEXT.GE.1)
     1    CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1      IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1      PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1      ISYMBL,ISPAC,
     1      IMPSW2,AMPSCH,AMPSCW,
     1      PX99,PY99)
        GOTO1400
C
 1400 CONTINUE
 1490 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWRTL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)PXMIN,PYMIN,PXMAX,PYMAX
 9012 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW
 9023 FORMAT('IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NX1COO,NX2COO,NY1COO,NY2COO
 9014 FORMAT('NX1COO,NX2COO,NY1COO,NY2COO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU
 9015 FORMAT('IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI
 9016 FORMAT('IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)AX1ZAN,AX2ZAN,AY1ZAN,AY2ZAN
 9017 FORMAT('AX1ZAN,AX2ZAN,AY1ZAN,AY2ZAN = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS
 9018 FORMAT('PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP
 9019 FORMAT('IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)PX1ZHE,PX2ZHE,PY1ZHE,PY2ZHE
 9033 FORMAT('PX1ZHE,PX2ZHE,PY1ZHE,PY2ZHE = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PX1ZWI,PX2ZWI,PY1ZWI,PY2ZWI
 9034 FORMAT('PX1ZWI,PX2ZWI,PY1ZWI,PY2ZWI = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)PX1ZVG,PX2ZVG,PY1ZVG,PY2ZVG
 9035 FORMAT('PX1ZVG,PX2ZVG,PY1ZVG,PY2ZVG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)PX1ZHG,PX2ZHG,PY1ZHG,PY2ZHG
 9036 FORMAT('PX1ZHG,PX2ZHG,PY1ZHG,PY2ZHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)PTIZTH
 9037 FORMAT('PTIZTH = ',E15.7)
      CALL DPWRST('XXX','BUG ')
C
      IF(NX1COO.LE.0)GOTO9029
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9021I=1,NX1COO
      WRITE(ICOUT,9022)I,PX1COO(I),X1COOR(I)
 9022 FORMAT('I,PX1COO(I),X1COOR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9029 CONTINUE
C
      IF(NX2COO.LE.0)GOTO9039
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9031I=1,NX2COO
      WRITE(ICOUT,9032)I,PX2COO(I),X2COOR(I)
 9032 FORMAT('I,PX2COO(I),X2COOR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9031 CONTINUE
 9039 CONTINUE
C
      IF(NY1COO.LE.0)GOTO9049
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9041I=1,NY1COO
      WRITE(ICOUT,9042)I,PY1COO(I),Y1COOR(I)
 9042 FORMAT('I,PY1COO(I),Y1COOR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9041 CONTINUE
 9049 CONTINUE
C
      IF(NY2COO.LE.0)GOTO9059
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9051I=1,NY2COO
      WRITE(ICOUT,9052)I,PY2COO(I),Y2COOR(I)
 9052 FORMAT('I,PY2COO(I),Y2COOR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9051 CONTINUE
 9059 CONTINUE
C
      WRITE(ICOUT,9081)IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM
 9081 FORMAT('IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9082)(IX1ZCN(I:I),I=1,100)
 9082 FORMAT('(IX1ZCN(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9083)(IX2ZCN(I:I),I=1,100)
 9083 FORMAT('(IX2ZCN(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9084)(IY1ZCN(I:I),I=1,100)
 9084 FORMAT('(IY1ZCN(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9085)(IY2ZCN(I:I),I=1,100)
 9085 FORMAT('(IY2ZCN(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,9901)ITEXSY,ITEXSP,ISYMBL,ISPAC
 9901 FORMAT('ITEXSY,ITEXSP,ISYMBL,ISPAC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9903)IBUGG4,ISUBG4,IERRG4
 9903 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWSHA(XTEMP1,MAXNXT,ICASDI,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT WILK-SHAPIRO TEST FOR
C              NORMALITY.
C     EXAMPLE--WILKS SHAPIRO NORMAL TEST Y
C            --WILK SHAPIRO TEST Y
C     REFERENCE--??
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-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--99/3
C     ORIGINAL VERSION--MARCH     1999.
C     UPDATED         --OCTOBER   2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASDI
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 IH11
      CHARACTER*4 IH12
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.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='DPAD'
      ISUBN2='AR  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************************
C               **  TREAT THE WILKS SHAPIRO TEST CASE  **
C               ********************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'WSHA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPWSHA--')
      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 ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPWSHA--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR WILKS SHAPIRO TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      THE ARGUMENT MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPWSHA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH THE WILKS SHAPIRO TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,MIN(80,IWIDTH))
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1. **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPWSHA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH THE WILKS SHAPIRO TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,MIN(80,IWIDTH))
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************
C               **  STEP 52--                    **
C               **  DO THE WILKS SHAPIRO TEST    **
C               ***********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPWSHA, AS WE ARE ABOUT TO CALL DPWSH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPWSH2(Y,NS1,
     1XTEMP1,MAXNXT,
     1STATVA,PVAL,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPWS'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='PVAL'
      IH2='UE  '
      VALUE0=PVAL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'WSHA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWSHA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPWSH2(Y,N,
     1XTEMP,MAXNXT,
     1STATVA,PVAL,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT THE WILKS SHAPIRO TEST
C              FOR NORMALITY
C     EXAMPLE--WILKS SHAPIRO NORMALITY TEST Y
C     REFERENCE--USE ALGORITHM FROM APPLIED STATISTICS (R93, SWILK
C                ROUTINE).
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-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--99/3
C     ORIGINAL VERSION--MARCH     1999.
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*1 IBASLC
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
      CHARACTER*6 ICONC4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      LOGICAL WGTS
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPWS'
      ISUBN2='H2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'WSH2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPWSH2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.3)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR: FOR WILKS-SHAPIRPO TEST, THE SAMPLE SIZE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)
 1112 FORMAT('      MUST BE AT LEAST 3.  SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1116)N
 1116 FORMAT('      SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.LE.5000)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** WARNING: FOR WILKS-SHAPIRPO TEST, THE P-VALUE ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1122)
 1122 FORMAT('      CALCULATION MAY NOT BE ACCURATE FOR SAMPLE SIZES',
     1' GREATER THAN 5,000.')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1126)N
 1126 FORMAT('      SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM WILKS-SHAPIRO--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR WILKS SHAPIRO       **
C               **  TEST                    **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      N2=N/2
      WGTS=.FALSE.
      CALL SORT(Y,N,Y)
      STATVA=0.0
      PVAL=1.0
      CALL SWILK(WGTS,Y,N,N,N2,XTEMP,STATVA,PVAL,IFAULT)
C
      CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
      ICONC4='REJECT'
      IF(PVAL.GT.0.10)ICONC1='ACCEPT'
      IF(PVAL.GT.0.05)ICONC2='ACCEPT'
      IF(PVAL.GT.0.025)ICONC3='ACCEPT'
      IF(PVAL.GT.0.01)ICONC4='ACCEPT'
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR WILKS SHAPIRO TEST    **
C               *********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC OCTOBER 2003: ADD SUPPORT FOR HTML AND LATEX OUTPUT.  ADD
CCCCC PLACEHOLDER FOR RICH TEXT FORMAT (RTF).
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5101)
 5101   FORMAT('
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5108) 5108 FORMAT('
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5102) 5102 FORMAT('WILK-SHAPIRO TEST FOR NORMALITY') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5109) 5109 FORMAT('
') CALL DPWRST('XXX','WRIT') CCCCC WRITE(ICOUT,5104) C5104 FORMAT('

') CCCCC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5105) 5105 FORMAT('
    ') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5106) 5106 FORMAT('
  1. Statistics:') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5107) 5107 FORMAT('

    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5111) 5111 FORMAT(' ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5121) 5121 FORMAT(' ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) 5123 FORMAT(' ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) 5126 FORMAT(' ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5141) 5141 FORMAT(' Location Parameter:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5151)YMEAN 5151 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,5142) 5142 FORMAT(' Scale Parameter:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5151)YSD 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(' Wilk-Shapiro Test Statstic Value:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5154)STATVA 5154 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('
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5125) 5125 FORMAT(' Number of Observations:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) 5127 FORMAT(' ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5129)N 5129 FORMAT(' ',I8) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) 5128 FORMAT('
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5107) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5993) C WRITE(ICOUT,5166) 5166 FORMAT('

  2. Critical Values:') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5107) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5111) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5165) 5165 FORMAT(' P-Value:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5151)PVAL CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5991) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5107) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5106) 5176 FORMAT('
  3. Conclusions:') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5107) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5177)ICONC1 5177 FORMAT(' At the 90% level, we ',A6, 1 ' the normality assumption.
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5178)ICONC2 5178 FORMAT(' At the 95% level, we ',A6, 1 ' the normality assumption.
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5179)ICONC3 5179 FORMAT(' At the 99% level, we ',A6, 1 ' the normality assumption.
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5993) 5993 FORMAT('
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5995) 5995 FORMAT('
')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8001   FORMAT('{',A1,'bf WILK SHAPIRO NORMALITY TEST}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8007   FORMAT(A1,'begin{center}')
 8008   FORMAT(A1,'end{center}')
 8012   FORMAT(A1,'end{verbatim}')
 8017   FORMAT(A1,'begin{enumerate}')
 8018   FORMAT(A1,'end{enumerate}')
 8019   FORMAT(5X,'$ ',A1,1X,A1,' $ ',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,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8021   FORMAT(5X,A1,'item Statistics:')
 8022   FORMAT(5X,A1,'item Critical Values:')
 8023   FORMAT(5X,A1,'item Conclusions:')
 8030   FORMAT(11X,A1,'begin{tabular} {lr}')
 8031   FORMAT(11X,'Number of Observations: & ',I8,2X,A1,A1)
 8032   FORMAT(11X,'Location Parameter: & ',G15.7,2X,A1,A1)
 8033   FORMAT(11X,'Scale Parameter: & ',G15.7,2X,A1,A1)
 8034   FORMAT(11X,'Wilk-Shapiro Test Statistic Value: & ',
     1         G15.7,2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
C
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8051)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)YMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)YSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8022)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8041 FORMAT(11X,'P-Value: & ',G15.7,2X,A1,A1)
        WRITE(ICOUT,8051)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)PVAL,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8051   FORMAT(11X,A1,'newline')
 8052   FORMAT(11X,'At the 90',A1,'% level, we ',A6,' the normality ',
     1       'assumption.',2X,A1,A1)
 8053   FORMAT(11X,'At the 95',A1,'% level, we ',A6,' the normality ',
     1       'assumption.',2X,A1,A1)
 8054   FORMAT(11X,'At the 99',A1,'% level, we ',A6,' the normality ',
     1       'assumption.',2X,A1,A1)
 8091   FORMAT(A1,'end{enumerate}')
 8092   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8051)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8052)IBASLC,ICONC1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8053)IBASLC,ICONC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8054)IBASLC,ICONC3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8008)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8092)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT( '              WILKS SHAPIRO TEST FOR NORMALITY')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4241)
 4241   FORMAT('1. STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)N
 4242   FORMAT(6X,'NUMBER OF OBSERVATIONS                = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)YMEAN
 4243   FORMAT(6X,'LOCATION PARAMETER                    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4244)YSD
 4244   FORMAT(6X,'SCALE PARAMETER                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4344)STATVA
 4344   FORMAT(6X,'WILKS SHAPIRO TEST STATISTIC VALUE = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4341)
 4341   FORMAT('2. CRITICAL VALUES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)PVAL
 4245   FORMAT(6X,'P-VALUE      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4261)
 4261   FORMAT('3. CONCLUSIONS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4263)ICONC1
 4263   FORMAT(6X,
     1        'AT THE 90% LEVEL, WE ',A6,' THE NORMALITY ASSUMPTION.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4265)ICONC2
 4265   FORMAT(6X,
     1         'AT THE 95% LEVEL, WE ',A6,' THE NORMALITY ASSUMPTION.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4267)ICONC3
 4267   FORMAT(6X,
     1     'AT THE 97.5% LEVEL, WE ',A6,' THE NORMALITY ASSUMPTION.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4269)ICONC4
 4269   FORMAT(6X,
     1  'AT THE 99% LEVEL, WE ',A6,' THE NORMALITY ASSUMPTION.')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'WSH2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPWSH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I)
 9017 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPW280(ISTRIN,ISTART,ISTOP,ICOL2,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--DETERMINE THE COLUMN NUMBER
C              AT THE BEGINNING OF THE SECOND WORD
C              IN THE COLUMN INTERVAL ISTART TO ISTOP
C              IN THE CHARACTER*80 VARIABLE    ISTRIN   .
C              (THIS IS USEFUL FOR EXTRACTING THE FULL SECOND WORD.)
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 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--DECEMBER  1985.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*80 ISTRIN
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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='DPW2'
      ISUBN2='80  '
C
      IERROR='NO'
      ICOL2=(-999)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'W280')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPW280--')
      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)(ISTRIN(J:J),J=1,80)
   54 FORMAT('(ISTRIN(J:J),J=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ISTART,ISTOP
   55 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICOL2
   56 FORMAT('ICOL2 = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************
C               **  STEP 1--                             **
C               **  DETERMINE THE COLUMN NUMBER          **
C               **  AT THE BEGINNING OF THE SECOND WORD  **
C               *******************************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'W280')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTART.GE.1.AND.ISTOP.GE.1.AND.
     1   ISTART.LE.80.AND.ISTOP.LE.80)GOTO1119
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPW280--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      ISTART OR ISTOP IS < 1 OR > 80. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)ISTART
 1113 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)ISTOP
 1114 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)(ISTRIN(I:I),I=1,80)
 1116 FORMAT('      (ISTRIN(I:I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1119 CONTINUE
C
      IF(ISTART.LE.ISTOP)GOTO1129
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPW280--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ISTART EXCEEDS ISTOP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)ISTART
 1123 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)ISTOP
 1124 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)(ISTRIN(I:I),I=1,80)
 1126 FORMAT('      (ISTRIN(I:I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1129 CONTINUE
C
      ICOL1=ISTOP+1
      DO1210I=ISTART,ISTOP
      I2=I
      IF(ISTRIN(I:I).EQ.' ')GOTO1215
 1210 CONTINUE
      ICOL1=ISTOP+1
      GOTO1219
 1215 CONTINUE
      ICOL1=I2
      GOTO1219
 1219 CONTINUE
C
      ICOL2=ISTOP+1
      IF(ICOL1.GT.ISTOP)GOTO1229
      DO1220I=ICOL1,ISTOP
      I2=I
      IF(ISTRIN(I:I).NE.' ')GOTO1225
 1220 CONTINUE
      ICOL2=ISTOP+1
      GOTO1229
 1225 CONTINUE
      ICOL2=I2
      GOTO1229
 1229 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'W280')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPW280--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,ISUBRO,IERROR
 9013 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(ISTRIN(J:J),J=1,80)
 9014 FORMAT('(ISTRIN(J:J),J=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ISTART,ISTOP
 9015 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ICOL1
 9016 FORMAT('ICOL1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)ICOL2
 9017 FORMAT('ICOL2 = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPW380(ISTRIN,ISTART,ISTOP,ICOL3,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--DETERMINE THE COLUMN NUMBER
C              AT THE BEGINNING OF THE THIRD WORD
C              IN THE COLUMN INTERVAL ISTART TO ISTOP
C              IN THE CHARACTER*80 VARIABLE    ISTRIN   .
C              (THIS IS USEFUL FOR EXTRACTING THE FULL THIRD WORD.)
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 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/7
C     ORIGINAL VERSION--JUNE      1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*80 ISTRIN
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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='DPW3'
      ISUBN2='80  '
C
      IERROR='NO'
      ICOL2=(-999)
      ICOL2B=(-999)
      ICOL3=(-999)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'W380')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPW380--')
      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)(ISTRIN(J:J),J=1,80)
   54 FORMAT('(ISTRIN(J:J),J=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ISTART,ISTOP
   55 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICOL2,ICOL2B
   56 FORMAT('ICOL2,COL2B = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)ICOL3
   57 FORMAT('ICOL3 = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************
C               **  STEP 1--                             **
C               **  DETERMINE THE COLUMN NUMBER          **
C               **  AT THE BEGINNING OF THE THIRD  WORD  **
C               *******************************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'W380')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTART.GE.1.AND.ISTOP.GE.1.AND.
     1   ISTART.LE.80.AND.ISTOP.LE.80)GOTO1119
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPW380--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      ISTART OR ISTOP IS < 1 OR > 80. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)ISTART
 1113 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)ISTOP
 1114 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)(ISTRIN(I:I),I=1,80)
 1116 FORMAT('      (ISTRIN(I:I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1119 CONTINUE
C
      IF(ISTART.LE.ISTOP)GOTO1129
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPW380--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ISTART EXCEEDS ISTOP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)ISTART
 1123 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)ISTOP
 1124 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)(ISTRIN(I:I),I=1,80)
 1126 FORMAT('      (ISTRIN(I:I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1129 CONTINUE
C
C     FIND THE FIRST BLANK AT THE END OF WORD 1
C
      ICOL1=ISTOP+1
      DO1210I=ISTART,ISTOP
      I2=I
      IF(ISTRIN(I:I).EQ.' ')GOTO1215
 1210 CONTINUE
      ICOL1=ISTOP+1
      GOTO1219
 1215 CONTINUE
      ICOL1=I2
      GOTO1219
 1219 CONTINUE
C
C     FIND THE BEGINNING OF WORD 2
C
      ICOL2=ISTOP+1
      IF(ICOL1.GT.ISTOP)GOTO1229
      DO1220I=ICOL1,ISTOP
      I2=I
      IF(ISTRIN(I:I).NE.' ')GOTO1225
 1220 CONTINUE
      ICOL2=ISTOP+1
      GOTO1229
 1225 CONTINUE
      ICOL2=I2
      GOTO1229
 1229 CONTINUE
C
C     FIND THE FIRST BLANK AT THE END OF WORD 2
C
      ICOL2B=ISTOP+1
      IF(ICOL2.GT.ISTOP)GOTO1239
      DO1230I=ICOL2,ISTOP
      I2=I
      IF(ISTRIN(I:I).EQ.' ')GOTO1235
 1230 CONTINUE
      ICOL2B=ISTOP+1
      GOTO1239
 1235 CONTINUE
      ICOL2B=I2
      GOTO1239
 1239 CONTINUE
C
C     FIND THE BEGINNING OF WORD 3
C
      ICOL3=ISTOP+1
      IF(ICOL2B.GT.ISTOP)GOTO1249
      DO1240I=ICOL2B,ISTOP
      I2=I
      IF(ISTRIN(I:I).NE.' ')GOTO1245
 1240 CONTINUE
      ICOL3=ISTOP+1
      GOTO1249
 1245 CONTINUE
      ICOL3=I2
      GOTO1249
 1249 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'W380')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPW380--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,ISUBRO,IERROR
 9013 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(ISTRIN(J:J),J=1,80)
 9014 FORMAT('(ISTRIN(J:J),J=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ISTART,ISTOP
 9015 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ICOL1
 9016 FORMAT('ICOL1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)ICOL2,ICOL2B
 9017 FORMAT('ICOL2,ICOL2B = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)ICOL3
 9018 FORMAT('ICOL3 = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPXH1H(IWD,ICH,NUMCH,IBUGA3)
C
C     PURPOSE--DECOMPOSE A WORD (TYPICALLY 4 CHARACTERS
C              BUT MORE GENERALLY NUMCPW CHARACTERS PER WORD)
C              INTO INDIVIDUAL CHARACTERS--1 CHARACTER PER WORD.
C
C     NOTE ALSO THE POSSIBLE EXISTENCE OF A6 FORMATS
C     RATHER THAN A4 FORMATS FOR THE PRINTING OF
C     CERTAIN HOLLERITH (= CHARACTER) VARIABLES.
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 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   1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IWD
      CHARACTER*4 ICH
      CHARACTER*4 IBUGA3
C
      CHARACTER*4 IX1
      CHARACTER*4 IX2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION ICH(*)
C
C     NUMBPC = NUMBER OF BITS PER CHARACTER.
C     NUMCPW = NUMBER OF CHARACTERS PER WORD.
C     THESE VALUES WILL CHANGE DEPENDING
C     ON THE COMPUTER AND ARE DEFINED IN THE SUBROUTINE INITMC.
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='DPXH'
      ISUBN2='1H  '
C
C               ****************************************
C               **  DECOMPOSE A WORD INTO CHARACTERS  **
C               ****************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,91)
   91 FORMAT('***** AT THE BEGINNING OF DPXH1H--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,92)IWD
   92 FORMAT('IWD (IN A4 FORMAT)  = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,93)IWD
   93 FORMAT('IWD (IN A6 FORMAT)  = ',A6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,94)IWD
   94 FORMAT('IWD (IN A10 FORMAT) = ',A10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,95)IBUGA3
   95 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMCH=0
      DO100I=1,NUMCPW
      ICH(I)=' '
  100 CONTINUE
C
C               **************************************************************
C               **  STEP 2--                                                **
C               **  DECOMPOSE THE   TARGET WORDS INTO INDIVIDUAL CHARACTERS.**
C               **************************************************************
C
      IF(IWD.EQ.' ')GOTO390
      IX1=IWD
      ISTAR2=0
      ILEN1=NUMBPC
      ILEN2=ILEN1
C
      DO200I=1,NUMCPW
      IX2=' '
      ISTAR1=(I-1)*NUMBPC
      CALL DPCHEX(ISTAR1,ILEN1,IX1,ISTAR2,ILEN2,IX2)
      ICH(I)=IX2
  200 CONTINUE
C
      K=0
      DO300I=1,NUMCPW
      K=K+1
      IF(ICH(I).EQ.' ')GOTO350
  300 CONTINUE
      NUMCH=K
      GOTO390
  350 CONTINUE
      NUMCH=K-1
  390 CONTINUE
C
C               ****************
C               **  STEP 3--  **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPXH1H--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ISTAR1,ILEN1,IX1
 9012 FORMAT('ISTAR1,ILEN1,IX1 = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ISTAR2,ILEN2,IX2
 9013 FORMAT('ISTAR2,ILEN2,IX2 = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMCH
 9014 FORMAT('NUMCH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(ICH(I),I=1,NUMCH)
 9015 FORMAT('ICH(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPYACB(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A YATES CUBE PLOT--
C              THE COMMAND HAS THE FOLLOWING FORMAT:
C                  YATES CUBE PLOT Y X1 X2 X3
C              WHERE X1, X2,  AND X3 ARE RESTRICTED TO HAVING VALUES
C              IN THE (-1,1) INTERVAL.  IF THEY HAVE 2 DISTINCT
C              LEVELS, THESE LEVELS WILL BE CONVERTED TO -1 AND 1.
C     EXAMPLE--YATES CUBE PLOT Y X1 X2 X3
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-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--2000/1
C     ORIGINAL VERSION--JANUARY       2000.
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 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
      CHARACTER*4 IHRI31
      CHARACTER*4 IHRI32
      CHARACTER*4 IHRI41
      CHARACTER*4 IHRI42
CCCCC CHARACTER*4 IH
      CHARACTER*4 IH1
      CHARACTER*4 IH2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
C
CCCCC CHARACTER*4 IREPU
CCCCC CHARACTER*4 IRESU
C
      CHARACTER*4 ICASEQ
C
CCCCC CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION YRES(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION X2(MAXOBV)
      DIMENSION X3(MAXOBV)
      DIMENSION TEMP1(MAXOBV)
      DIMENSION TEMP2(MAXOBV)
      DIMENSION TEMP3(MAXOBV)
      DIMENSION TEMP4(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),YRES(1))
      EQUIVALENCE (GARBAG(IGARB2),X1(1))
      EQUIVALENCE (GARBAG(IGARB3),X2(1))
      EQUIVALENCE (GARBAG(IGARB4),X3(1))
      EQUIVALENCE (GARBAG(IGARB5),TEMP1(1))
      EQUIVALENCE (GARBAG(IGARB6),TEMP2(1))
      EQUIVALENCE (GARBAG(IGARB7),TEMP3(1))
      EQUIVALENCE (GARBAG(IGARB8),TEMP4(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.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
      IERROR='NO'
      IFOUND='NO'
C
      ISUBN1='DPYA'
      ISUBN2='CB  '
C
      ICASPL='YCUB'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=4
      MINN2=1
C
      ICOLH=0
C
C               ****************************************
C               **  TREAT THE YATES CUBE PLOT CASE    **
C               ****************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'YACB')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPYACB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG2,IBUGG3,IBUGQ,ISUBRO
   52 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAXN
   54 FORMAT('MAXN = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'YACB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'CUBE'.AND.
     1   IHARG(2).EQ.'PLOT')GOTO112
      GOTO119
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO119
C
  119 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               **  AT LEAST 1 REQUIRED                              **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'YACB')
     1CALL 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               **  STEP 2.1--                         **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='2.1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'YACB')
     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  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'YACB')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               **************************************************
C               **  STEP 2.2--                                  **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **************************************************
C
      ISTEPN='2.2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'YACB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.4)GOTO2290
C
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPYACB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      ILLEGAL SYNTAX--THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      TO BE INCLUDED AS ARGUMENTS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      IN A YATES CUBE PLOT COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      MUST BE EXACTLY 4;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)NUMV2
 2216 FORMAT('      SUCH WAS NOT THE CASE HERE.  NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)
 2217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2218)(IANS(I),I=1,MIN(80,IWIDTH))
 2218 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
C
C               ***************************************
C               **  STEP 2.3                         **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               ***************************************
C
      ISTEPN='2.3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'YACB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2300I=1,NUMV2
      IH1=IHARG(I)
      IH2=IHARG2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH1,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(I.EQ.1)THEN
        ICOL1=IVALUE(ILOCV)
        N1=IN(ILOCV)
        IHRI11=IH1
        IHRI12=IH2
      ENDIF
      IF(I.EQ.2)THEN
        ICOL2=IVALUE(ILOCV)
        N2=IN(ILOCV)
        IHRI21=IH1
        IHRI22=IH2
      ENDIF
      IF(I.EQ.3)THEN
        ICOL3=IVALUE(ILOCV)
        N3=IN(ILOCV)
        IHRI31=IH1
        IHRI32=IH2
      ENDIF
      IF(I.EQ.4)THEN
        ICOL4=IVALUE(ILOCV)
        N4=IN(ILOCV)
        IHRI41=IH1
        IHRI42=IH2
      ENDIF
 2300 CONTINUE
C
C               **************************************************
C               **  STEP 2.4--                                  **
C               **  CHECK THAT FIRST THREE ARGUMENTS            **
C               **  HAVE THE SAME NUMBER OF OBSERVATIONS.       **
C               **************************************************
C
      ISTEPN='2.4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'YACB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N2.NE.N1.OR.N3.NE.N1.OR.N4.NE.N1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2411)
 2411   FORMAT('***** ERROR IN DPYACB--FOR A YATES CUBE PLOT,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2413)
 2413   FORMAT('      ALL FOUR VARIABLES MUST HAVE THE SAME')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2415)
 2415   FORMAT('      NUMER OF ELEMENTS;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2421)N1
 2421   FORMAT('THE FIRST  VARIABLE HAD ',I8,' ELEMENTS;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2422)N2
 2422   FORMAT('THE SECOND VARIABLE HAD ',I8,' ELEMENTS;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2423)N3
 2423   FORMAT('THE THIRD  VARIABLE HAD ',I8,' ELEMENTS;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2424)N4
 2424   FORMAT('THE FOURTH  VARIABLE HAD ',I8,' ELEMENTS;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2427)
 2427   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,2428)(IANS(I),I=1,MIN(80,IWIDTH))
 2428   FORMAT('      ',80A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ******************************************************
C               **  STEP 2.5--                                      **
C               **  CHECK THAT VARIABLES HAVE AT LEAST 1 ELEMENT    **
C               ******************************************************
C
 4100 CONTINUE
      ISTEPN='2.5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'YACB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.GE.1)GOTO2590
C
 2510 CONTINUE
      WRITE(ICOUT,2511)
 2511 FORMAT('***** ERROR IN DPYACB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2513)
 2513 FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2514)
 2514 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2515)
 2515 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2516)IHRI11,IHRI12,N1
 2516 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2520)
 2520 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2521)(IANS(I),I=1,MIN(100,IWIDTH))
 2521 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2590 CONTINUE
C
C               *************************************************
C               **  STEP 3--                                   **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FOR  EACH OF THE RESPONSE VARIABLES   **
C               **  EXTRACT THE DATA SUBSET                    **
C               *************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'YACB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO3010
      IF(ICASEQ.EQ.'SUBS')GOTO3020
      IF(ICASEQ.EQ.'FOR')GOTO3030
C
 3010 CONTINUE
      DO3015I=1,N1
      ISUB(I)=1
 3015 CONTINUE
      NQ=N1
      GOTO3050
C
 3020 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3050
C
 3030 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3050
C
 3050 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO3060I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3060
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)YRES(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)YRES(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)YRES(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)YRES(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)YRES(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)YRES(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)YRES(J)=TAGPLO(I)
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)X1(J)=TAGPLO(I)
C
      IJ=MAXN*(ICOL3-1)+I
      IF(ICOL3.LE.MAXCOL)X2(J)=V(IJ)
      IF(ICOL3.EQ.MAXCP1)X2(J)=PRED(I)
      IF(ICOL3.EQ.MAXCP3)X2(J)=RES(I)
      IF(ICOL3.EQ.MAXCP3)X2(J)=YPLOT(I)
      IF(ICOL3.EQ.MAXCP4)X2(J)=XPLOT(I)
      IF(ICOL3.EQ.MAXCP5)X2(J)=X2PLOT(I)
      IF(ICOL3.EQ.MAXCP6)X2(J)=TAGPLO(I)
C
      IJ=MAXN*(ICOL4-1)+I
      IF(ICOL4.LE.MAXCOL)X3(J)=V(IJ)
      IF(ICOL4.EQ.MAXCP1)X3(J)=PRED(I)
      IF(ICOL4.EQ.MAXCP3)X3(J)=RES(I)
      IF(ICOL4.EQ.MAXCP3)X3(J)=YPLOT(I)
      IF(ICOL4.EQ.MAXCP4)X3(J)=XPLOT(I)
      IF(ICOL4.EQ.MAXCP5)X3(J)=X2PLOT(I)
      IF(ICOL4.EQ.MAXCP6)X3(J)=TAGPLO(I)
C
 3060 CONTINUE
      N=J
C
C               *******************************************************
C               **  STEP 8--                                         **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS            **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.               **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).    **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).    **
C               *******************************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'YACB')GOTO5099
      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      WRITE(ICOUT,5001)NLOCAL,ICASPL
 5001 FORMAT('NLOCAL,ICASPL=',I5,1X,A4)
      CALL DPWRST('XXX','BUG ')
 5099 CONTINUE
C
      CALL DPYAC2(YRES,X1,X2,X3,N,ICASPL,NUMV2,
     1TEMP1,TEMP2,TEMP3,TEMP4,
     1Y,X,D,X3D,DSIZE,
     1N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
      NPLOTP=N2
C
C               *****************
C               **  STEP 9--   **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'YACB')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPYACB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG2,IBUGG3,IBUGQ,ISUBRO
 9012 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NLOCAL,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NLOCAL,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)NLOCAL
 9041 FORMAT('NLOCAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)NPLOTP
 9051 FORMAT('NPLOTP = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPYAC2(YRES,X1,X2,X3,N,ICASPL,NUMV2,
     1TEMP1,TEMP2,TEMP3,TEMP4,
     1Y,X,D,X3D,DSIZE,
     1NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A YATES CUBE PLOT
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-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--2000/12
C     ORIGINAL VERSION--JANUARY   2000.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
CCCCC CHARACTER*4 ICONC
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION YRES(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
      DIMENSION X3(*)
C
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION TEMP4(*)
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
      DIMENSION X3D(*)
      DIMENSION DSIZE(*)
C
      DIMENSION V1(8)
      DIMENSION V2(8)
      DIMENSION V3(8)
      DIMENSION AX1OF(8)
      DIMENSION AX2OF(8)
      DIMENSION AX3OF(8)
      DIMENSION ZX1(8)
      DIMENSION ZX2(8)
      DIMENSION ZX3(8)
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
      DATA V1 /-1.0, +1.0, -1.0, +1.0, -1.0, +1.0, -1.0, +1.0 /
      DATA V2 /-1.0, -1.0, +1.0, +1.0, -1.0, -1.0, +1.0, +1.0 /
      DATA V3 /-1.0, -1.0, -1.0, -1.0, +1.0, +1.0, +1.0, +1.0 /
      DATA AX1OF /-0.1,  0.1, -0.1,  0.1,  0.1,  0.1,  0.1,  0.1 /
      DATA AX2OF / 0.1,  0.1,  0.0,  0.0,  0.2,  0.0,  0.0,  0.0 /
      DATA AX3OF / 0.0, -0.1,  0.1, -0.1,  0.2,  0.1,  0.1,  0.0 /
      DATA ZX1   / 0.0,  1.0,  0.0,  1.0,  0.0,  1.0,  0.0,  1.0 /
      DATA ZX2   / 1.0,  1.0,  1.0,  1.0,  0.0,  0.0,  0.0,  0.0 /
      DATA ZX3   / 0.0,  0.0,  1.0,  1.0,  0.0,  0.0,  1.0,  1.0 /
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPYA'
      ISUBN2='C2  '
      IWRITE='OFF'
C
      IERROR='NO'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPYAC2--')
      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(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'YAC2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPYAC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,N,N2,NPLOTV,NUMV2
   72 FORMAT('ICASPL,N,N2,NPLOTV,NUMV2 = ',A4,2X,4I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ****************************************
C               **  STEP 4--                          **
C               **  STEP THROUGH EACH FACTOR VARIABLE **
C               **  AND DETERMINE IF THERE ARE 2      **
C               **  DISTINCT ELEMENTS.                **
C               ****************************************
C
      IERROR='NO'
      CALL DISTIN(X1,N,IWRITE,TEMP4,N1,IBUGG3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(N1.NE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,101)
  101   FORMAT('***** ERROR FROM DPYAC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,103)
  103   FORMAT('      FIRST FACTOR VARIABLE HAS ',I8,' DISTINCT ',
     1         'VALUES.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ELSE
        IF(TEMP4(1).LE.TEMP4(2))THEN
          ALOW=TEMP4(1)
          AHIGH=TEMP4(2)
        ELSE
          ALOW=TEMP4(2)
          AHIGH=TEMP4(1)
        ENDIF
        DO109I=1,N
          TEMP1(I)=-1.0
          ATEMP=ABS(X1(I)-AHIGH)
          IF(ATEMP.LE.0.0005)TEMP1(I)=1.0
  109   CONTINUE
      ENDIF
C
      IERROR='NO'
      CALL DISTIN(X2,N,IWRITE,TEMP4,N2,IBUGG3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(N2.NE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,111)
  111   FORMAT('***** ERROR FROM DPYAC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,113)
  113   FORMAT('      SECOND FACTOR VARIABLE HAS ',I8,' DISTINCT ',
     1         'VALUES.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ELSE
        IF(TEMP4(1).LE.TEMP4(2))THEN
          ALOW=TEMP4(1)
          AHIGH=TEMP4(2)
        ELSE
          ALOW=TEMP4(2)
          AHIGH=TEMP4(1)
        ENDIF
        DO119I=1,N
          TEMP2(I)=-1.0
          ATEMP=ABS(X2(I)-AHIGH)
          IF(ATEMP.LE.0.0005)TEMP2(I)=1.0
  119   CONTINUE
      ENDIF
C
      IERROR='NO'
      CALL DISTIN(X3,N,IWRITE,TEMP4,N3,IBUGG3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(N3.NE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,121)
  121   FORMAT('***** ERROR FROM DPYAC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,123)
  123   FORMAT('      THIRD FACTOR VARIABLE HAS ',I8,' DISTINCT ',
     1         'VALUES.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ELSE
        IF(TEMP4(1).LE.TEMP4(2))THEN
          ALOW=TEMP4(1)
          AHIGH=TEMP4(2)
        ELSE
          ALOW=TEMP4(2)
          AHIGH=TEMP4(1)
        ENDIF
        DO129I=1,N
          TEMP3(I)=-1.0
          ATEMP=ABS(X3(I)-AHIGH)
          IF(ATEMP.LE.0.0005)TEMP3(I)=1.0
  129   CONTINUE
      ENDIF
C
C               ****************************************
C               **  STEP 5--                          **
C               **  LOOP THROUGH 8 POTENTIAL VERTICES **
C               **    -1 -1 -1                        **
C               **    -1 -1  1                        **
C               **    -1  1 -1                        **
C               **    -1  1  1                        **
C               **     1 -1 -1                        **
C               **     1 -1  1                        **
C               **     1  1 -1                        **
C               **     1  1  1                        **
C               **  AND COMPUTE PLOT POINTS           **
C               ****************************************
C
      ATOL=0.0005
      NPLOTP=0
      ITAG=0
      DO200I=1,8
        AX1=V1(I)
        AX2=V2(I)
        AX3=V3(I)
        NMTCH=0
        DO210J=1,N
          IF(AX1.EQ.TEMP1(J).AND.AX2.EQ.TEMP2(J).AND.AX3.EQ.TEMP3(J))
     1      THEN
            NMTCH=NMTCH+1
            TEMP4(NMTCH)=YRES(J)
          ENDIF
  210   CONTINUE
        IF(NMTCH.GT.0)THEN
          CALL MEAN(TEMP4,NMTCH,IWRITE,AMU,IBUGG3,IERROR)
CCCCC     ITAG=ITAG+1
          NPLOTP=NPLOTP+1
          X(NPLOTP)=ZX1(I)+AX1OF(I)
          X3D(NPLOTP)=ZX2(I)+AX2OF(I)
          Y(NPLOTP)=ZX3(I)+AX3OF(I)
          D(NPLOTP)=REAL(ITAG)
          DSIZE(NPLOTP)=AMU
        ENDIF 
  200 CONTINUE
C
C               ****************************************
C               **  STEP 5--                          **
C               **  GENERATE THE 6 FACES OF THE CUBE **
C               ****************************************
      ITAG=ITAG+1
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
C
      ITAG=ITAG+1
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
C
      ITAG=ITAG+1
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
C
      ITAG=ITAG+1
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
C
      ITAG=ITAG+1
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=0.0
      D(NPLOTP)=REAL(ITAG)
C
      ITAG=ITAG+1
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=1.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=1.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
      NPLOTP=NPLOTP+1
      X(NPLOTP)=0.0
      X3D(NPLOTP)=0.0
      Y(NPLOTP)=1.0
      D(NPLOTP)=REAL(ITAG)
C
 8000 CONTINUE
      NPLOTV=3
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'YAC2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPYAC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,N,N2,IERROR
 9012 FORMAT('ICASPL,N,N2,IERROR = ',A4,2I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N2
 9013 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO9023
      DO9021I=1,N
      WRITE(ICOUT,9022)I,Y(I),X1(I),X2(I),X3(I)
 9022 FORMAT('I,Y(I),X1(I),X2(I),X3(I) = ',I8,4E13.5)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9023 CONTINUE
      WRITE(ICOUT,9031)N2,NPLOTV
 9031 FORMAT('N2,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,NPLOTP
      WRITE(ICOUT,9036)I,X(I),X3D(I),Y(I),D(I),DSIZE(I)
 9036 FORMAT('I,X(I),X3D(I),Y(I),D(I),DSIZE(I) = ',I5,5F10.5)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPYACU(IHARG,IARGT,ARG,NUMARG,
     1YATCCU,YATTCU,YATRCU,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE YATES COEF/T/RESSD CUTOFF
C              THE SPECIFIED YATES COEF CUTOFF WILL BE PLACED
C              IN THE FLOATING POINT VARIABLES
C              YATCCU,YATTCU,YATRCU   RESPECTIVELY.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--YATCCU (A FLOATING POINT VARIABLE)
C                       YATTCU (A FLOATING POINT VARIABLE)
C                       YATRCU (A FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/12
C     ORIGINAL VERSION--NOVEMBER  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
      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.1)GOTO9000
      IF(IHARG(1).EQ.'COEF')GOTO1110
      IF(IHARG(1).EQ.'T')GOTO1110
      IF(IHARG(1).EQ.'RESS')GOTO1110
      GOTO9000
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'CUTO')GOTO1150
      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(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPYACU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR YATES ... CUTOFF ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      EXAMPLES OF ALLOWABLE FORMS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('          YATES COEF  CUTOFF 10')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('          YATES T     CUTOFF 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)
 1133 FORMAT('          YATES RESSD CUTOFF .5')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      THE DEFAULT YATES COEF  CUTOFF ',
     1'IS INFINITY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      THE DEFAULT YATES T     CUTOFF ',
     1'IS INFINITY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      THE DEFAULT YATES RESSD CUTOFF ',
     1'IS INFINITY')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      HOLD=CPUMAX
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IF(IHARG(1).EQ.'COEF')YATCCU=HOLD
      IF(IHARG(1).EQ.'T')YATTCU=HOLD
      IF(IHARG(1).EQ.'RESS')YATRCU=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      IF(IHARG(1).EQ.'COEF')
     1WRITE(ICOUT,1181)YATCCU
 1181 FORMAT('THE YATES COEFFICIENT CUTOFF HAS JUST BEEN SET TO ',
     1E15.7)
      IF(IHARG(1).EQ.'COEF')
     1CALL DPWRST('XXX','BUG ')
      IF(IHARG(1).EQ.'T')
     1WRITE(ICOUT,1182)YATTCU
 1182 FORMAT('THE YATES T-VALUE CUTOFF HAS JUST BEEN SET TO ',
     1E15.7)
      IF(IHARG(1).EQ.'T')
     1CALL DPWRST('XXX','BUG ')
      IF(IHARG(1).EQ.'RESS')
     1WRITE(ICOUT,1183)
 1183 FORMAT('THE YATES RESIDUAL STANDARD DEVIATION CUTOFF ')
      IF(IHARG(1).EQ.'RESS')
     1CALL DPWRST('XXX','BUG ')
      IF(IHARG(1).EQ.'RESS')
     1WRITE(ICOUT,1184)YATRCU
 1184 FORMAT('HAS JUST BEEN SET TO ', E15.7)
      IF(IHARG(1).EQ.'RESS')
     1CALL DPWRST('XXX','BUG ')
 1189 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 ')
C
      IF(IHARG(1).EQ.'COEF')
     1WRITE(ICOUT,8111)YATCCU
 8111 FORMAT('THE CURRENT YATES COEFFICIENT CUTOFF IS ',E15.7)
      IF(IHARG(1).EQ.'COEF')
     1CALL DPWRST('XXX','BUG ')
      IF(IHARG(1).EQ.'COEF')
     1WRITE(ICOUT,8112)
 8112 FORMAT('THE DEFAULT YATES COEFFICIENT CUTOFF IS INFINITY')
      IF(IHARG(1).EQ.'COEF')
     1CALL DPWRST('XXX','BUG ')
C
      IF(IHARG(1).EQ.'T')
     1WRITE(ICOUT,8113)YATTCU
 8113 FORMAT('THE CURRENT YATES T-VALUE CUTOFF IS ',E15.7)
      IF(IHARG(1).EQ.'T')
     1CALL DPWRST('XXX','BUG ')
      IF(IHARG(1).EQ.'T')
     1WRITE(ICOUT,8114)
 8114 FORMAT('THE DEFAULT YATES T-VALUE CUTOFF IS INFINITY')
      IF(IHARG(1).EQ.'T')
     1CALL DPWRST('XXX','BUG ')
C
      IF(IHARG(1).EQ.'RESS')
     1WRITE(ICOUT,8115)YATRCU
 8115 FORMAT('THE CURRENT YATES RES. SD. CUTOFF IS ',E15.7)
      IF(IHARG(1).EQ.'RESS')
     1CALL DPWRST('XXX','BUG ')
      IF(IHARG(1).EQ.'RESS')
     1WRITE(ICOUT,8116)
 8116 FORMAT('THE DEFAULT YATES RES. SD. CUTOFF IS INFINITY')
      IF(IHARG(1).EQ.'RESS')
     1CALL DPWRST('XXX','BUG ')
C
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPYAOU(IHARG,NUMARG,
     1IYATOS,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE YATES COEF/T/RESSD CUTOFF
C              THE SPECIFIED YATES COEF CUTOFF WILL BE PLACED
C              IN THE CHARACTER VARIABLE IYATOS.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IYATOS (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/12
C     ORIGINAL VERSION--NOVEMBER  1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IYATOS
      CHARACTER*4 IHOLD
      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(NUMARG.LE.0)GOTO9000
      IF(IHARG(1).EQ.'OUTP')GOTO1110
      GOTO9000
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'OUTP')GOTO1150
      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.'?')GOTO8100
      GOTO1160
C
 1150 CONTINUE
      IHOLD='123'
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IYATOS=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IYATOS
 1181 FORMAT('THE YATES SWITCH HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 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 ')
C
      WRITE(ICOUT,8111)IYATOS
 8111 FORMAT('THE CURRENT   YATES OUTPUT SWITCH IS ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)
 8112 FORMAT('THE DEFAULT   YATES OUTPUT SWITCH IS 123')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8113)
 8113 FORMAT('THE ALLOWABLE YATES OUTPUT SWITCH SETTINGS ARE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8121)
 8121 FORMAT('    1     TO PRINT YATES OUTPUT SECTION 1 ONLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8122)
 8122 FORMAT('    2     TO PRINT YATES OUTPUT SECTION 2 ONLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8123)
 8123 FORMAT('    3     TO PRINT YATES OUTPUT SECTION 3 ONLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8124)
 8124 FORMAT('    12    TO PRINT YATES OUTPUT SECTIONS 1 & 2 ONLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8125)
 8125 FORMAT('    13    TO PRINT YATES OUTPUT SECTIONS 1 & 3 ONLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8126)
 8126 FORMAT('    23    TO PRINT YATES OUTPUT SECTIONS 2 & 3 ONLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8127)
 8127 FORMAT('    123   TO PRINT ALL 3 YATES OUTPUT SECTIONS')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPYATE(ICASAN,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A YATES ANALYSIS
C              (USEFUL FOR COMPUTING THE EFFECTS IN A 2**K
C              AND A 2**(K-P) EXPERIMENT)
C     NOTE--THIS CODE ASSUMES THE DATA IS IN
C           STANDARD YATES/HUNTER/BOX ORDER.
C           FOR EXAMPLE, FOR A 2**3--
C                 - - -
C                 + - -
C                 - + -
C                 + + -
C                 - - +
C                 + - +
C                 - + +
C                 + + +
C     NOTE--IF HAVE REPLICATION, THEN THE REPLICATES
C           MAY EITHER BE IMMEDIATELY WITHIN
C           OR MAY BE IN BLOCKS AFTER.
C     EXAMPLE--YATES Y
C              YATES Y SET
C              YATES ANALYSIS Y
C              YATES ANALYSIS Y SET
C              DEX FIT Y
C              DEX FIT Y REP
C              2**K DEX FIT Y
C              2**K DEX FIT Y REP
C              + OTHER COMBINATIONS OF SYNONYMS
C     NOTE--IF THERE ARE NO REPLICATIONS IN THE DATA,
C           THEN THIS COMMAND TAKES 1 ARGUMENT.
C           IF HAVE REPLCATION,
C           THEN THIS COMMAND TAKES 2 ARGUMENTS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/7
C     ORIGINAL VERSION--JUNE      1987.
C     UPDATED         --JUNE      1989.  SYNONYM = (2**K) DEX FIT
C     UPDATED         --NOVEMBER  1989.  SELECTIVE PRINTING OF COEF
C     UPDATED         --JUNE      1990.  TEMPORARY ARRAYS TO GARBAGE COMMON
C                                        MOVE SOME DPYAT2 DIMENSIONS TO DPYATE
C     UPDATED         --NOVEMBER  1991.  ALLOW 2**1 ANALYSIS
C     UPDATED         --APRIL     1992. DEFINE CUTOFF
C     UPDATED         --APRIL     1992. DELETE MAXNPP
C     UPDATED         --APRIL     1992. DELETE NPLOTP,X(.),Y(.),D(.)
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASAN
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 IANGLU
      CHARACTER*4 ICAPSW
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992 (ALAN)
      INCLUDE 'DPCOHO.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
C
      DIMENSION COEF(MAXOBV)
      DIMENSION SSQCOE(MAXOBV)
      DIMENSION TCOEF(MAXOBV)
      DIMENSION RSDCOE(MAXOBV)
      DIMENSION TAGCOE(MAXOBV)
      DIMENSION TAGCO2(MAXOBV)
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZI.INC'
      DIMENSION REPD(MAXOBV)
      DIMENSION IFLAG(MAXOBV)
      DIMENSION RSDCOC(MAXOBV)
      DIMENSION ITAG(MAXOBV)
      DIMENSION ITAGCO(MAXOBV)
      DIMENSION YMEAN(MAXOBV)
      DIMENSION YVAR(MAXOBV)
      DIMENSION DUMMY(MAXOBV)
      DIMENSION DUMMY2(MAXOBV)
      DIMENSION AINDEX(MAXOBV)
      DIMENSION AINDE2(MAXOBV)
      DIMENSION TEMP(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),COEF(1))
      EQUIVALENCE (GARBAG(IGARB4),SSQCOE(1))
      EQUIVALENCE (GARBAG(IGARB5),TCOEF(1))
      EQUIVALENCE (GARBAG(IGARB6),RSDCOE(1))
      EQUIVALENCE (GARBAG(IGARB7),TAGCOE(1))
      EQUIVALENCE (GARBAG(IGARB8),TAGCO2(1))
      EQUIVALENCE (GARBAG(IGARB9),REPD(1))
      EQUIVALENCE (GARBAG(IGAR10),RSDCOC(1))
      EQUIVALENCE (G2RBAG(IGAR11),YMEAN(1))
      EQUIVALENCE (G2RBAG(IGAR12),YVAR(1))
      EQUIVALENCE (G2RBAG(IGAR13),DUMMY(1))
      EQUIVALENCE (G2RBAG(IGAR14),DUMMY2(1))
      EQUIVALENCE (G2RBAG(IGAR15),AINDEX(1))
      EQUIVALENCE (G2RBAG(IGAR16),AINDE2(1))
      EQUIVALENCE (G2RBAG(IGAR17),TEMP(1))
      EQUIVALENCE (IGARBG(IIGAR1),IFLAG(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITAG(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITAGCO(1))
CCCCC END CHANGE
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989
      INCLUDE 'DPCODE.INC'
      INCLUDE 'DPCOSU.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='DPYA'
      ISUBN2='TE  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      IWRITE='YES'
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED   APRIL 1992 (ALAN)
      ICUTMX=NUMBPW
      IF(IHOST1.EQ.'CDC '.OR.IHOST1.EQ.'CYBE')ICUTMX=48
      IF(IHOST1.EQ.'205 ')ICUTMX=48
      CUTOFF=2**(ICUTMX-3)
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'YATE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPYATE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASAN
   53 FORMAT('ICASAN = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,54)IANGLU,IBUGA2,IBUGA3,IBUGQ
CCC54 FORMAT('IANGLU,IBUGA2,IBUGA3,IBUGQ = ',
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGA2,IBUGA3,IBUGQ
   54 FORMAT('IBUGA2,IBUGA3,IBUGQ = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASAN,MAXN
   56 FORMAT('ICASAN,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC WRITE(ICOUT,58)MAXNPP
CCC58 FORMAT('MAXNPP = ',I8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE INSERTED NOVEMBER 1989
      WRITE(ICOUT,61)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
   61 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  TREAT THE YATES ANALYSIS CASE  **
C               *************************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'ANAL'.AND.IHARG2(1).EQ.'YSIS')GOTO1110
CCCCC THE FOLLOWING 5 LINES WERE ADDED JUNE 1989
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'FIT')GOTO1110
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'DEX'.AND.
     1IHARG(2).EQ.'FIT')GOTO1120
      GOTO1190
C
 1110 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED JUNE 1989
 1120 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING LINE WAS CHANGED JUNE 1989
CCCCC ICASAN='YATE'
      ICASAN='DEXF'
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  CARRY OUT A GENERAL CHECK FOR THE                 **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE 1 OR 2).                            **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL 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               **  STEP 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'YATE')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ********************************************************
C               **  STEP 14--                                         **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE                **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE 1 OR 2).                            **
C               ********************************************************
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.1)GOTO1490
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPYATE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A YATES ANALYSIS, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,IWIDTH)
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ****************************************************************
C               **  STEP 15--                                                  *
C               **  EXAMINE THE VARIABLES--                                    *
C               **  HAS EACH VARIABLE                                          *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISR1, ILISR2,                              *
C               **  IS THE LINE IN THE TABLE                                   *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               **  NOTE THAT     ICOLR1, ICOLR2,                              *
C               **  IS THE DATA COLUMN (1 TO 10+6)                             *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               ****************************************************************
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      IF(NUMVAR.LE.1)GOTO1590
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPYATE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,IWIDTH)
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPYATE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,IWIDTH)
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  CHECK THAT VARIABLES 1 AND 2       HAVE         **
C               **  THE SAME NUMBER OF ELEMENTS.                    **
C               ******************************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.LE.1)GOTO2190
      IF(NIRIG1.EQ.NIRIG2)GOTO2190
C
 2110 CONTINUE
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPYATE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      THE NUMBER OF OBSERVATIONS IN VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      1 AND 2 MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1
 2116 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2
 2117 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2120)
 2120 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2121)(IANS(I),I=1,IWIDTH)
 2121 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2190 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPYATE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH AN YATES ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE PERFORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE RESPONSE VARIABLE              **
C               **       THE REPLICATION-TAG VARIABLE       **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1WRITE(ICOUT,780)N,NIRIG1,NQ,IMAX
  780 FORMAT(' N,NIRIG1,NQ,IMAX = ',4I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL DPWRST('XXX','BUG ')
      DO3300I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3300
      J=J+1
C
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IF(NUMVAR.LE.1)Y2(J)=1.0
      IF(NUMVAR.LE.1)GOTO3300
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
 3300 CONTINUE
      NS=J
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1WRITE(ICOUT,776)J,NS
  776 FORMAT('J,NS = ',2I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL DPWRST('XXX','BUG ')
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT THE            **
C               **  SUBSETTING DOES NOT RESULT IN          **
C               **  TOO FEW DATA POINTS RESULTING          **
C               **  (AT LEAST 2)                           **
C               **  WITH WHICH TO DO A YATES ANALYSIS.     **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUNT=0
      IF(NS.LE.2)ICOUNT=NS
      IF(NS.LE.2)GOTO3410
      DO3400I=1,NS
CCCCC WRITE(ICOUT,777)I,ICOUNT,NS,MINN2,Y2(I)
CC777 FORMAT('I,ICOUNT,NS,MINN2,Y2(I) = ',I8,E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUNT=ICOUNT+1
 3400 CONTINUE
 3410 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED NOVEMBER 1991
CCCCC IF(ICOUNT.LE.MINN2)GOTO3450
      IF(ICOUNT.LT.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPYATE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED SUBSETTING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)IHRI11,IHRI12
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH A YATES ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE PERFORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)ICOUNT
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE (ICOUNT = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)
 3459 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3460)(IANS(I),I=1,IWIDTH)
 3460 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ***************************************
C               **  STEP 41--                        **
C               **  CARRY OUT THE YATES ANALYSIS     **
C               ***************************************
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'YATE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC JUNE, 1990.  MOVE SOME DIMENSIONS FROM DPYAT2 TO DPYATE
      CALL DPYAT2(Y1,Y2,NS,ICASAN,MAXN,IWRITE,
CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989
     1YATCCU,YATTCU,YATRCU,IYATOS,IYATRS,
     1COEF,SSQCOE,TCOEF,RSDCOE,TAGCOE,TAGCO2,NCOEF,
     1PRESSD,PRESDF,REPSD,REPDF,REFSD,REFDF,SDCOEF,
     1REPD,IFLAG,RSDCOC,ITAG,ITAGCO,YMEAN,
     1YVAR,DUMMY,DUMMY2,AINDEX,AINDE2,TEMP,
     1ICAPSW,ICAPTY,
     1IBUGA3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 51--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='51'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NPASS=7
      DO5100IPASS=1,NPASS
      IF(IPASS.EQ.1)IH='PRES'
      IF(IPASS.EQ.1)IH2='SD  '
      IF(IPASS.EQ.2)IH='PRES'
      IF(IPASS.EQ.2)IH2='DF  '
      IF(IPASS.EQ.3)IH='REPS'
      IF(IPASS.EQ.3)IH2='D  '
      IF(IPASS.EQ.4)IH='REPD'
      IF(IPASS.EQ.4)IH2='F   '
      IF(IPASS.EQ.5)IH='REFS'
      IF(IPASS.EQ.5)IH2='D  '
      IF(IPASS.EQ.6)IH='REFD'
      IF(IPASS.EQ.6)IH2='F   '
      IF(IPASS.EQ.7)IH='SDCO'
      IF(IPASS.EQ.7)IH2='EF  '
C
      DO5150I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO5180
 5150 CONTINUE
      IF(NUMNAM.LT.MAXNAM)GOTO5170
      WRITE(ICOUT,5151)
 5151 FORMAT('***** ERROR IN DPYATE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5152)
 5152 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5153)MAXNAM
 5153 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5154)
 5154 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5155)
 5155 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5156)
 5156 FORMAT('      HAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5157)
 5157 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5158)
 5158 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5159)
 5159 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5160)
 5160 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5161)
 5161 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5162)
 5162 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5163)(IANS(I),I=1,IWIDTH)
 5163 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 5170 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      IF(IPASS.EQ.1)VALUE(ILOC)=PRESSD
      IF(IPASS.EQ.2)VALUE(ILOC)=PRESDF
      IF(IPASS.EQ.3)VALUE(ILOC)=REPSD
      IF(IPASS.EQ.4)VALUE(ILOC)=REPDF
      IF(IPASS.EQ.5)VALUE(ILOC)=REFSD
      IF(IPASS.EQ.6)VALUE(ILOC)=REFDF
      IF(IPASS.EQ.7)VALUE(ILOC)=SDCOEF
      VAL=VALUE(ILOC)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(ILOC)=IVAL
      GOTO5100
C
 5180 CONTINUE
      IF(IPASS.EQ.1)VALUE(I2)=PRESSD
      IF(IPASS.EQ.2)VALUE(I2)=PRESDF
      IF(IPASS.EQ.3)VALUE(I2)=REPSD
      IF(IPASS.EQ.4)VALUE(I2)=REPDF
      IF(IPASS.EQ.5)VALUE(I2)=REFSD
      IF(IPASS.EQ.6)VALUE(I2)=REFDF
      IF(IPASS.EQ.7)VALUE(I2)=SDCOEF
      VAL=VALUE(I2)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(I2)=IVAL
      GOTO5100
C
 5100 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'YATE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPYATE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASAN
 9013 FORMAT('ICASAN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)MAXN,NUMVAR
 9014 FORMAT('MAXN,NUMVAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 6 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC IF(NPLOTP.LE.0)GOTO9029
CCCCC DO9020I=1,NPLOTP
CCCCC WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
C9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
CCCCC CALL DPWRST('XXX','BUG ')
C9020 CONTINUE
C9029 CONTINUE
      WRITE(ICOUT,9031)ICOUNT
 9031 FORMAT('ICOUNT = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9050I=1,NIRIG1
      WRITE(ICOUT,9051)I,Y1(I),Y2(I),ISUB(I)
 9051 FORMAT('I,Y1(I),Y2(I),ISUB(I) = ',I8,2E15.7,I8)
      CALL DPWRST('XXX','BUG ')
 9050 CONTINUE
      WRITE(ICOUT,9061)IHRI11,IHRI12
 9061 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)IHRI21,IHRI22
 9062 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE INSERTED NOVEMBER 1989
      WRITE(ICOUT,9071)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
 9071 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPYAT2(Y,REP,N,ICASPL,MAXN,IWRITE,
CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989
     1YATCCU,YATTCU,YATRCU,IYATOS,IYATRS,
     1COEF,SSQCOE,TCOEF,RSDCOE,TAGCOE,TAGCO2,NCOEF,
     1PRESSD,PRESDF,REPSD,REPDF,REFSD,REFDF,SDCOEF,
     1REPD,IFLAG,RSDCOC,ITAG,ITAGCO,YMEAN,
     1YVAR,DUMMY,DUMMY2,AINDEX,AINDE2,TEMP,
     1ICAPSW,ICAPTY,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--CARRY OUT A YATES ANALYSIS (DEX FIT FOR 2**K DESIGNS)
C              (USEFUL FOR COMPUTING THE EFFECTS IN A 2**K
C              AND A 2**(K-P) EXPERIMENT)
C     NOTE--THIS CODE ASSUMES THE DATA IS IN
C           STANDARD YATES/HUNTER/BOX ORDER.
C           FOR EXAMPLE, FOR A 2**3--
C                 - - -
C                 + - -
C                 - + -
C                 + + -
C                 - - +
C                 + - +
C                 - + +
C                 + + +
C     NOTE--IF HAVE REPLICATION, THEN THE REPLICATES
C           MAY EITHER BE IMMEDIATELY WITHIN
C           OR MAY BE IN BLOCKS AFTER.
C     EXAMPLE--YATES Y
C              YATES Y REP
C              YATES ANALYSIS Y
C              YATES ANALYSIS Y REP
C              DEX FIT Y
C              DEX FIT Y REP
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/7
C     ORIGINAL VERSION--JULY      1987.
C     UPDATED         --JUNE      1989.  2**K DEX FIT SYNONYM
C     UPDATED         --NOVEMBER  1989.  SELECTIVE PRINTING OF COEF
C     UPDATED         --JANUARY   1990.  PRINT MEAN IN ORDERED LIST
C     UPDATED         --JUNE      1990.  MOVE SOME DIMENSIONS TO DPYATE
C     UPDATED         --OCTOBER   1991.  PRINT TO STORAGE FILE
C     UPDATED         --NOVEMBER  1991.  FIX BOMB WITH PRINT FOR 2**2
C     UPDATED         --NOVEMBER  1991.  FIX BOMB FOR 2**1
C     UPDATED         --NOVEMBER  1991.  REMOVE 2 PRINT LINES (RESSD)
C     UPDATED         --APRIL     1992.  DELETE IFOUND
C     UPDATED         --JUNE      1992.  SKIP PRINTING SECTION 2
C     UPDATED         --JUNE      1992.  FIX SD(YBAR)
C     UPDATED         --NOVEMBER  1996.  FORMAT CORRECTIONS AFTER 7400 CONTINUE
C     UPDATED         --NOVEMBER  1996.  ADD LINES AT END OF OUTPUT (7713)
C     UPDATED         --OCTOBER   2003.  SUPPORT FOR HTML, LATEX OUTPUT
C     UPDATED         --JUNE      2005.  PRINT OUTPUT TO DPST1F.DAT AND
C                                        DPST2F.DAT EVEN IF PRINTING
C                                        SWITCH IS OFF
C     UPDATED         --OCTOBER   2006.  CALL LIST TO TPPF
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IWRITE
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IREP
      CHARACTER*4 ICASE
CCCCC THE FOLLOWING LINE WAS FIXED NOVEMBER 1991
CCCCC BECAUSE THE CALLING ROUTINE (DPYATE) HAD IFLAG NOVEMBER 1991
CCCCC EQUIVALANCED TO IGARBG WHICH WAS INTEGER BUT NOVEMBER 1991
CCCCC DPYAT2 WAS TRYING TO USE IFLAG AS CHARACTER*2 NOVEMBER 1991
CCCCC CHARACTER*2 IFLAG
      CHARACTER*2 STAR
      CHARACTER*12 STAR2
C
CCCCC THE FOLLOWING 2 SECTIONS WERE ADDED OCTOBER 1991
      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*4 ISUBN0
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
CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989
      CHARACTER*4 IYATOS
      CHARACTER*4 IYATRS
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
CCCCC JUNE, 1990.  FOLLOWING INCLUDE FILE NO LONGER NEEDED.
CCCCC       INCLUDE 'DPCOPA.INC'
C
CCCCC THE FOLLOWING INCLUDE STATEMENT WAS ADDED OCTOBER 1991
      INCLUDE 'DPCOF2.INC'
C
      DIMENSION Y(*)
      DIMENSION REP(*)
C
      DIMENSION COEF(*)
      DIMENSION SSQCOE(*)
      DIMENSION TCOEF(*)
      DIMENSION RSDCOE(*)
      DIMENSION TAGCOE(*)
      DIMENSION TAGCO2(*)
C
CCCCC FOLLOWING DIMENSIONS MOVED TO DPYATE
CCCCC DIMENSION REPD(MAXOBV)
CCCCC DIMENSION IFLAG(MAXOBV)
CCCCC DIMENSION RSDCOC(MAXOBV)
CCCCC DIMENSION ITAG(MAXOBV)
CCCCC DIMENSION ITAGCO(MAXOBV)
CCCCC DIMENSION YMEAN(MAXOBV)
CCCCC DIMENSION YVAR(MAXOBV)
CCCCC DIMENSION DUMMY(MAXOBV)
CCCCC DIMENSION DUMMY2(MAXOBV)
CCCCC DIMENSION AINDEX(MAXOBV)
CCCCC DIMENSION AINDE2(MAXOBV)
CCCCC DIMENSION TEMP(MAXOBV)
      DIMENSION REPD(*)
      DIMENSION IFLAG(*)
      DIMENSION RSDCOC(*)
      DIMENSION ITAG(*)
      DIMENSION ITAGCO(*)
      DIMENSION YMEAN(*)
      DIMENSION YVAR(*)
      DIMENSION DUMMY(*)
      DIMENSION DUMMY2(*)
      DIMENSION AINDEX(*)
      DIMENSION AINDE2(*)
      DIMENSION TEMP(*)
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='DPYA'
      ISUBN2='T2  '
C
      IERROR='NO'
C
      AN=N
      CUTOFF=999999.0
C
      CCUTP=YATCCU
      CCUTN=(-YATCCU)
      TCUTP=YATTCU
      TCUTN=(-YATTCU)
      RCUTP=YATRCU
      RCUTN=(-YATRCU)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'YAT2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPYAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,ISUBRO
   52 FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,MAXN
   53 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PRESSD,PRESDF,REPSD,REPDF
   55 FORMAT('PRESSD,PRESDF,REPSD,REPDF = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)REFDF,REFDF,SDCOEF
   56 FORMAT('REFDF,REFDF,SDCOEF = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)N
   60 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO63
      DO61I=1,N
      WRITE(ICOUT,62)I,Y(I),REP(I)
   62 FORMAT('I,Y(I),REP(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
      WRITE(ICOUT,71)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
   71 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)CCUTN,CCUTP
   72 FORMAT('CCUTN,CCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)TCUTN,TCUTP
   73 FORMAT('TCUTN,TCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)RCUTN,RCUTP
   74 FORMAT('RCUTN,RCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   63 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPYAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)N
 1114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.GE.2)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPYAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1130I=1,N
      IF(Y(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPYAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
CCCCCC THE FOLLOWING SECTION WAS ADDED OCTOBER 1991
C               **************************************************
C               **  STEP 15--                                   **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
 1500 CONTINUE
      ISTEPN='15'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='YAT2'
      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='YAT2'
      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
C               **************************************************
C               **  STEP 20--                                   **
C               **  COMPUTE GRAND MEAN                          **
C               **  COMPUTE GRAND STANDARD DEVIATION            **
C               **************************************************
C
      SUM=0.0
      DO2000I=1,N
      SUM=SUM+Y(I)
 2000 CONTINUE
      GMEAN=SUM/AN
C
      SUM=0.0
      DO2020I=1,N
      SUM=SUM+(Y(I)-GMEAN)**2
 2020 CONTINUE
      GSSQ=SUM
      GVAR=GSSQ/(AN-1.0)
      GSD=0.0
      IF(GVAR.GT.0.0)GSD=SQRT(GVAR)
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  EXTRACT THE DISTINCT REPLICATION VALUES       **
C               **  IN ORDER TO                                   **
C               **  DETERMINE THE TYPE OF REPLICATION CASE--      **
C               **     1) NO REPLICATION                          **
C               **     2) REPLICATION 'WITHIN', AS IN             **
C               **        (FOR A 2**2 WITH 3 REPLICATIONS)--      **
C               **          X1  X2  REP                           **
C               **           -   +   1                            **
C               **           -   +   2                            **
C               **           -   +   3                            **
C               **                                                **
C               **           +   +   1                            **
C               **           +   +   2                            **
C               **           +   +   3                            **
C               **                                                **
C               **           -   -   1                            **
C               **           -   -   2                            **
C               **           -   -   3                            **
C               **                                                **
C               **           +   +   1                            **
C               **           +   +   2                            **
C               **           +   +   3                            **
C               **     3) REPLICATION 'BETWEEN', AS IN            **
C               **        (FOR A 2**2 WITH 3 REPLICATIONS)--      **
C               **          X1  X2  REP                           **
C               **           -   +   1                            **
C               **           +   +   1                            **
C               **           -   -   1                            **
C               **           +   +   1                            **
C               **                                                **
C               **           -   +   2                            **
C               **           +   +   2                            **
C               **           -   -   2                            **
C               **           +   +   2                            **
C               **                                                **
C               **           -   +   3                            **
C               **           +   +   3                            **
C               **           -   -   3                            **
C               **           +   +   3                            **
C               **                                                **
C               ****************************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL DISTIN(REP,N,IWRITE,REPD,NREPD,IBUGA3,IERROR)
C
      NUMREP=NREPD
      ANUMRE=NUMREP
      IREP='NO'
      ICASE='-999'
      IF(NUMREP.EQ.1)GOTO2190
      IREP='YES'
      ICASE='BETW'
      IF(REP(2).NE.REP(1))ICASE='WITH'
 2190 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1WRITE(ICOUT,2191)REPD(1),REPD(2),REPD(3),REPD(4)
 2191 FORMAT('REPD(1),REPD(2),REPD(3),REPD(4) = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1CALL DPWRST('XXX','BUG ')
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1WRITE(ICOUT,2192)NREPD,IREP,ICASE
 2192 FORMAT('NREPD,IREP,ICASE = ',I8,2X,A4,2X,A4)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1CALL DPWRST('XXX','BUG ')
C
C               **************************************************
C               **  STEP 22--                                   **
C               **  COMPUTE CELL MEANS                          **
C               **************************************************
C
      IF(IREP.EQ.'NO')GOTO2210
      IF(ICASE.EQ.'WITH')GOTO2220
      GOTO2230
C
 2210 CONTINUE
      NMEAN=N
      ANMEAN=NMEAN
      DO2211I=1,N
      YMEAN(I)=Y(I)
 2211 CONTINUE
      GOTO2290
C
 2220 CONTINUE
      NMEAN=N/NUMREP
      ANMEAN=NMEAN
      DO2221I=1,NMEAN
      SUM=0.0
      JMIN=NUMREP*(I-1)+1
      JMAX=NUMREP*I
      DO2222J=JMIN,JMAX
      SUM=SUM+Y(J)
 2222 CONTINUE
      YMEAN(I)=SUM/ANUMRE
 2221 CONTINUE
      GOTO2290
C
 2230 CONTINUE
      NMEAN=N/NUMREP
      ANMEAN=NMEAN
      DO2231I=1,NMEAN
      SUM=0.0
      DO2232J=I,N,NMEAN
      SUM=SUM+Y(J)
 2232 CONTINUE
      YMEAN(I)=SUM/ANUMRE
 2231 CONTINUE
      GOTO2290
C
 2290 CONTINUE
      NCOEF=NMEAN
C
C               **************************************************
C               **  STEP 23--                                   **
C               **  IF HAVE REPLICATION,                        **
C               **  COMPUTE REPLICATION STANDARD DEVIATION      **
C               **************************************************
C
      IREPDF=0
      REPDF=0.0
      REPVAR=0.0
      REPSD=0.0
      LOFCDF=0.0
      IF(IREP.EQ.'NO')GOTO2390
      IF(ICASE.EQ.'WITH')GOTO2320
      GOTO2330
C
 2320 CONTINUE
      NMEAN=N/NUMREP
      ANMEAN=NMEAN
      SUMT=0.0
      DO2321I=1,NMEAN
      SUM=0.0
      JMIN=NUMREP*(I-1)+1
      JMAX=NUMREP*I
      DO2322J=JMIN,JMAX
      SUM=SUM+(Y(J)-YMEAN(I))**2
      SUMT=SUMT+(Y(J)-YMEAN(I))**2
 2322 CONTINUE
      YVAR(I)=SUM/(ANUMRE-1.0)
 2321 CONTINUE
      IREPDF=NMEAN
      REPDF=ANMEAN
      REPVAR=SUMT/REPDF
      REPSD=0.0
      IF(REPVAR.GT.0.0)REPSD=SQRT(REPVAR)
      GOTO2390
C
 2330 CONTINUE
      NMEAN=N/NUMREP
      ANMEAN=NMEAN
      SUMT=0.0
      DO2331I=1,NMEAN
      SUM=0.0
      DO2332J=I,N,NMEAN
      SUM=SUM+(Y(J)-YMEAN(I))**2
      SUMT=SUMT+(Y(J)-YMEAN(I))**2
 2332 CONTINUE
      YVAR(I)=SUM/(ANUMRE-1.0)
 2331 CONTINUE
      IREPDF=NMEAN
      REPDF=ANMEAN
      REPVAR=SUMT/REPDF
      REPSD=0.0
      IF(REPVAR.GT.0.0)REPSD=SQRT(REPVAR)
      GOTO2390
C
 2390 CONTINUE
      NCOEF=NMEAN
C
C               **************************************************
C               **  STEP 24--                                   **
C               **  COMPUTE EFFECTS                             **
C               **  (VIA THE YATES ALGORITHM ?)                   **
C               **************************************************
C
      DO2410I=1,NMEAN
      COEF(I)=YMEAN(I)
 2410 CONTINUE
C
      NPASS=(ALOG10(ANMEAN)/0.30103)+0.5
      NUMFAC=NPASS
C
      DO2420IPASS=1,NPASS
C
      DO2430I=1,NMEAN
      DUMMY(I)=COEF(I)
 2430 CONTINUE
C
      J1=0
      J2=NMEAN/2
      DO2440I=1,NMEAN,2
      IP1=I+1
      J1=J1+1
      J2=J2+1
      COEF(J1)=DUMMY(IP1)+DUMMY(I)
      COEF(J2)=DUMMY(IP1)-DUMMY(I)
 2440 CONTINUE
C
 2420 CONTINUE
C
      COEF(1)=COEF(1)/ANMEAN
      DO2450I=2,NMEAN
      COEF(I)=COEF(I)/(ANMEAN/2.0)
 2450 CONTINUE
C
C               **************************************************
C               **  STEP 24--                                   **
C               **  COMPUTE SUM OF SQUARES FOR EACH EFFECT      **
C               **  REFERENCE--HUNTER DESIGN OF EXP. COURSE,    **
C               **             VOLUME 4, PAGE 71                **
C               **************************************************
C
      SSQCOE(1)=GSSQ
      DO2500I=2,NMEAN
      SSQCOE(I)=ANMEAN*COEF(I)*COEF(I)/4.0
 2500 CONTINUE
C
C               **************************************************
C               **  STEP 26--                                   **
C               **  DEFINE IDENTIFIERS                          **
C               **************************************************
C
      J=0
      JP1=1
CCCCC TAGCOE(JP1)=0.0
      ITAGCO(JP1)=0.0
C
      J=1
      JP1=2
      ITAG(J)=1
CCCCC TAGCOE(JP1)=ITAG(J)
      ITAGCO(JP1)=ITAG(J)
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1991
      IF(NUMFAC.LE.1)GOTO2629
      DO2610IFAC=2,NUMFAC
      JMIN=2**(IFAC-1)
      JMAX=(2**IFAC)-1
      K=0
      DO2620J=JMIN,JMAX
      JP1=J+1
      IF(J.EQ.JMIN)ITAG(J)=IFAC
CCCCC IF(J.EQ.JMIN)TAGCOE(JP1)=ITAG(J)
      IF(J.EQ.JMIN)ITAGCO(JP1)=ITAG(J)
      IF(J.EQ.JMIN.AND.IFAC.GE.10)ITAGCO(JP1)=ITAGCO(JP1)-10
      IF(J.EQ.JMIN)GOTO2620
      K=K+1
      ITAG(J)=10*ITAG(K)+IFAC
CCCCC TAGCOE(JP1)=ITAG(J)
      ITAGCO(JP1)=ITAG(J)
      IF(IFAC.GE.10)ITAGCO(JP1)=ITAGCO(JP1)-10
 2620 CONTINUE
 2610 CONTINUE
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1991
 2629 CONTINUE
C
      TAGCO2(1)=0.0
      IF(NUMFAC.LE.0)GOTO2639
      DO2630I=2,NMEAN
      AJUNK=ITAGCO(I)
CCCCC ATEMP=ALOG10(TAGCOE(I)+0.5)
      ATEMP=ALOG10(AJUNK+0.5)
      ATEMP=ATEMP+1.0
      ITEMP=ATEMP
      TAGCO2(I)=ITEMP
 2630 CONTINUE
 2639 CONTINUE
C
C               **************************************************
C               **  STEP 27--                                   **
C               **  COMPUTE PSEUDO-REPLIC. STANDARD DEVIATION   **
C               **************************************************
C
      SUM=0.0
      SUMI=0.0
      DO2700I=1,NMEAN
      IF(TAGCO2(I).GE.2.5)SUM=SUM+SSQCOE(I)
      IF(TAGCO2(I).GE.2.5)SUMI=SUMI+1.0
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1WRITE(ICOUT,2701)I,TAGCO2(I),COEF(I),SSQCOE(I),SUMI,SUM
 2701 FORMAT('I,TAGCO2(I),COEF(I),SSQCOE(I),SUMI,SUM = ',I8,5E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1CALL DPWRST('XXX','BUG ')
 2700 CONTINUE
      PRESSS=SUM
      PRESDF=SUMI
      IPRESD=PRESDF+0.5
      PRESVA=0.0
      IF(PRESDF.GT.0.1)PRESVA=PRESSS/PRESDF
      PRESSD=0.0
      IF(PRESVA.GT.0.0)PRESSD=SQRT(PRESVA)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1WRITE(ICOUT,2702)PRESSS,PRESVA,PRESDF,PRESSD
 2702 FORMAT('PRESSS,PRESVA,PRESDF,PRESSD = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1CALL DPWRST('XXX','BUG ')
C
C               ****************************************************************
C               **  STEP 28--                                                  *
C               **  COMPUTE A REFERENCE STANDARD DEVIATION                     *
C               **  WHICH EQUALS                                               *
C               **     THE REPLICATION ST. DEV.     (IF HAVE REPLICATION)      *
C               **     THE PSEUDO-REPLIC. ST. DEV. (IF NOT HAVE REPLICATION)   *
C               ****************************************************************
C
      IREFDF=0
      IF(IREP.EQ.'NO')IREFDF=IPRESD
      IF(IREP.EQ.'YES')IREFDF=IREPDF
C
      REFVAR=0.0
      IF(IREP.EQ.'NO')REFVAR=PRESVA
C
      IF(IREP.EQ.'YES')REFVAR=REPVAR
      REFSD=0.0
      IF(REFVAR.GT.0.0)REFSD=SQRT(REFVAR)
C
C               **************************************************
C               **  STEP 29--                                   **
C               **  COMPUTE STANDARD DEV. FOR EACH COEF         **
C               **  REFERENCE--HUNTER DESIGN OF EXP. COURSE,    **
C               **             VOLUME 4, PAGE 82                **
C               **************************************************
C
      VCOER=0.0
      VCOER=2.0*(REPVAR/(AN/2.0))
      SDCOER=0.0
      IF(VCOER.GT.0.0)SDCOER=SQRT(VCOER)
C
      VCOEP=0.0
      VCOEP=2.0*(PRESVA/(AN/2.0))
      SDCOEP=0.0
      IF(VCOEP.GT.0.0)SDCOEP=SQRT(VCOEP)
C
      VCOEF=0.0
      VCOEF=2.0*(REFVAR/(AN/2.0))
      SDCOEF=0.0
      IF(VCOEF.GT.0.0)SDCOEF=SQRT(VCOEF)
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED OCTOBER 1991
      VGMEAN=0.0
      VGMEAN=REFVAR/AN
      SDGMEA=0.0
      IF(VGMEAN.GT.0.0)SDGMEA=SQRT(VGMEAN)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1WRITE(ICOUT,2903)REFVAR,REFSD,VCOEF,SDCOEF
 2903 FORMAT('REFVAR,REFSD,VCOEF,SDCOEF = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1CALL DPWRST('XXX','BUG ')
C
C               **************************************************
C               **  STEP 30--                                   **
C               **  COMPUTE T VALUE FOR EACH COEF               **
C               **************************************************
C
      DO3010I=1,NMEAN
      TCOEF(I)=0.0
      IF(SDCOEF.GT.0.0)TCOEF(I)=COEF(I)/SDCOEF
      IF(SDCOEF.GT.0.0.AND.TCOEF(I).GT.CUTOFF)TCOEF(I)=CUTOFF
      IF(SDCOEF.GT.0.0.AND.TCOEF(I).LT.-CUTOFF)TCOEF(I)=(-CUTOFF)
 3010 CONTINUE
C
C               **************************************************
C               **  STEP 31--                                   **
C               **  COMPUTE A SORT INDEX BASED ON               **
C               **  THE MAGNITUDE OF THE EFFECTS                **
C               **************************************************
C
      DO3110I=1,NMEAN
      DUMMY(I)=(-ABS(COEF(I)))
      AINDEX(I)=I
 3110 CONTINUE
C
      AMIN=DUMMY(1)
      DO3120I=1,NMEAN
      IF(DUMMY(I).LT.AMIN)AMIN=DUMMY(I)
 3120 CONTINUE
      DUMMY(1)=AMIN-10.0
C
      CALL SORTC(DUMMY,AINDEX,NMEAN,DUMMY2,AINDE2)
C
C               **************************************************
C               **  STEP 32--                                   **
C               **  COMPUTE THE RESIDUAL STANDARD DEVIATION     **
C               **  THAT WOULD RESULT IF FIT EACH TERM          **
C               **  INDIVIDUALLY, AS IN                         **
C               **  RESPONSE = CONSTANT + TERM + ERROR          **
C               **************************************************
C
CCCCC DO3210I=1,NMEAN
CCCCC CALL DMV(TAGCOE(I),NMEAN,TEMP)
CCCCC COEFFI=COEF(I)
CCCCC SUM=0.0
CCCCC DO3220J=1,NMEAN
CCCCC PREDJ=GMEAN+COEFFI*TEMP(J)
CCCCC RESJ=Y(J)-PREDJ
CCCCC SUM=SUM+RESJ*RESJ
C3220 CONTINUE
CCCCC RESVI=SUM/(AN-2.0)
CCCCC RESSDI=0.0
CCCCC IF(RESVI.GT.0.0)RESSDI=SQRT(RESVI)
CCCCC RSDCOE(I)=RESSDI
C3210 CONTINUE
C
      DO3210I=1,NMEAN
CCCCC THE FOLLOWING LINE WAS INSERTED JUNE 1992 (JJF)
      RVAR=0.0
CCCCC IF(I.EQ.1)RVAR=SSQCOE(1)/(ANMEAN-1.0)
      IF(I.EQ.1)RVAR=SSQCOE(1)/(AN-1.0)
CCCCC IF(I.GE.2)RVAR=(SSQCOE(1)-SSQCOE(I))/(ANMEAN-1.0-1.0)
CCCCC THE FOLLOWING LINE WAS FIXED NOVEMBER 1991
CCCCC IF(I.GE.2)RVAR=(SSQCOE(1)-SSQCOE(I))/(AN-1.0-1.0)
      IDENOM=N-1-1
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT & MOVED UP JUNE 1992 (JJF)
CCCCC RVAR=0.0
      IF(I.GE.2.AND.IDENOM.GE.1)RVAR=(SSQCOE(1)-SSQCOE(I))/
     1(AN-1.0-1.0)
      RSDCOE(I)=0.0
      IF(RVAR.GT.0.0)RSDCOE(I)=SQRT(RVAR)
 3210 CONTINUE
C
      DO3220I=1,NMEAN
      AI=I
      I2=AINDE2(I)+0.5
      IF(I.EQ.1)CUMSSQ=0.0
      IF(I.GE.2)CUMSSQ=CUMSSQ+SSQCOE(I2)
CCCCC IF(I.LT.NMEAN)RVAR=(SSQCOE(1)-CUMSSQ)/(ANMEAN-AI)
      IF(I.LT.NMEAN)RVAR=(SSQCOE(1)-CUMSSQ)/(AN-AI)
      IF(I.EQ.NMEAN.AND.IREP.EQ.'YES')RVAR=(SSQCOE(1)-CUMSSQ)/(AN-AI)
      IF(I.EQ.NMEAN.AND.IREP.EQ.'NO')RVAR=0.0
      RSDCOC(I2)=0.0
      IF(RVAR.GT.0.0)RSDCOC(I2)=SQRT(RVAR)
 3220 CONTINUE
C
C               **************************************************
C               **  STEP 33--                                   **
C               **  COMPUTE 97.5 AND 99.5 PERCENT POINTS        **
C               **  COMPUTE 95% AND 99% CONFIDENCE LIMITS       **
C               **************************************************
C
      NU=IREFDF
C
      P=0.975
      CALL TPPF(P,REAL(NU),T975)
      CL95=T975*SDCOEF
C
      P=0.995
      CALL TPPF(P,REAL(NU),T995)
      CL99=T995*SDCOEF
C
C               **************************************************
C               **  STEP 34--                                   **
C               **  FLAG THOSE EFFECTS WHICH HAVE T VALUES      **
C               **  LARGER (IN MAGNITUDE) THAT T975, AND        **
C               **  LARGER (IN MAGNITUDE) THAT T995             **
C               **************************************************
C
      DO3400I=1,NMEAN
CCCCC THE FOLLOWING 3 LINES WERE FIXED NOVEMBER 1991
CCCCC IFLAG(I)='  '
CCCCC IF(ABS(TCOEF(I)).GT.T975)IFLAG(I)='* '
CCCCC IF(ABS(TCOEF(I)).GT.T995)IFLAG(I)='**'
      IFLAG(I)=0
      IF(ABS(TCOEF(I)).GT.T975)IFLAG(I)=1
      IF(ABS(TCOEF(I)).GT.T995)IFLAG(I)=2
 3400 CONTINUE
C
C               ****************************
C               **  STEP 71--             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='71'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
CCCCC WRITE OUTPUT IN HTML FORMAT
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('
') 5002 FORMAT('
') 5003 FORMAT('2k DEX FIT ') 5004 FORMAT('
') 5005 FORMAT('

') WRITE(ICOUT,5001) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5002) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5003) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5004) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5005) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C C STEP 2: START TABLE AND DEFINE A CAPTION C IF(IYATOS.EQ.'1'.OR.IYATOS.EQ.'12'.OR.IYATOS.EQ.'13'.OR. 1 IYATOS.EQ.'123')THEN 5011 FORMAT('
    ') 5013 FORMAT('') WRITE(ICOUT,5011) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5013) CALL DPWRST('XXX','WRIT') C C STEP 4: DEFINE DATA ROW C 5041 FORMAT(' ') 5043 FORMAT(' ') 5049 FORMAT(' ') 5061 FORMAT(' Note--Data Must be in Standard ', 1 'Order:') 5062 FORMAT(' Number of Observations:') 5063 FORMAT(' Number of Factors:') 5064 FORMAT(' No Replication Case:') 5065 FORMAT(' Replication Case:') 5066 FORMAT(' Replication Standard Deviation:') 5067 FORMAT(' Replication Degrees of Freedom:') 5068 FORMAT(' Psuedo-Replication Standard Deviation:') 5069 FORMAT(' Psuedo-Degrees of Freedom:
    ') 5070 FORMAT(' (The Psuedo-Replication Standard Deviation') 5071 FORMAT(' assumes all 3, 4, 5, and higher level') 5072 FORMAT(' interaction terms are not real, but are') 5073 FORMAT(' manifestations of random error)') 5074 FORMAT(' Standard Deviation of a Coefficient:
    ') 5075 FORMAT(' (based on psudeo-replication standard ', 1 'deviation)') 5076 FORMAT(' (based on replication standard deviation)') 5077 FORMAT(' Grand Mean:') 5078 FORMAT(' Grand Standard Deviation:') 5079 FORMAT(' 99% Confidence Limits (+/-):') 5080 FORMAT(' 95% Confidence Limits (+/-):') 5081 FORMAT(' 99.5% Point of the t Distribution:') 5082 FORMAT(' 97.5% Point of the t Distribution:') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5061) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5062) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5053)N CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5063) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5053)NUMFAC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') IF(IREP.EQ.'NO')THEN WRITE(ICOUT,5064) ELSE WRITE(ICOUT,5065) ENDIF CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C IF(IREP.EQ.'YES')THEN WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5066) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)REPSD CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5067) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5053)IREPDF CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') ENDIF C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5068) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)PRESSD CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5069) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5070) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5071) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5072) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5073) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5053)IPRESD CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5074) CALL DPWRST('XXX','WRIT') IF(IREP.EQ.'YES')THEN WRITE(ICOUT,5075) ELSE WRITE(ICOUT,5076) ENDIF CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') IF(IREP.EQ.'YES')THEN WRITE(ICOUT,5051)SDCOER ELSE WRITE(ICOUT,5051)SDCOEP ENDIF CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5077) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)GMEAN CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5078) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)GSD CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5056) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5079) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CL99 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5080) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CL95 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5081) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)T995 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5043) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5082) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5049) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)T975 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5047) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5059) CALL DPWRST('XXX','WRIT') C C STEP 4: END THE TABLE AND RESET ASIS MODE C 5091 FORMAT('
    ') 5047 FORMAT(' ') 5051 FORMAT(' ',G15.7) 5053 FORMAT(' ',I8) 5055 FORMAT(' ',A8) 5056 FORMAT('  ') 5059 FORMAT('
    ') 5093 FORMAT('
') WRITE(ICOUT,5091) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5093) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') ENDIF C C STEP 2: START TABLE AND DEFINE A CAPTION C IF(IYATOS.EQ.'3'.OR.IYATOS.EQ.'13'.OR.IYATOS.EQ.'23'.OR. 1 IYATOS.EQ.'123')THEN 5101 FORMAT('

') 5111 FORMAT('
    ') 5113 FORMAT('') 5115 FORMAT(' ') WRITE(ICOUT,5101) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5111) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5113) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5115) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5117) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5119) CALL DPWRST('XXX','WRIT') C C STEP 3: DEFINE HEADER ROW C 5121 FORMAT(' ') 5122 FORMAT(' ') 5124 FORMAT(' Identifier') 5125 FORMAT(' Effect
    Estimate') 5126 FORMAT(' t
    Value') 5127 FORMAT(' RESSD:
    Mean + Term') 5128 FORMAT(' RESSD:
    Mean +
    Cumulative Term') 5137 FORMAT(' ') 5138 FORMAT(' ') 5143 FORMAT(' ') 5151 FORMAT(' ',F14.5) 5152 FORMAT(' ',F11.5) 5153 FORMAT(' Mean') 5154 FORMAT('  ') 5155 FORMAT(' ',I8) 5157 FORMAT(' ',A12) 5158 FORMAT(' ',F13.1) 5159 FORMAT(' ') C WRITE(ICOUT,5141) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5153) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5151)GMEAN CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5154) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)RSDCOE(1) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)RSDCOE(1) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5159) CALL DPWRST('XXX','WRIT') C ITAGCO(1)=0 TCOEF(1)=-999.99 IF(SDGMEA.GT.0.0)TCOEF(1)=GMEAN/SDGMEA IFLAG(1)=0 WRITE(IOUNI2,7433)ITAGCO(1),GMEAN,SDGMEA,RSDCOE(1),RSDCOE(1) C DO5180I=2,NMEAN I2=AINDE2(I)+0.5 IF(CCUTP.LT.CPUMAX.AND. 1 CCUTN.LE.COEF(I2).AND.COEF(I2).LE.CCUTP)GOTO5180 IF(TCUTP.LT.CPUMAX.AND. 1 TCUTN.LE.TCOEF(I2).AND.TCOEF(I2).LE.TCUTP)GOTO5180 IF(RCUTP.LT.CPUMAX.AND. 1 RCUTN.LE.RSDCOC(I2).AND.RSDCOC(I2).LE.RCUTP)GOTO5180 C STAR2='  ' IF(IFLAG(I2).EQ.1)STAR2='*' IF(IFLAG(I2).EQ.2)STAR2='**' STAR=' ' IF(IFLAG(I2).EQ.1)STAR2='*' IF(IFLAG(I2).EQ.2)STAR2='**' C WRITE(ICOUT,5141) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5155)ITAGCO(I2) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5151)COEF(I2) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5158)TCOEF(I2) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5157)STAR2 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)RSDCOE(I2) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5143) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5152)RSDCOC(I2) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5159) CALL DPWRST('XXX','WRIT') C WRITE(IOUNI1,7443)ITAGCO(I2),COEF(I2),TCOEF(I2), 1 RSDCOE(I2),RSDCOC(I2) WRITE(IOUNI2,7443)ITAGCO(I2),COEF(I2),TCOEF(I2), 1 RSDCOE(I2),RSDCOC(I2) C 5180 CONTINUE C C STEP 4: END THE TABLE AND RESET ASIS MODE C 5191 FORMAT('
    ') 5117 FORMAT(' Estimation for Yates Fit') 5119 FORMAT('
    ') 5123 FORMAT('
    ') 5139 FORMAT('
    ') WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5122) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5124) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5122) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5125) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5122) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5126) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5122) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5127) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5122) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5128) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5123) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5137) CALL DPWRST('XXX','WRIT') C C FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES C WRITE(ICOUT,5121) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5138) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5139) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5147) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5137) CALL DPWRST('XXX','WRIT') C C STEP 4: DEFINE DATA ROW C 5141 FORMAT('
    ') 5147 FORMAT('
    ') 5193 FORMAT('
') 5199 FORMAT('
')
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5199)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8005 FORMAT('{',A1,'bf 2$^k$ DEX FIT}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IYATOS.EQ.'1'.OR.IYATOS.EQ.'12'.OR.IYATOS.EQ.'13'.OR.
     1    IYATOS.EQ.'123')THEN
          WRITE(ICOUT,8003)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8005)IBASLC
          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,999)
          CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Number of Factors: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'No Replication Case: & ',2X,A1,A1)
 8024 FORMAT(5X,'Replication Case: & ',2X,A1,A1)
 8025 FORMAT(5X,'Replication Standard Deviation: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Degrees of Freedom: & ',I8,2X,A1,A1)
 8027 FORMAT(5X,'Psuedo-Replication Standard Deviation: & ',G15.7,
     1       2X,A1,A1)
 8028 FORMAT(5X,'Psuedo-Degrees of Freedom: & ',I8,2X,A1,A1)
 8029 FORMAT(5X,'(The Psuedo-Replication Standard Deviation & ',
     1       2X,A1,A1)
 8030 FORMAT(5X,'assumes all 3, 4, 5, and higher level & ',2X,A1,A1)
 8031 FORMAT(5X,'interaction terms are not real, but are & ',2X,A1,A1)
 8032 FORMAT(5X,'manifestations of random error) & ',2X,A1,A1)
 8033 FORMAT(5X,'Standard Deviation of a Coefficient: & ',
     1       G15.7,2X,A1,A1)
 8034 FORMAT(5X,'(based on psuedo-replication standard deviation) & ',
     1       2X,A1,A1)
 8035 FORMAT(5X,'(based on replication standard deviation) & ',
     1       2X,A1,A1)
 8036 FORMAT(5X,'Grand Mean: & ',G15.7,2X,A1,A1)
 8037 FORMAT(5X,'Grand Standard Deviation: & ',G15.7,2X,A1,A1)
 8038 FORMAT(5X,'99',A1,'% Confidence Limits ($',A1,'pm$): & ',
     1       G15.7,2X,A1,A1)
 8039 FORMAT(5X,'95',A1,'% Confidence Limits ($',A1,'pm$): & ',
     1       G15.7,2X,A1,A1)
 8040 FORMAT(5X,'99.5',A1,'% Point of the t Distribution: & ',
     1       G15.7,2X,A1,A1)
 8041 FORMAT(5X,'97.5',A1,'% Point of the t Distribution: & ',
     1       G15.7,2X,A1,A1)
 8042 FORMAT(5X,'{',A1,'bf Note}--Data Must be in Standard Order: & ',
     1       2X,A1,A1)
 8045 FORMAT(5X,' & ',2X,A1,A1)
 8049 FORMAT(A1,'end{tabular}')
          WRITE(ICOUT,8009)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8020)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8042)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8021)N,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8022)NUMFAC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(IREP.EQ.'NO')THEN
            WRITE(ICOUT,8023)IBASLC,IBASLC
          ELSE
            WRITE(ICOUT,8024)IBASLC,IBASLC
          ENDIF
          IF(IREP.EQ.'YES')THEN
            WRITE(ICOUT,8025)REPSD,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,8026)IREPDF,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,8027)PRESSD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8028)IPRESD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8029)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8030)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8031)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8032)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8045)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(IREP.EQ.'NO')THEN
            WRITE(ICOUT,8033)SDCOEP,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,8034)IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
          ELSE
            WRITE(ICOUT,8033)SDCOER,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,8035)IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,8045)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8036)GMEAN,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8037)GSD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8045)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8038)IBASLC,IBASLC,CL99,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8039)IBASLC,IBASLC,CL95,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8040)IBASLC,T995,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8041)IBASLC,T975,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8049)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
          WRITE(ICOUT,8091)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8093)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IYATOS.EQ.'3'.OR.IYATOS.EQ.'13'.OR.IYATOS.EQ.'23'.OR.
     1     IYATOS.EQ.'123')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8103 FORMAT(A1,'begin{table}')
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Estimation for Yates Fit}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
          WRITE(ICOUT,8103)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8109)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8111)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8113)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120     FORMAT(5X,A1,'begin{tabular} {rrrrr}')
 8121     FORMAT(5X,' & & & & {',A1,'bf RESSD:} ',
     1           2X,A1,A1)
 8122     FORMAT(5X,' & {',A1,'bf Effect} & {',A1,'bf t} & {',A1,
     1           'bf RESSD:} & {',A1,'bf Mean +} ',
     1           2X,A1,A1)
 8123     FORMAT(5X,'{',A1,'bf Identifier} & {',A1,'bf Estimate} & {',
     1           A1,'bf value} & {',A1,'bf Mean +} & {',A1,
     1           'bf Cumulative Term} ',2X,A1,A1)
 8124     FORMAT(5X,' MEAN & ',F14.5,' &  & ',F11.5,' & ',F11.5,
     1           2X,A1,A1)
 8125     FORMAT(5X,I8,' & ',F14.5,' & ',F13.1,'* & ',F11.5,' & ',
     1           F11.5,2X,A1,A1)
 8126     FORMAT(5X,I8,' & ',F14.5,' & ',F13.1,'** & ',F11.5,' & ',
     1           F11.5,2X,A1,A1)
 8127     FORMAT(5X,I8,' & ',F14.5,' & ',F13.1,A1,'space ',
     1           A1,'space & ',F11.5,' & ',F11.5,2X,A1,A1)
 8148     FORMAT(5X,A1,'hline')
 8149     FORMAT(A1,'end{tabular}')
C
          WRITE(ICOUT,8109)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8120)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C  HEADER ROWS
C
          WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8123)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8148)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C  DATA ROWS
C
          WRITE(ICOUT,8124)GMEAN,RSDCOE(1),RSDCOE(1),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
C
          ITAGCO(1)=0
          TCOEF(1)=-999.99
          IF(SDGMEA.GT.0.0)TCOEF(1)=GMEAN/SDGMEA
          IFLAG(1)=0
          WRITE(IOUNI2,7433)ITAGCO(1),GMEAN,SDGMEA,RSDCOE(1),RSDCOE(1)
C
          DO8180I=2,NMEAN
            I2=AINDE2(I)+0.5
            IF(CCUTP.LT.CPUMAX.AND.
     1         CCUTN.LE.COEF(I2).AND.COEF(I2).LE.CCUTP)GOTO8180
            IF(TCUTP.LT.CPUMAX.AND.
     1         TCUTN.LE.TCOEF(I2).AND.TCOEF(I2).LE.TCUTP)GOTO8180
            IF(RCUTP.LT.CPUMAX.AND.
     1         RCUTN.LE.RSDCOC(I2).AND.RSDCOC(I2).LE.RCUTP)GOTO8180
C
            IF(IFLAG(I2).EQ.1)THEN
              WRITE(ICOUT,8125)ITAGCO(I2),COEF(I2),TCOEF(I2),
     1                         RSDCOE(I2),RSDCOC(I2),IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSEIF(IFLAG(I2).EQ.2)THEN
              WRITE(ICOUT,8126)ITAGCO(I2),COEF(I2),TCOEF(I2),
     1                         RSDCOE(I2),RSDCOC(I2),IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSE
              WRITE(ICOUT,8127)ITAGCO(I2),COEF(I2),TCOEF(I2),
     1                         IBASLC,IBASLC,
     1                         RSDCOE(I2),RSDCOC(I2),IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ENDIF
C
            WRITE(IOUNI1,7443)ITAGCO(I2),COEF(I2),TCOEF(I2),
     1                        RSDCOE(I2),RSDCOC(I2)
            WRITE(IOUNI2,7443)ITAGCO(I2),COEF(I2),TCOEF(I2),
     1                     RSDCOE(I2),RSDCOC(I2)
C
 8180     CONTINUE
C
          WRITE(ICOUT,8149)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191     FORMAT(A1,'end{center}')
 8193     FORMAT(A1,'end{table}')
 8199     FORMAT(A1,'begin{verbatim}')
          WRITE(ICOUT,8191)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8193)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8199)IBASLC
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'RTF' .AND. ICAPTY.EQ.'ON')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7101)
 7101   FORMAT('                *****************************')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7102)
        CALL DPWRST('XXX','BUG ')
CCCCC   THE FOLLOWING LINE WAS REWORDED JUNE 1989
 7102   FORMAT('                **      2**K DEX FIT       ** ')
        WRITE(ICOUT,7101)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
CCCCC   THE FOLLOWING 2 LINES WERE ADDED JUNE 1989
        WRITE(ICOUT,7112)
 7112   FORMAT('      (NOTE--DATA MUST BE IN STANDARD ORDER)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7113)N
 7113   FORMAT('      NUMBER OF OBSERVATIONS           = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7114)NUMFAC
 7114   FORMAT('      NUMBER OF FACTORS                = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(IREP.EQ.'NO')THEN
          WRITE(ICOUT,7115)
 7115     FORMAT('      NO REPLICATION CASE')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IREP.EQ.'YES')THEN
          WRITE(ICOUT,7116)
 7116     FORMAT('      REPLICATION CASE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(IYATOS.EQ.'1'.OR.IYATOS.EQ.'12'.OR.IYATOS.EQ.'13'.OR.
     1    IYATOS.EQ.'123')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IF(IREP.EQ.'YES')THEN
            WRITE(ICOUT,7123)REPSD
 7123       FORMAT('      REPLICATION STANDARD DEVIATION   = ',E20.11)
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IREP.EQ.'YES')THEN
            WRITE(ICOUT,7124)IREPDF
 7124       FORMAT('      REPLICATION DEGREES OF FREEDOM   = ',I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,7125)PRESSD
 7125     FORMAT('      PSEUDO-REPLICATION STAND. DEV.   = ',E20.11)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7126)IPRESD
 7126     FORMAT('      PSEUDO-DEGREES OF FREEDOM        = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7127)
          CALL DPWRST('XXX','BUG ')
CCCCC     THE FOLLOWING LINE WAS REWORDED JUNE 1989
 7127     FORMAT('      (THE PSEUDO-REP. STAND. DEV. ASSUMES ALL')
          WRITE(ICOUT,7128)
          CALL DPWRST('XXX','BUG ')
CCCCC     THE FOLLOWING LINE WAS REWORDED JUNE 1989
 7128     FORMAT('      3, 4, 5, ...-TERM INTERACTIONS ARE NOT REAL,')
CCCCC     THE FOLLOWING 2 LINES WERE ADDED JUNE 1989
          WRITE(ICOUT,7129)
 7129     FORMAT('      BUT ARE MANIFESTATIONS OF RANDOM ERROR)')
          CALL DPWRST('XXX','BUG ')
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IF(IREP.EQ.'YES')THEN
            WRITE(ICOUT,7131)SDCOER
 7131       FORMAT('      STANDARD DEVIATION OF A COEF.    = ',E20.11)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7132)
 7132       FORMAT('      (BASED ON REPLICATION ST. DEV.)')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IREP.EQ.'NO')THEN
            WRITE(ICOUT,7133)SDCOEP
 7133       FORMAT('      STANDARD DEVIATION OF A COEF.    = ',E20.11)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7134)
 7134       FORMAT('      (BASED ON PSEUDO-REP. ST. DEV.)')
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7211)GMEAN
 7211     FORMAT('      GRAND MEAN                       = ',E20.11)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7212)GSD
 7212     FORMAT('      GRAND STANDARD DEVIATION         = ',E20.11)
          CALL DPWRST('XXX','BUG ')
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7224)CL99
 7224     FORMAT('      99% CONFIDENCE LIMITS (+-)       = ',E20.11)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7223)CL95
 7223     FORMAT('      95% CONFIDENCE LIMITS (+-)       = ',E20.11)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7222)T995
 7222     FORMAT('      99.5% POINT OF T DISTRIBUTION    = ',E20.11)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7221)T975
 7221     FORMAT('      97.5% POINT OF T DISTRIBUTION    = ',E20.11)
          CALL DPWRST('XXX','BUG ')
C
        ENDIF
C
CCCCC THE FOLLOWING LINE WAS ENTERED JUNE 1992 (JJF)
        GOTO7390
CCCCC IF(IYATOS.EQ.'2'.OR.IYATOS.EQ.'12'.OR.IYATOS.EQ.'23'.OR.
CCCCC1IYATOS.EQ.'123')GOTO7300
CCCCC GOTO7390
 7300   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7311)
 7311   FORMAT('                                 EFFECT   ',
     1  '                       ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,17311)
17311   FORMAT('OBSERVATION        IDENTIFIER    ESTIMATE ',
     1  '     T VALUE      RESSD')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7312)
 7312   FORMAT('-----------------------------------------------',
     1  '-------------------')
        CALL DPWRST('XXX','BUG ')
        I=1
        WRITE(ICOUT,7313)YMEAN(I),COEF(I),RSDCOE(I)
 7313   FORMAT(F15.5,'       MEAN',F14.5,9X,6X,F11.5)
        CALL DPWRST('XXX','BUG ')
        DO7320I=2,NMEAN
          IF(CCUTP.LT.CPUMAX.AND.
     1      CCUTN.LE.COEF(I).AND.COEF(I).LE.CCUTP)GOTO7320
          IF(TCUTP.LT.CPUMAX.AND.
     1      TCUTN.LE.TCOEF(I).AND.TCOEF(I).LE.TCUTP)GOTO7320
          STAR='  '
          IF(IFLAG(I).EQ.1)STAR='* '
          IF(IFLAG(I).EQ.2)STAR='**'
          WRITE(ICOUT,7322)YMEAN(I),ITAGCO(I),COEF(I),TCOEF(I),STAR,
     1                     RSDCOE(I)
 7322     FORMAT(F15.5,I11,F14.5,F13.1,A2,F11.5)
          CALL DPWRST('XXX','BUG ')
 7320   CONTINUE
C
 7390   CONTINUE
C
        IF(IYATOS.EQ.'3'.OR.IYATOS.EQ.'13'.OR.IYATOS.EQ.'23'.OR.
     1     IYATOS.EQ.'123')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
C
          WRITE(ICOUT,7411)
 7411     FORMAT('                    EFFECT   ',
     1           '                                   ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,17411)
17411     FORMAT('      IDENTIFIER    ESTIMATE ',
     1           '     T VALUE      RESSD:     RESSD:')
          CALL DPWRST('XXX','BUG ')
C
          WRITE(ICOUT,7412)
 7412     FORMAT(20X,2X,
     1           '                         MEAN +     MEAN +')
          CALL DPWRST('XXX','BUG ')
C
          WRITE(ICOUT,7413)
 7413     FORMAT(20X,2X,
     1           '                         TERM    CUM TERMS')
          CALL DPWRST('XXX','BUG ')
C
          WRITE(ICOUT,7414)
 7414     FORMAT('      -------------------------------',
     1           '---------------------------')
          CALL DPWRST('XXX','BUG ')
C
          WRITE(ICOUT,7431)GMEAN,RSDCOE(1),RSDCOE(1)
 7431     FORMAT(9X,'MEAN',F14.5,13X,2X,F11.5,F11.5)
          CALL DPWRST('XXX','BUG ')
C
          ITAGCO(1)=0
          TCOEF(1)=-999.99
          IF(SDGMEA.GT.0.0)TCOEF(1)=GMEAN/SDGMEA
          IFLAG(1)=0
          WRITE(IOUNI2,7433)ITAGCO(1),GMEAN,SDGMEA,
     1                      RSDCOE(1),RSDCOE(1)
 7433     FORMAT(I9,F14.5,F13.1,'  ',F11.5,F11.5)
C
          DO7440I=2,NMEAN
            I2=AINDE2(I)+0.5
            IF(CCUTP.LT.CPUMAX.AND.
     1         CCUTN.LE.COEF(I2).AND.COEF(I2).LE.CCUTP)GOTO7440
            IF(TCUTP.LT.CPUMAX.AND.
     1         TCUTN.LE.TCOEF(I2).AND.TCOEF(I2).LE.TCUTP)GOTO7440
            IF(RCUTP.LT.CPUMAX.AND.
     1         RCUTN.LE.RSDCOC(I2).AND.RSDCOC(I2).LE.RCUTP)GOTO7440
C
            STAR='  '
            IF(IFLAG(I2).EQ.1)STAR='* '
            IF(IFLAG(I2).EQ.2)STAR='**'
C
            WRITE(ICOUT,7442)ITAGCO(I2),COEF(I2),TCOEF(I2),STAR,
     1                       RSDCOE(I2),RSDCOC(I2)
 7442       FORMAT(4X,I9,F14.5,F13.1,A2,F11.5,F11.5)
            CALL DPWRST('XXX','BUG ')
            WRITE(IOUNI1,7443)ITAGCO(I2),COEF(I2),TCOEF(I2),
     1                        RSDCOE(I2),RSDCOC(I2)
            WRITE(IOUNI2,7443)ITAGCO(I2),COEF(I2),TCOEF(I2),
     1                     RSDCOE(I2),RSDCOC(I2)
 7443       FORMAT(I9,F14.5,F13.1,'  ',F11.5,F11.5)
C
 7440     CONTINUE
         ENDIF
C
       ENDIF
CCCCC  JUNE 2005.  WRITE TO DPST1F.DAT AND DPST2F.DAT IF PRINTING
CCCCC              SWITCH TURNED OFF
       ELSE
         ITAGCO(1)=0
         TCOEF(1)=-999.99
         IF(SDGMEA.GT.0.0)TCOEF(1)=GMEAN/SDGMEA
         IFLAG(1)=0
         WRITE(IOUNI2,7433)ITAGCO(1),GMEAN,SDGMEA,RSDCOE(1),RSDCOE(1)
         DO7940I=2,NMEAN
           I2=AINDE2(I)+0.5
           IF(CCUTP.LT.CPUMAX.AND.
     1        CCUTN.LE.COEF(I2).AND.COEF(I2).LE.CCUTP)GOTO7940
           IF(TCUTP.LT.CPUMAX.AND.
     1        TCUTN.LE.TCOEF(I2).AND.TCOEF(I2).LE.TCUTP)GOTO7940
           IF(RCUTP.LT.CPUMAX.AND.
     1        RCUTN.LE.RSDCOC(I2).AND.RSDCOC(I2).LE.RCUTP)GOTO7940
C
           STAR='  '
           IF(IFLAG(I2).EQ.1)STAR='* '
           IF(IFLAG(I2).EQ.2)STAR='**'
C
           WRITE(IOUNI1,7443)ITAGCO(I2),COEF(I2),TCOEF(I2),
     1                       RSDCOE(I2),RSDCOC(I2)
           WRITE(IOUNI2,7443)ITAGCO(I2),COEF(I2),TCOEF(I2),
     1                       RSDCOE(I2),RSDCOC(I2)
C
 7940    CONTINUE
       ENDIF
C
CCCCC THE FOLLOWING WAS ADDED OCTOBER 1991
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
        WRITE(ICOUT,7711)
 7711   FORMAT('NOTE--TAG, COEF, TCOEF, RESSD, & CUMULATIVE RESSD')
        CALL DPWRST('XXX','BUG ')
C
        WRITE(ICOUT,7712)
 7712   FORMAT('      WERE WRITTEN OUT TO FILES DPST1F.DAT AND ',
     1         'DPST2F.DAT')
        CALL DPWRST('XXX','BUG ')
C
        WRITE(ICOUT,7713)
 7713   FORMAT('      TO READ THESE VARIABLES BACK IN, ENTER   ')
        CALL DPWRST('XXX','BUG ')
C
        WRITE(ICOUT,7714)
 7714   FORMAT('         SKIP 0')
        CALL DPWRST('XXX','BUG ')
C
        WRITE(ICOUT,7715)
 7715   FORMAT('         READ DPST1F.DAT TAG COEF TCOEF RSD CUMRSD')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCCC THE FOLLOWING SECTION WAS ADDED OCTOBER 1991
C               **************************************
C               **  STEP 81--                       **
C               **  CLOSE       THE STORAGE FILES.  **
C               **************************************
C
      ISTEPN='81'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'YAT2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPYAT2--')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,9012)IFOUND,IERROR
C9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NUMREP,IREP,ICASE
 9013 FORMAT('N,NUMREP,IREP,ICASE = ',2I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)GMEAN,GSSQ,GVAR,GSD
 9014 FORMAT('GMEAN,GSSQ,GVAR,GSD = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PRESSD,PRESDF,REPSD,REPDF
 9015 FORMAT('PRESSD,PRESDF,REPSD,REPDF = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)REFDF,REFDF,SDCOEF
 9016 FORMAT('REFDF,REFDF,SDCOEF = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9021I=1,NMEAN
      WRITE(ICOUT,9022)I,YMEAN(I),COEF(I),YVAR(I)
 9022 FORMAT('I,YMEAN(I),COEF(I),YVAR(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
      WRITE(ICOUT,9031)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
 9031 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)CCUTN,CCUTP
 9032 FORMAT('CCUTN,CCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)TCUTN,TCUTP
 9033 FORMAT('TCUTN,TCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)RCUTN,RCUTP
 9034 FORMAT('RCUTN,RCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END