SUBROUTINE DPSUB2(NIOLD,ILOCS,NS,IBUGQ,IERROR) C C NOTE--THIS SUBROUTINE IS IDENTICAL TO THE DPSUB2 SUBROUTINE C AND THE DPSUB3 SUBROUTINE C AND HAS BEEN DUPLICATED TO THEM ONLY FOR ECONOMY OF MAPPING PURPOSES C THAT IS, TO SAVE STORAGE IN THE MAPPING. C FOR VIRTUAL OPERATING SYSTEMS, THIS DUPLICATION IS NEEDLESS. C ANY CALLS TO SUBROUTINES DPSUB2 AND SPSUB3 COULD BE CHANGED C TO CALLS TO DPSUB2. C C PURPOSE--DEFINE AN INTEGER 0-1 VECTOR ISUB C WHICH WILL BE USED IN OTHER SUBROUTINES C FOR EXTRACTING SUBSETS. C NOTE THAT IF THE WORDS SUBSET OR EXCEPT IS NOT C IN THE ARGUMENT LIST, C THEN THE OUTPUT PARAMETER WILL BE SET TO NUMARG+1. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--JANUARY 1978. C UPDATED --JANUARY 1978. C UPDATED --FEBRUARY 1978. C UPDATED --MAY 1978. C UPDATED --OCTOBER 1978. C UPDATED --NOVEMBER 1978. C UPDATED --FEBRUARY 1979. C UPDATED --NOVEMBER 1980. C UPDATED --JANUARY 1981. C UPDATED --JULY 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --DECEMBER 1981. C UPDATED --MARCH 1982. C UPDATED --MAY 1982. C UPDATED --MARCH 1988. ALLOW NOT EQUAL <> >< NOT= C UPDATED --FEBRUARY 1989. SUPPRESS EMPTY SUBSET MESSAGE (ALAN) C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGQ CHARACTER*4 IERROR C CHARACTER*4 ICASSC CHARACTER*4 ICASQU CHARACTER*4 ICASVA CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CHARACTER*4 ICASOP CHARACTER*4 IHSET CHARACTER*4 IHSET2 CHARACTER*4 IH CHARACTER*4 IH2 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='DPSU' ISUBN2='B2 ' C IERROR='NO' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C C ******************************** C ** TREAT THE SUBSET CASE ** C ******************************** C IF(IBUGQ.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)NIOLD,ILOCS,NS 52 FORMAT('NIOLD,ILOCS,NS = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IBUGQ,IERROR 54 FORMAT('IBUGQ,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)NUMARG,NUMNAM,MAXNAM,N,MAXN 55 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)IWIDTH,ILOCS,ILOCS2,ILOCTG 56 FORMAT('IWIDTH,ILOCS,ILOCS2,ILOCTG = ',4I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C **************************************************************** C ** STEP 1-- C ** INITIALIZE THE SUBSET SIZE (NS) TO NIOLD. C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. C ** ALSO CHECK THAT THE RELEVANT NUMBER OF OBSERVATIONS (NIOLD) C ** IS POSITIVE. C **************************************************************** C ISTEPN='1' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NS=NIOLD ILOCS=NUMARG+1 MINNA=0 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2, 1IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IF(NIOLD.GE.1)GOTO190 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,111) 111 FORMAT('***** ERROR IN DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,112) 112 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,113) 113 FORMAT(' (FROM WHICH A SUBSET WAS TO HAVE BEEN ', 1'EXTRACTED)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,114) 114 FORMAT(' IS 0') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 190 CONTINUE C C **************************************************************** C ** STEP 2.1-- C ** INITIALIZE ALL ELEMENTS IN ISUB(.) TO 11 C ** ISUB(.) WILL TAKE ON 4 VALUES AT MOST-- C ** 00, 01, 10, 11 . C ** THE FIRST DIGIT INDICATES WHETHER OR NOT THE GIVEN ELEMENT C ** IS OUT (0) OR IN (1) OF THE LOCAL CUMULATIVE UNION SET. C ** THE SECOND DIGIT INDICATES WHETHER OR NOT THE GIVEN ELEMENT C ** IS OUT (0) OR IN (1) OF THE GLOBAL CUMULATIVE INTERSECTION S C ** THE INITIALIZATION OF ALL ELEMENTS TO 11 C ** THUS INDICATES THAT INITIALLY ALL ELEMENTS (TEMPORARILY) C ** ARE IN THE LOCAL UNION SET, C ** AND INITIALLY ALL ELEMENTS C ** ARE IN THE GLOBAL INTERSECTION SET. C **************************************************************** C ISTEPN='2.1' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C DO200I=1,NIOLD ISUB(I)=11 200 CONTINUE C C ************************************************* C ** STEP 2.2-- ** C ** IF EXISTENT, ** C ** PACK < = INTO <= ** C ** PACK = < INTO =< ** C ** PACK > = INTO >= ** C ** PACK = > INTO => ** C ** THIS IS BECAUSE = SIGNS ARE AUTOMATICALLY ** C ** GIVEN A SPACE IN DPTYPE AND TREATED AS ** C ** AS A SEPARATE WORD. ** C ** NOTE THAT NUMARG WILL BE CHANGED. ** C ************************************************* C ISTEPN='2.2' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL ADJUS2(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) C C ************************************************ C ** STEP 3.1-- ** C ** CHECK TO SEE IF HAVE THE SUBSET CASE. ** C ** CHECK TO SEE IF HAVE THE EXCEPT CASE. ** C ** LOCATE THE POSITION IN THE ARGUMENT LIST ** C ** OF THE WORD SUBSET OR EXCEPT . ** C ************************************************ C ISTEPN='3.1' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C JMAX=0 ICASSC='SEAR' ICASQU='UNKN' NUMSV=0 DO300IPASS=1,100 C IF(IBUGQ.EQ.'OFF')GOTO309 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,301) 301 FORMAT('***** AT THE BEGINNING OF ANOTHER PASS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,302)IPASS,ILOCTG 302 FORMAT('IPASS,ILOCTG = ',2I8) CALL DPWRST('XXX','BUG ') IF(ILOCTG.GE.1) 1WRITE(ICOUT,303)ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG) 303 FORMAT('ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG) = ', 1A4,I8,2X,A4,2X,A4) IF(ILOCTG.GE.1) 1CALL DPWRST('XXX','BUG ') WRITE(ICOUT,304)JMAX 304 FORMAT('JMAX= ',I8) CALL DPWRST('XXX','BUG ') 309 CONTINUE C IF(ICASSC.EQ.'STOP')GOTO1100 JMIN=JMAX+1 IF(JMIN.GT.NUMARG)GOTO1100 IF(JMIN.EQ.NUMARG.AND.IHARG(JMIN).EQ.'AND '.AND. 1IHARG2(JMIN).EQ.' ')GOTO1100 C IF(ICASSC.EQ.'CONT')GOTO600 DO310I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=00 IF(ITEMP.EQ.11)ISUB(I)=11 310 CONTINUE ICASQU='UNKN' DO340J=JMIN,NUMARG J2=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ')GOTO350 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ')GOTO360 340 CONTINUE ILOCS=NUMARG+1 GOTO1100 C 350 CONTINUE ICASQU='SUBS' ILOCS=J2 CCCCC THE FOLLOWING 6 LINES WERE INSERTED MARCH 1988. ILOCS2=ILOCS+2 IHSET=IHARG(ILOCS2) IHSET2=IHARG2(ILOCS2) IF(IHSET.EQ.'<> ')ICASQU='EXCE' IF(IHSET.EQ.'>< ')ICASQU='EXCE' IF(IHSET.EQ.'NOT=')ICASQU='EXCE' GOTO390 C 360 CONTINUE ICASQU='EXCE' ILOCS=J2 GOTO390 C 390 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,391)IPASS,ICASQU,ILOCS 391 FORMAT('IPASS,ICASQU,ILOCS = ',I8,2X,A4,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C ******************************************* C ** STEP 3.2-- ** C ** IF HAVE THE SUBSET CASE, ** C ** INITIALIZE ISUB(.) TO 0X--00 OR 01. ** C ** IF HAVE THE EXCEPT CASE, ** C ** INITIALIZE ISUB(.) TO 1X--10 OR 11. ** C ******************************************* C ISTEPN='3.2' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASQU.EQ.'SUBS')GOTO400 GOTO405 C 400 CONTINUE DO401I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 401 CONTINUE GOTO409 C 405 CONTINUE DO406I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 406 CONTINUE GOTO409 C 409 CONTINUE C C ******************************************************** C ** STEP 4-- ** C ** CHECK VALIDITY OF FIRST ARGUMENT AFTER SUBSET ** C ** OR EXCEPT . ** C ** THIS SHOULD BE THE SUBSET VARIABLE ** C ** OR THE DUMMY INDEX I . ** C ******************************************************** C ISTEPN='4' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASVA='UNKN' ILOCS1=ILOCS+1 JMAX=ILOCS1 IF(ILOCS1.LE.NUMARG)GOTO429 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,411) 411 FORMAT('***** ERROR IN DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,412) 412 FORMAT(' THE WORD SUBSET OR EXCEPT WAS THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,413) 413 FORMAT(' FINAL WORD ON THE COMMAND LINE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,414) 414 FORMAT(' THE WORD SUBSET OR EXCEPT SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,415) 415 FORMAT(' BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,416) 416 FORMAT(' SUBSET X = 4') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,417) 417 FORMAT(' SUBSET X = 4 7 9 15 22') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,418) 418 FORMAT(' SUBSET X = 4 TO 10') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,419) 419 FORMAT(' SUBSET X >= 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,420) 420 FORMAT(' AND SO FORTH.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,421) 421 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,422)(IANS(I),I=1,IWIDTH) 422 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 429 CONTINUE C IHSET=IHARG(ILOCS1) IHSET2=IHARG2(ILOCS1) C IF(IHSET.EQ.'I '.AND.IHSET2.EQ.' ')GOTO430 GOTO440 C 430 CONTINUE ICASVA='I ' IF(NUMNAM.LE.0)GOTO490 DO435I=1,NUMNAM IF(IHNAME(I).EQ.IHSET.AND.IHNAM2(I).EQ.IHSET2.AND. 1IUSE(I).EQ.'V ')GOTO440 435 CONTINUE GOTO490 C 440 CONTINUE ICASVA='V ' 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')GOTO9000 ISETV=IVALUE(ILOC) IF(IBUGQ.EQ.'ON')WRITE(ICOUT,451)ILOCS1,IHSET,IHSET2,ISETV 451 FORMAT('ILOCS1,IHSET,IHSET2,ISETV = ',I8,3X,2A4,3X,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') GOTO490 C 490 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,491)IPASS,IHSET,IHSET2,ICASVA,ISETV 491 FORMAT('IPASS,IHSET,IHSET2,ICASVA,ISETV = ', 1I8,2X,A4,2X,A4,2X,A4,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C **************************************************************** C ** STEP 5-- C ** CHECK TO SEE IF NEXT ARGUMENT IS C ** < C ** <= C ** = C ** >= C ** > C ** <> >< NOT= C ** IF NONE OF THE ABOVE, THEN THE ASSUMED OPERATION IS = . C **************************************************************** C ISTEPN='5' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASOP='UNKN' ILOCS2=ILOCS+2 JMAX=ILOCS2 IF(ILOCS2.LE.NUMARG)GOTO529 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,501) 501 FORMAT('***** ERROR IN DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,502) 502 FORMAT(' THE SUBSET/EXCEPT VARIABLE NAME WAS THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,503) 503 FORMAT(' FINAL WORD ON THE COMMAND LINE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,504) 504 FORMAT(' THE SUBSET/EXCEPT VARIABLE NAME SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,505) 505 FORMAT(' BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,506) 506 FORMAT(' SUBSET X = 4') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,507) 507 FORMAT(' SUBSET X = 4 7 9 15 22') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,508) 508 FORMAT(' SUBSET X = 4 TO 10') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,509) 509 FORMAT(' SUBSET X >= 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,510) 510 FORMAT(' AND SO FORTH.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,521) 521 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,522)(IANS(I),I=1,IWIDTH) 522 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 529 CONTINUE C IHSET=IHARG(ILOCS2) IHSET2=IHARG2(ILOCS2) C IF(IHSET.EQ.'< ')GOTO531 IF(IHSET.EQ.'<= ')GOTO532 IF(IHSET.EQ.'=< ')GOTO532 IF(IHSET.EQ.'= ')GOTO533 IF(IHSET.EQ.'>= ')GOTO534 IF(IHSET.EQ.'=> ')GOTO534 IF(IHSET.EQ.'> ')GOTO535 CCCCC THE FOLLOWING 3 LINES WERE INSERTED MARCH 1988. IF(IHSET.EQ.'<> ')GOTO533 IF(IHSET.EQ.'>< ')GOTO533 IF(IHSET.EQ.'NOT=')GOTO533 GOTO536 C 531 CONTINUE ICASOP='< ' ILOCTG=ILOCS2 GOTO590 C 532 CONTINUE ICASOP='<= ' ILOCTG=ILOCS2 GOTO590 C 533 CONTINUE ICASOP='= ' ILOCTG=ILOCS2 GOTO590 C 534 CONTINUE ICASOP='>= ' ILOCTG=ILOCS2 GOTO590 C 535 CONTINUE ICASOP='> ' ILOCTG=ILOCS2 GOTO590 C 536 CONTINUE ICASOP='=ASS' ILOCTG=ILOCS2-1 GOTO590 C 590 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,591)IPASS,IHSET,IHSET2,ICASVA,ICASOP 591 FORMAT('IPASS,IHSET,IHSET2,ICASVA,ICASOP = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C ************************************************************** C ** STEP 6-- ** C ** DETERMINE THE LOWER LIMIT OF THE INTERVAL OF INTEREST. ** C ** THIS IS DONE BY CHECKING THE FIRST (NEXT) ARGUMENT ** C ** IN THE LIST. ** C ** ALSO, FOR THOSE 4 CASES IN WHICH ** C ** ICASOP IS < <= >= > ** C ** DETERMINE THE UPPER LIMIT OF THE INTERVAL OF INTEREST. ** C ************************************************************** C 600 CONTINUE C ISTEPN='6' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGQ.EQ.'OFF')GOTO609 WRITE(ICOUT,601) 601 FORMAT(' AT THE BEGINNING OF STEP 6 IN DPSUB2--') CALL DPWRST('XXX','BUG ') DO605I=1,NIOLD WRITE(ICOUT,606)I,ISUB(I) 606 FORMAT('I,ISUB(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') 605 CONTINUE 609 CONTINUE C ILOCTG=ILOCTG+1 JMAX=ILOCTG IF(ILOCTG.LE.NUMARG)GOTO629 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,611) 611 FORMAT('***** ERROR IN DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,612) 612 FORMAT(' THE SUBSET/EXCEPT OPERATION < <= = >= >') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,613) 613 FORMAT(' WAS THE FINAL WORD ON THE COMMAND LINE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,614) 614 FORMAT(' THE SUBSET/EXCEPT VARIABLE NAME SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,615) 615 FORMAT(' BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,616) 616 FORMAT(' SUBSET X = 4') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,617) 617 FORMAT(' SUBSET X = 4 7 9 15 22') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,618) 618 FORMAT(' SUBSET X = 4 TO 10') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,619) 619 FORMAT(' SUBSET X >= 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,620) 620 FORMAT(' AND SO FORTH.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,621) 621 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,622)(IANS(I),I=1,IWIDTH) 622 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 629 CONTINUE C IF(IARGT(ILOCTG).EQ.'NUMB')GOTO640 IF(IARGT(ILOCTG).EQ.'WORD')GOTO650 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,631) 631 FORMAT('***** INTERNAL ERROR IN DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,632) 632 FORMAT(' AN ARGUMENT TYPE WHICH SHOULD BE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,633) 633 FORMAT(' EITHER A NUMBER OR A WORD, IS NEITHER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,634)IHARG(ILOCTG),IHARG2(ILOCTG) 634 FORMAT(' ARGUMENT = ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,635)ILOCTG 635 FORMAT(' LOCATION IN ARGUMENT LIST = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,636)IARGT(ILOCTG) 636 FORMAT(' ARGUMENT TYPE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,637) 637 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,638)(IANS(I),I=1,IWIDTH) 638 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 640 CONTINUE DMIN=ARG(ILOCTG) DMAX=ARG(ILOCTG) IF(ICASOP.EQ.'= ')GOTO690 IF(ICASOP.EQ.'=ASS')GOTO690 IF(ICASOP.EQ.'< ')DMIN=CPUMIN IF(ICASOP.EQ.'< ')DMAX=ARG(ILOCTG) IF(ICASOP.EQ.'< ')GOTO690 IF(ICASOP.EQ.'<= ')DMIN=CPUMIN IF(ICASOP.EQ.'<= ')DMAX=ARG(ILOCTG) IF(ICASOP.EQ.'<= ')GOTO690 IF(ICASOP.EQ.'>= ')DMIN=ARG(ILOCTG) IF(ICASOP.EQ.'>= ')DMAX=CPUMAX IF(ICASOP.EQ.'>= ')GOTO690 IF(ICASOP.EQ.'> ')DMIN=ARG(ILOCTG) IF(ICASOP.EQ.'> ')DMAX=CPUMAX IF(ICASOP.EQ.'> ')GOTO690 GOTO690 C 650 CONTINUE IH=IHARG(ILOCTG) IH2=IHARG2(ILOCTG) IHWUSE='P' MESSAG='YES' CALL CHECKN(IH,IH2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR) IF(IERROR.EQ.'YES')GOTO9000 DMIN=VALUE(ILOC) DMAX=VALUE(ILOC) IF(ICASOP.EQ.'= ')GOTO690 IF(ICASOP.EQ.'=ASS')GOTO690 IF(ICASOP.EQ.'< ')DMIN=CPUMIN IF(ICASOP.EQ.'< ')DMAX=VALUE(ILOC) IF(ICASOP.EQ.'< ')GOTO690 IF(ICASOP.EQ.'<= ')DMIN=CPUMIN IF(ICASOP.EQ.'<= ')DMAX=VALUE(ILOC) IF(ICASOP.EQ.'<= ')GOTO690 IF(ICASOP.EQ.'>= ')DMIN=VALUE(ILOC) IF(ICASOP.EQ.'>= ')DMAX=CPUMAX IF(ICASOP.EQ.'>= ')GOTO690 IF(ICASOP.EQ.'> ')DMIN=VALUE(ILOC) IF(ICASOP.EQ.'> ')DMAX=CPUMAX IF(ICASOP.EQ.'> ')GOTO690 GOTO690 C 690 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,691)IPASS,ICASVA,ICASOP,IH,IH2,DMIN, 1DMAX 691 FORMAT('IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4,2E15.7) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C **************************************************************** C ** STEP 7-- C ** DETERMINE THE UPPER LIMIT OF THE INTERVAL OF INTEREST. C ** NOTE THAT FOR THOSE 4 CASES IN WHICH C ** ICASOP IS < <= >= > ** C ** THE UPPER LIMIT OF THE INTERVAL ** C ** HAS ALREADY BEEN DETERMINED AND SO ** C ** ALL OF THE CODE OF THIS SECTION MAY BE SKIPPED. C ** ON THE OTHER HAND WHEN THE OPERATION IS = , C ** (EXPLICITLY OR ASSUMED), ** C ** THE UPPER LIMIT MUST BE DETERMINED. C ** THIS IS DONE BY CHECKING THE NEXT ARGUMENT C ** IN THE LIST. C ** IF THIS NEXT ARGUMENT IS TO , C ** THIS IMPLIES THAT AN UPPER LIMIT WILL BE PROVIDED C ** (IN THE ARGUMENT AFTER THE TO ). C ** HOWEVER, IF THE NEXT ARGUMENT IS NOT A TO , C ** THEN THIS IMPLIES THAT THE LIST CONSISTS C ** OF INDIVIDUAL ELEMENTS OF THE SUBSET C ** AND SO THE UPPER LIMIT WILL BE IDENTICAL C ** TO THE LOWER LIMIT. C **************************************************************** C 700 CONTINUE C ISTEPN='7' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASOP.EQ.'< ')ICASSC='SEAR' IF(ICASOP.EQ.'< ')GOTO790 IF(ICASOP.EQ.'<= ')ICASSC='SEAR' IF(ICASOP.EQ.'<= ')GOTO790 IF(ICASOP.EQ.'>= ')ICASSC='SEAR' IF(ICASOP.EQ.'>= ')GOTO790 IF(ICASOP.EQ.'> ')ICASSC='SEAR' IF(ICASOP.EQ.'> ')GOTO790 C ILOCTG=ILOCTG+1 C IF(ILOCTG.GT.NUMARG)GOTO710 IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO710 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND. 1IHARG2(ILOCTG).EQ.'ET ')GOTO720 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND. 1IHARG2(ILOCTG).EQ.'PT ')GOTO720 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO750 GOTO730 C 710 CONTINUE ILOCTG=ILOCTG-1 JMAX=ILOCTG ICASSC='STOP' DMAX=DMIN GOTO790 C 720 CONTINUE ILOCTG=ILOCTG-1 JMAX=ILOCTG ICASSC='SEAR' DMAX=DMIN GOTO790 C 730 CONTINUE ILOCTG=ILOCTG-1 JMAX=ILOCTG ICASSC='CONT' DMAX=DMIN GOTO790 C 750 CONTINUE ILOCTG=ILOCTG+1 JMAX=ILOCTG IF(ILOCTG.GT.NUMARG)GOTO760 IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO760 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND. 1IHARG2(ILOCTG).EQ.'ET ')GOTO760 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND. 1IHARG2(ILOCTG).EQ.'PT ')GOTO760 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO760 GOTO770 C 760 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,761) 761 FORMAT('***** ERROR IN DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,762) 762 FORMAT(' THE WORD TO SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,763) 763 FORMAT(' BEEN FOLLOWED BY A NUMBER OR') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,764) 764 FORMAT(' BY A PARAMETER NAME, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,765)IHARG(ILOCTG),IHARG2(ILOCTG) 765 FORMAT(' TO WAS FOLLOWED BY THE WORD ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,766) 766 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,767)(IANS(I),I=1,IWIDTH) 767 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 770 CONTINUE IF(IARGT(ILOCTG).EQ.'NUMB')GOTO775 IF(IARGT(ILOCTG).EQ.'WORD')GOTO776 C IBRAN=770 WRITE(ICOUT,771)IBRAN CALL DPWRST('XXX','BUG ') WRITE(ICOUT,772)ILOCTG,IARGT(ILOCTG) 771 FORMAT('***** INTERNAL ERROR IN DPSUB2--', 1'IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ',I8) CALL DPWRST('XXX','BUG ') 772 FORMAT('ILOCTG, IARGT(ILOCTG) = ',I8,2X,A4) IERROR='YES' GOTO9000 C 775 CONTINUE DMAX=ARG(ILOCTG) GOTO780 C 776 CONTINUE IH=IHARG(ILOCTG) IH2=IHARG2(ILOCTG) IHWUSE='P' MESSAG='YES' CALL CHECKN(IH,IH2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR) IF(IERROR.EQ.'YES')GOTO9000 DMAX=VALUE(ILOC) GOTO780 C 780 CONTINUE ILOCTG=ILOCTG+1 ICASSC='CONT' IF(ILOCTG.GT.NUMARG)ICASSC='STOP' IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND. 1IHARG2(ILOCTG).EQ.' ')ICASSC='STOP' IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND. 1IHARG2(ILOCTG).EQ.'ET ')ICASSC='SEAR' IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND. 1IHARG2(ILOCTG).EQ.'PT ')ICASSC='SEAR' ILOCTG=ILOCTG-1 JMAX=ILOCTG C 790 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,791)IPASS,ICASVA,ICASOP,IH,IH2,DMIN, 1DMAX 791 FORMAT('IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4,2E15.7) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C *************************************************** C ** STEP 8-- ** C ** TO ALLOW FOR ROUNDOFF ERRORS IN THE ** C ** STORAGE OF NUMBERS, ** C ** JUDICIOUSLY EXPAND THE INTERVAL OF INTEREST ** C ** BY AN EPSILON AMOUNT. ** C *************************************************** C ISTEPN='8' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGQ.EQ.'OFF')GOTO804 WRITE(ICOUT,801) 801 FORMAT(' AT THE BEGINNING OF STEP 8--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,802)DMIN,DMAX 802 FORMAT('DMIN,DMAX = ',2E15.7) CALL DPWRST('XXX','BUG ') 804 CONTINUE C IF(DMIN.LE.DMAX)GOTO809 HOLD=DMIN DMIN=DMAX DMAX=HOLD 809 CONTINUE C IF(DMIN.EQ.CPUMIN)GOTO819 IF(DMIN.EQ.CPUMAX)GOTO819 IF(ABS(DMIN).EQ.0.0)EPS=0.000001 IF(ABS(DMIN).NE.0.0)EPS=ABS(DMIN*0.000001) IF(ICASOP.EQ.'= ')DMIN=DMIN-EPS IF(ICASOP.EQ.'=ASS')DMIN=DMIN-EPS IF(ICASOP.EQ.'< ')DMIN=DMIN-EPS IF(ICASOP.EQ.'<= ')DMIN=DMIN-EPS IF(ICASOP.EQ.'>= ')DMIN=DMIN-EPS IF(ICASOP.EQ.'> ')DMIN=DMIN+EPS 819 CONTINUE C IF(DMAX.EQ.CPUMAX)GOTO829 IF(DMAX.EQ.CPUMIN)GOTO829 IF(ABS(DMAX).EQ.0.0)EPS=0.000001 IF(ABS(DMAX).NE.0.0)EPS=ABS(DMAX*0.000001) IF(ICASOP.EQ.'= ')DMAX=DMAX+EPS IF(ICASOP.EQ.'=ASS')DMAX=DMAX+EPS IF(ICASOP.EQ.'< ')DMAX=DMAX-EPS IF(ICASOP.EQ.'<= ')DMAX=DMAX+EPS IF(ICASOP.EQ.'>= ')DMAX=DMAX+EPS IF(ICASOP.EQ.'> ')DMAX=DMAX+EPS 829 CONTINUE C 890 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,891)IPASS,ICASVA,ICASOP,IH,IH2 891 FORMAT('IPASS,ICASVA,ICASOP,IH,IH2 = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') IF(IBUGQ.EQ.'ON')WRITE(ICOUT,892)EPS,DMIN,DMAX,CPUMIN,CPUMAX 892 FORMAT('EPS,DMIN,DMAX,CPUMIN,CPUMAX = ',5E15.7) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C **************************************************** C ** STEP 9-- ** C ** DEFINE THE ISUB(.) VECTOR-- ** C ** FOR ANY K (K = 1 TO NIOLD), ** C ** IF THE K-TH ELEMENT OF THE ** C ** SUBSET SPECIFICATION VARIABLE ** C ** (THE VARIABLE SPECIFIED AFTER SUBSET ** C ** IN THE COMMAND LINE) ** C ** IS WITHIN THE SPECIFIED (DMIN,DMAX) LIMITS, ** C ** THEN ISUB(K) SHOULD RESULT IN A VALUE OF 1; ** C ** BUT IF THE K-TH ELEMENT OF THE ** C ** SUBSET SPECIFICATION VARIABLE ** C ** IS OUTSIDE THE SPECIFIED (DMIN,DMAX) LIMITS, ** C ** THEN ISUB(K) SHOULD RESULT IN A 0 . ** C **************************************************** C ISTEPN='9' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGQ.EQ.'ON')WRITE(ICOUT,901)ILOCS1,IHSET,IHSET2,ICASVA,ISETV, 1MAXCOL 901 FORMAT('ILOCS1,IHSET,IHSET2,ICASVA,ISETV,MAXCOL = ', 1I8,2X,A4,2X,A4,2X,A4,I8,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C IF(ICASVA.EQ.'UNKN')GOTO910 IF(ICASVA.EQ.'I ')GOTO930 IF(ISETV.LE.MAXCOL)GOTO940 IF(ISETV.EQ.MAXCP1)GOTO950 CCCCC IF(ISETV.EQ.MAXCP2)GOTO960 IF(ISETV.EQ.MAXCP2)GOTO950 IF(ISETV.EQ.MAXCP3)GOTO950 IF(ISETV.EQ.MAXCP4)GOTO950 IF(ISETV.EQ.MAXCP5)GOTO950 IF(ISETV.EQ.MAXCP6)GOTO950 C 910 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,911) 911 FORMAT('***** INTERNAL ERROR IN DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,912) 912 FORMAT(' IMPROPER VALUE FOR ICASVA AND/OR ISETV') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,913)ICASVA,ISETV,MAXCOL,MAXCP1,MAXCP2 913 FORMAT(' ICASVA,ISETV,MAXCOL,MAXCP1,MAXCP2 = ',A4,4I8) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 930 CONTINUE NS=0 ND=0 DO931I=1,NIOLD TARGET=I IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO932 IF(ICASQU.EQ.'SUBS')GOTO933 IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO934 IF(ICASQU.EQ.'EXCE')GOTO935 GOTO931 932 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 NS=NS+1 GOTO931 933 CONTINUE ND=ND+1 GOTO931 934 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 ND=ND+1 GOTO931 935 CONTINUE NS=NS+1 GOTO931 931 CONTINUE GOTO990 C 940 CONTINUE NS=0 ND=0 DO941I=1,NIOLD IJ=MAXN*(ISETV-1)+I VIJ=V(IJ) IF(IBUGQ.EQ.'ON')WRITE(9,947)I,NIOLD,ISETV,DMIN,DMAX,VIJ 947 FORMAT('I,NIOLD,ISETV,DMIN,DMAX,VIJ = ', 13I8,3E12.4) TARGET=VIJ IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO942 IF(ICASQU.EQ.'SUBS')GOTO943 IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO944 IF(ICASQU.EQ.'EXCE')GOTO945 GOTO941 942 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 NS=NS+1 GOTO941 943 CONTINUE ND=ND+1 GOTO941 944 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 ND=ND+1 GOTO941 945 CONTINUE NS=NS+1 GOTO941 941 CONTINUE GOTO990 C 950 CONTINUE NS=0 ND=0 DO951I=1,NIOLD CCCCC TARGET=PRED(I) IF(ISETV.EQ.MAXCP1)TARGET=PRED(I) IF(ISETV.EQ.MAXCP2)TARGET=RES(I) IF(ISETV.EQ.MAXCP3)TARGET=YPLOT(I) IF(ISETV.EQ.MAXCP4)TARGET=XPLOT(I) IF(ISETV.EQ.MAXCP5)TARGET=X2PLOT(I) IF(ISETV.EQ.MAXCP6)TARGET=TAGPLO(I) IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO952 IF(ICASQU.EQ.'SUBS')GOTO953 IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO954 IF(ICASQU.EQ.'EXCE')GOTO955 GOTO951 952 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 NS=NS+1 GOTO951 953 CONTINUE ND=ND+1 GOTO951 954 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 ND=ND+1 GOTO951 955 CONTINUE NS=NS+1 GOTO951 951 CONTINUE GOTO990 C CC960 CONTINUE CCCCC NS=0 CCCCC ND=0 CCCCC DO961I=1,NIOLD CCCCC TARGET=RES(I) CCCCC IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) CCCCC1GOTO962 CCCCC IF(ICASQU.EQ.'SUBS')GOTO963 CCCCC IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) CCCCC1GOTO964 CCCCC IF(ICASQU.EQ.'EXCE')GOTO965 CCCCC GOTO961 CC962 CONTINUE CCCCC ITEMP=ISUB(I) CCCCC IF(ITEMP.EQ.00)ISUB(I)=10 CCCCC IF(ITEMP.EQ.10)ISUB(I)=10 CCCCC IF(ITEMP.EQ.01)ISUB(I)=11 CCCCC IF(ITEMP.EQ.11)ISUB(I)=11 CCCCC NS=NS+1 CCCCC GOTO961 CC963 CONTINUE CCCCC ND=ND+1 CCCCC GOTO961 CC964 CONTINUE CCCCC ITEMP=ISUB(I) CCCCC IF(ITEMP.EQ.00)ISUB(I)=00 CCCCC IF(ITEMP.EQ.10)ISUB(I)=00 CCCCC IF(ITEMP.EQ.01)ISUB(I)=01 CCCCC IF(ITEMP.EQ.11)ISUB(I)=01 CCCCC ND=ND+1 CCCCC GOTO961 CC965 CONTINUE CCCCC NS=NS+1 CCCCC GOTO961 CC961 CONTINUE CCCCC GOTO990 C 990 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,991)IPASS,ICASQU,DMIN,DMAX,EPS, 1NIOLD,NS,ND 991 FORMAT('IPASS,ICASQU,DMIN,DMAX,EPS,NIOLD,NS,ND = ', 1I8,2X,A4,3E15.7,3I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') IF(IBUGQ.EQ.'OFF')GOTO994 DO992I=1,NIOLD WRITE(ICOUT,993)I,ISUB(I) 993 FORMAT('I,ISUB(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') 992 CONTINUE 994 CONTINUE C C ************************************************* C ** STEP 10-- ** C ** WRITE OUT A MESSAGE FOR THIS STEP ** C ** INDICATING ** C ** THE SUBSET VARIABLE NAME, ** C ** THE SUBSET MINIMUM, ** C ** THE SUBSET MAXIMUM, ** C ** THE INPUT NUMBER OF OBSERVATIONS (LOCAL), ** C ** THE NUMBER OF OBSERVATIONS IGNORED ** C ** AND THE OUTPUT NUMBER OF OBSERVATIONS ** C ** (THAT IS, THE SUBSET SAMPLE SIZE). ** C ** ALSO, CHECK THAT NS IS POSITIVE. ** C ************************************************* C ISTEPN='10' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASQU.EQ.'EXCE')GOTO1020 GOTO1010 C 1010 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1019 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1011) 1011 FORMAT('***** NOTE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1012)IHARG(ILOCS1),IHARG2(ILOCS1) 1012 FORMAT(' SUBSET VARIABLE = ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1013)DMIN 1013 FORMAT(' SUBSET MINIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1014)DMAX 1014 FORMAT(' SUBSET MAXIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1015)NIOLD 1015 FORMAT(' INPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1016)ND 1016 FORMAT(' NUMBER OF OBSERVATIONS IGNORED = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1017)NS 1017 FORMAT(' OUTPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') 1019 CONTINUE GOTO1050 C 1020 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1029 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1021) 1021 FORMAT('***** NOTE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1022)IHARG(ILOCS1),IHARG2(ILOCS1) 1022 FORMAT(' EXCEPTED SUBSET VARIABLE = ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1023)DMIN 1023 FORMAT(' EXCEPTED SUBSET MINIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1024)DMAX 1024 FORMAT(' EXCEPTED SUBSET MAXIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1025)NIOLD 1025 FORMAT(' INPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1026)ND 1026 FORMAT(' NUMBER OF OBSERVATIONS IGNORED = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1027)NS 1027 FORMAT(' OUTPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') 1029 CONTINUE GOTO1050 C 1050 CONTINUE CCCCC IF(NS.GE.1)GOTO1059 CCCCC WRITE(ICOUT,999) CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,1051) C1051 FORMAT('***** ERROR IN DPSUB2--') CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,1052) C1052 FORMAT(' THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.') CCCCC CALL DPWRST('XXX','BUG ') CCCCC IERROR='YES' CCCCC GOTO9000 C1059 CONTINUE C NUMSV=IPASS C 300 CONTINUE C 1100 CONTINUE DO1110I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=00 IF(ITEMP.EQ.11)ISUB(I)=11 1110 CONTINUE C C ************************************* C ** STEP 11-- ** C ** PUT ISUB(.) IN FINAL 0,1 FORM ** C ************************************* C ISTEPN='11' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C DO1210I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=0 IF(ITEMP.EQ.10)ISUB(I)=0 IF(ITEMP.EQ.01)ISUB(I)=1 IF(ITEMP.EQ.11)ISUB(I)=1 1210 CONTINUE C C ***************************************** C ** STEP 12-- ** C ** IF THERE WERE 2 OR MORE SUBSET ** C ** VARIABLES, GATHER INFORMATION ** C ** FOR A FINAL SUMMARY MESSAGE BY ** C ** DETERMINING THE FINAL NUMBER OF ** C ** ELEMENTS IN THE SUBSET ** C ** (AFTER ALL VARIABLES HAVE ** C ** BEEN INDIVIDUALLY ACCOUNTED FOR). ** C ***************************************** C 1500 CONTINUE C ISTEPN='12' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMSV.LE.1)GOTO1590 NS=0 DO1510I=1,NIOLD IF(ISUB(I).EQ.1)NS=NS+1 1510 CONTINUE 1590 CONTINUE C C ************************************************* C ** STEP 13-- ** C ** IF THERE WERE 2 OR MORE SUBSET VARIABLES, ** C ** WRITE OUT A FINAL MESSAGE ** C ** SUMMARIZING FOR ALL VARIABLES ** C ** THE NUMBER OF SUBSET VARIABLES ** C ** THE INPUT NUMBER OF OBSERVATIONS (LOCAL), ** C ** THE NUMBER OF OBSERVATIONS IGNORED ** C ** AND THE OUTPUT NUMBER OF OBSERVATIONS ** C ** (THAT IS, THE SUBSET SAMPLE SIZE). ** C ** ALSO, CHECK THAT NS IS POSITIVE. ** C ************************************************* C ISTEPN='13' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMSV.LE.1)GOTO1690 ND=NIOLD-NS C IF(IFEEDB.EQ.'OFF')GOTO1609 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1601) 1601 FORMAT('***** SUBSET/EXCEPT SUMMARY--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1602)NUMSV 1602 FORMAT(' NUMBER OF SPECIFICATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1605)NIOLD 1605 FORMAT(' INPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1606)ND 1606 FORMAT(' NUMBER OF OBSERVATIONS IGNORED = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1607)NS 1607 FORMAT(' OUTPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') 1609 CONTINUE C IF(NS.GE.1)GOTO1619 CCCCC THE FOLLOWING LINE WAS INSERTED FEBRUARY 1989 CCCCC TO SUPPRESS ERROR MESSAGE FOR EMPTY SUBSET FEBRUARY 1989 CCCCC UNLESS FEEDBACK SWITCH IS ON FEBRUARY 1989 IF(IFEEDB.EQ.'OFF')GOTO1619 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1611) 1611 FORMAT('***** ERROR IN DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1612) 1612 FORMAT(' THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1619 CONTINUE C 1690 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGQ.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPSUB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)NIOLD,ILOCS,NS 9012 FORMAT('NIOLD,ILOCS,NS = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IBUGQ,IERROR 9014 FORMAT('IBUGQ,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)NUMARG,NUMNAM,MAXNAM,N,MAXN 9015 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',5I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)IWIDTH,ILOCS,ILOCS2,ILOCTG 9016 FORMAT('IWIDTH,ILOCS,ILOCS2,ILOCTG = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)NUMSV,ND 9017 FORMAT('NUMSV,ND = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)ICASQU,ICASVA,ICASOP,ICASSC 9018 FORMAT('ICASQU,ICASVA,ICASOP,ICASSC = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') DO9020I=1,NIOLD WRITE(ICOUT,9021)I,ISUB(I) 9021 FORMAT('I,ISUB(I) = ',2I8) CALL DPWRST('XXX','BUG ') 9020 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPSUB3(NIOLD,ILOCS,NS,IBUGQ,IERROR) C C NOTE--THIS SUBROUTINE IS IDENTICAL TO THE DPSUBS SUBROUTINE C AND THE DPSUB2 SUBROUTINE C AND HAS BEEN DUPLICATED TO THEM ONLY FOR ECONOMY OF MAPPING PURPOSES C THAT IS, TO SAVE STORAGE IN THE MAPPING. C FOR VIRTUAL OPERATING SYSTEMS, THIS DUPLICATION IS NEEDLESS. C ANY CALLS TO SUBROUTINES DPSUB2 AND SPSUB3 COULD BE CHANGED C TO CALLS TO DPSUBS. C C PURPOSE--DEFINE AN INTEGER 0-1 VECTOR ISUB C WHICH WILL BE USED IN OTHER SUBROUTINES C FOR EXTRACTING SUBSETS. C NOTE THAT IF THE WORDS SUBSET OR EXCEPT IS NOT C IN THE ARGUMENT LIST, C THEN THE OUTPUT PARAMETER WILL BE SET TO NUMARG+1. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--JANUARY 1978. C UPDATED --JANUARY 1978. C UPDATED --FEBRUARY 1978. C UPDATED --MAY 1978. C UPDATED --OCTOBER 1978. C UPDATED --NOVEMBER 1978. C UPDATED --FEBRUARY 1979. C UPDATED --NOVEMBER 1980. C UPDATED --JANUARY 1981. C UPDATED --JULY 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --DECEMBER 1981. C UPDATED --MARCH 1982. C UPDATED --MAY 1982. C UPDATED --MARCH 1988. ALLOW NOT EQUAL <> >< NOT= C UPDATED --FEBRUARY 1989. SUPPRESS EMPTY SUBSET MESSAGE (ALAN) C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGQ CHARACTER*4 IERROR C CHARACTER*4 ICASSC CHARACTER*4 ICASQU CHARACTER*4 ICASVA CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CHARACTER*4 ICASOP CHARACTER*4 IHSET CHARACTER*4 IHSET2 CHARACTER*4 IH CHARACTER*4 IH2 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='DPSU' ISUBN2='B3 ' C IERROR='NO' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C C ******************************** C ** TREAT THE SUBSET CASE ** C ******************************** C IF(IBUGQ.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)NIOLD,ILOCS,NS 52 FORMAT('NIOLD,ILOCS,NS = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IBUGQ,IERROR 54 FORMAT('IBUGQ,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)NUMARG,NUMNAM,MAXNAM,N,MAXN 55 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)IWIDTH,ILOCS,ILOCS2,ILOCTG 56 FORMAT('IWIDTH,ILOCS,ILOCS2,ILOCTG = ',4I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C **************************************************************** C ** STEP 1-- C ** INITIALIZE THE SUBSET SIZE (NS) TO NIOLD. C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. C ** ALSO CHECK THAT THE RELEVANT NUMBER OF OBSERVATIONS (NIOLD) C ** IS POSITIVE. C **************************************************************** C ISTEPN='1' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NS=NIOLD ILOCS=NUMARG+1 MINNA=0 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2, 1IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IF(NIOLD.GE.1)GOTO190 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,111) 111 FORMAT('***** ERROR IN DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,112) 112 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,113) 113 FORMAT(' (FROM WHICH A SUBSET WAS TO HAVE BEEN ', 1'EXTRACTED)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,114) 114 FORMAT(' IS 0') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 190 CONTINUE C C **************************************************************** C ** STEP 2.1-- C ** INITIALIZE ALL ELEMENTS IN ISUB(.) TO 11 C ** ISUB(.) WILL TAKE ON 4 VALUES AT MOST-- C ** 00, 01, 10, 11 . C ** THE FIRST DIGIT INDICATES WHETHER OR NOT THE GIVEN ELEMENT C ** IS OUT (0) OR IN (1) OF THE LOCAL CUMULATIVE UNION SET. C ** THE SECOND DIGIT INDICATES WHETHER OR NOT THE GIVEN ELEMENT C ** IS OUT (0) OR IN (1) OF THE GLOBAL CUMULATIVE INTERSECTION S C ** THE INITIALIZATION OF ALL ELEMENTS TO 11 C ** THUS INDICATES THAT INITIALLY ALL ELEMENTS (TEMPORARILY) C ** ARE IN THE LOCAL UNION SET, C ** AND INITIALLY ALL ELEMENTS C ** ARE IN THE GLOBAL INTERSECTION SET. C **************************************************************** C ISTEPN='2.1' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C DO200I=1,NIOLD ISUB(I)=11 200 CONTINUE C C ************************************************* C ** STEP 2.2-- ** C ** IF EXISTENT, ** C ** PACK < = INTO <= ** C ** PACK = < INTO =< ** C ** PACK > = INTO >= ** C ** PACK = > INTO => ** C ** THIS IS BECAUSE = SIGNS ARE AUTOMATICALLY ** C ** GIVEN A SPACE IN DPTYPE AND TREATED AS ** C ** AS A SEPARATE WORD. ** C ** NOTE THAT NUMARG WILL BE CHANGED. ** C ************************************************* C ISTEPN='2.2' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL ADJUS2(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) C C ************************************************ C ** STEP 3.1-- ** C ** CHECK TO SEE IF HAVE THE SUBSET CASE. ** C ** CHECK TO SEE IF HAVE THE EXCEPT CASE. ** C ** LOCATE THE POSITION IN THE ARGUMENT LIST ** C ** OF THE WORD SUBSET OR EXCEPT . ** C ************************************************ C ISTEPN='3.1' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C JMAX=0 ICASSC='SEAR' ICASQU='UNKN' NUMSV=0 DO300IPASS=1,100 C IF(IBUGQ.EQ.'OFF')GOTO309 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,301) 301 FORMAT('***** AT THE BEGINNING OF ANOTHER PASS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,302)IPASS,ILOCTG 302 FORMAT('IPASS,ILOCTG = ',2I8) CALL DPWRST('XXX','BUG ') IF(ILOCTG.GE.1) 1WRITE(ICOUT,303)ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG) 303 FORMAT('ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG) = ', 1A4,I8,2X,A4,2X,A4) IF(ILOCTG.GE.1) 1CALL DPWRST('XXX','BUG ') WRITE(ICOUT,304)JMAX 304 FORMAT('JMAX= ',I8) CALL DPWRST('XXX','BUG ') 309 CONTINUE C IF(ICASSC.EQ.'STOP')GOTO1100 JMIN=JMAX+1 IF(JMIN.GT.NUMARG)GOTO1100 IF(JMIN.EQ.NUMARG.AND.IHARG(JMIN).EQ.'AND '.AND. 1IHARG2(JMIN).EQ.' ')GOTO1100 C IF(ICASSC.EQ.'CONT')GOTO600 DO310I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=00 IF(ITEMP.EQ.11)ISUB(I)=11 310 CONTINUE ICASQU='UNKN' DO340J=JMIN,NUMARG J2=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ')GOTO350 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ')GOTO360 340 CONTINUE ILOCS=NUMARG+1 GOTO1100 C 350 CONTINUE ICASQU='SUBS' ILOCS=J2 CCCCC THE FOLLOWING 6 LINES WERE INSERTED MARCH 1988. ILOCS2=ILOCS+2 IHSET=IHARG(ILOCS2) IHSET2=IHARG2(ILOCS2) IF(IHSET.EQ.'<> ')ICASQU='EXCE' IF(IHSET.EQ.'>< ')ICASQU='EXCE' IF(IHSET.EQ.'NOT=')ICASQU='EXCE' GOTO390 C 360 CONTINUE ICASQU='EXCE' ILOCS=J2 GOTO390 C 390 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,391)IPASS,ICASQU,ILOCS 391 FORMAT('IPASS,ICASQU,ILOCS = ',I8,2X,A4,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C ******************************************* C ** STEP 3.2-- ** C ** IF HAVE THE SUBSET CASE, ** C ** INITIALIZE ISUB(.) TO 0X--00 OR 01. ** C ** IF HAVE THE EXCEPT CASE, ** C ** INITIALIZE ISUB(.) TO 1X--10 OR 11. ** C ******************************************* C ISTEPN='3.2' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASQU.EQ.'SUBS')GOTO400 GOTO405 C 400 CONTINUE DO401I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 401 CONTINUE GOTO409 C 405 CONTINUE DO406I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 406 CONTINUE GOTO409 C 409 CONTINUE C C ******************************************************** C ** STEP 4-- ** C ** CHECK VALIDITY OF FIRST ARGUMENT AFTER SUBSET ** C ** OR EXCEPT . ** C ** THIS SHOULD BE THE SUBSET VARIABLE ** C ** OR THE DUMMY INDEX I . ** C ******************************************************** C ISTEPN='4' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASVA='UNKN' ILOCS1=ILOCS+1 JMAX=ILOCS1 IF(ILOCS1.LE.NUMARG)GOTO429 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,411) 411 FORMAT('***** ERROR IN DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,412) 412 FORMAT(' THE WORD SUBSET OR EXCEPT WAS THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,413) 413 FORMAT(' FINAL WORD ON THE COMMAND LINE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,414) 414 FORMAT(' THE WORD SUBSET OR EXCEPT SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,415) 415 FORMAT(' BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,416) 416 FORMAT(' SUBSET X = 4') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,417) 417 FORMAT(' SUBSET X = 4 7 9 15 22') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,418) 418 FORMAT(' SUBSET X = 4 TO 10') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,419) 419 FORMAT(' SUBSET X >= 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,420) 420 FORMAT(' AND SO FORTH.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,421) 421 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,422)(IANS(I),I=1,IWIDTH) 422 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 429 CONTINUE C IHSET=IHARG(ILOCS1) IHSET2=IHARG2(ILOCS1) C IF(IHSET.EQ.'I '.AND.IHSET2.EQ.' ')GOTO430 GOTO440 C 430 CONTINUE ICASVA='I ' IF(NUMNAM.LE.0)GOTO490 DO435I=1,NUMNAM IF(IHNAME(I).EQ.IHSET.AND.IHNAM2(I).EQ.IHSET2.AND. 1IUSE(I).EQ.'V ')GOTO440 435 CONTINUE GOTO490 C 440 CONTINUE ICASVA='V ' 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')GOTO9000 ISETV=IVALUE(ILOC) IF(IBUGQ.EQ.'ON')WRITE(ICOUT,451)ILOCS1,IHSET,IHSET2,ISETV 451 FORMAT('ILOCS1,IHSET,IHSET2,ISETV = ',I8,3X,2A4,3X,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') GOTO490 C 490 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,491)IPASS,IHSET,IHSET2,ICASVA,ISETV 491 FORMAT('IPASS,IHSET,IHSET2,ICASVA,ISETV = ', 1I8,2X,A4,2X,A4,2X,A4,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C **************************************************************** C ** STEP 5-- C ** CHECK TO SEE IF NEXT ARGUMENT IS C ** < C ** <= C ** = C ** >= C ** > C ** <> >< NOT= C ** IF NONE OF THE ABOVE, THEN THE ASSUMED OPERATION IS = . C **************************************************************** C ISTEPN='5' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASOP='UNKN' ILOCS2=ILOCS+2 JMAX=ILOCS2 IF(ILOCS2.LE.NUMARG)GOTO529 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,501) 501 FORMAT('***** ERROR IN DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,502) 502 FORMAT(' THE SUBSET/EXCEPT VARIABLE NAME WAS THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,503) 503 FORMAT(' FINAL WORD ON THE COMMAND LINE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,504) 504 FORMAT(' THE SUBSET/EXCEPT VARIABLE NAME SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,505) 505 FORMAT(' BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,506) 506 FORMAT(' SUBSET X = 4') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,507) 507 FORMAT(' SUBSET X = 4 7 9 15 22') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,508) 508 FORMAT(' SUBSET X = 4 TO 10') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,509) 509 FORMAT(' SUBSET X >= 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,510) 510 FORMAT(' AND SO FORTH.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,521) 521 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,522)(IANS(I),I=1,IWIDTH) 522 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 529 CONTINUE C IHSET=IHARG(ILOCS2) IHSET2=IHARG2(ILOCS2) C IF(IHSET.EQ.'< ')GOTO531 IF(IHSET.EQ.'<= ')GOTO532 IF(IHSET.EQ.'=< ')GOTO532 IF(IHSET.EQ.'= ')GOTO533 IF(IHSET.EQ.'>= ')GOTO534 IF(IHSET.EQ.'=> ')GOTO534 IF(IHSET.EQ.'> ')GOTO535 CCCCC THE FOLLOWING 3 LINES WERE INSERTED MARCH 1988. IF(IHSET.EQ.'<> ')GOTO533 IF(IHSET.EQ.'>< ')GOTO533 IF(IHSET.EQ.'NOT=')GOTO533 GOTO536 C 531 CONTINUE ICASOP='< ' ILOCTG=ILOCS2 GOTO590 C 532 CONTINUE ICASOP='<= ' ILOCTG=ILOCS2 GOTO590 C 533 CONTINUE ICASOP='= ' ILOCTG=ILOCS2 GOTO590 C 534 CONTINUE ICASOP='>= ' ILOCTG=ILOCS2 GOTO590 C 535 CONTINUE ICASOP='> ' ILOCTG=ILOCS2 GOTO590 C 536 CONTINUE ICASOP='=ASS' ILOCTG=ILOCS2-1 GOTO590 C 590 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,591)IPASS,IHSET,IHSET2,ICASVA,ICASOP 591 FORMAT('IPASS,IHSET,IHSET2,ICASVA,ICASOP = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C ************************************************************** C ** STEP 6-- ** C ** DETERMINE THE LOWER LIMIT OF THE INTERVAL OF INTEREST. ** C ** THIS IS DONE BY CHECKING THE FIRST (NEXT) ARGUMENT ** C ** IN THE LIST. ** C ** ALSO, FOR THOSE 4 CASES IN WHICH ** C ** ICASOP IS < <= >= > ** C ** DETERMINE THE UPPER LIMIT OF THE INTERVAL OF INTEREST. ** C ************************************************************** C 600 CONTINUE C ISTEPN='6' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGQ.EQ.'OFF')GOTO609 WRITE(ICOUT,601) 601 FORMAT(' AT THE BEGINNING OF STEP 6 IN DPSUB3--') CALL DPWRST('XXX','BUG ') DO605I=1,NIOLD WRITE(ICOUT,606)I,ISUB(I) 606 FORMAT('I,ISUB(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') 605 CONTINUE 609 CONTINUE C ILOCTG=ILOCTG+1 JMAX=ILOCTG IF(ILOCTG.LE.NUMARG)GOTO629 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,611) 611 FORMAT('***** ERROR IN DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,612) 612 FORMAT(' THE SUBSET/EXCEPT OPERATION < <= = >= >') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,613) 613 FORMAT(' WAS THE FINAL WORD ON THE COMMAND LINE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,614) 614 FORMAT(' THE SUBSET/EXCEPT VARIABLE NAME SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,615) 615 FORMAT(' BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,616) 616 FORMAT(' SUBSET X = 4') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,617) 617 FORMAT(' SUBSET X = 4 7 9 15 22') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,618) 618 FORMAT(' SUBSET X = 4 TO 10') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,619) 619 FORMAT(' SUBSET X >= 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,620) 620 FORMAT(' AND SO FORTH.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,621) 621 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,622)(IANS(I),I=1,IWIDTH) 622 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 629 CONTINUE C IF(IARGT(ILOCTG).EQ.'NUMB')GOTO640 IF(IARGT(ILOCTG).EQ.'WORD')GOTO650 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,631) 631 FORMAT('***** INTERNAL ERROR IN DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,632) 632 FORMAT(' AN ARGUMENT TYPE WHICH SHOULD BE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,633) 633 FORMAT(' EITHER A NUMBER OR A WORD, IS NEITHER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,634)IHARG(ILOCTG),IHARG2(ILOCTG) 634 FORMAT(' ARGUMENT = ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,635)ILOCTG 635 FORMAT(' LOCATION IN ARGUMENT LIST = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,636)IARGT(ILOCTG) 636 FORMAT(' ARGUMENT TYPE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,637) 637 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,638)(IANS(I),I=1,IWIDTH) 638 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 640 CONTINUE DMIN=ARG(ILOCTG) DMAX=ARG(ILOCTG) IF(ICASOP.EQ.'= ')GOTO690 IF(ICASOP.EQ.'=ASS')GOTO690 IF(ICASOP.EQ.'< ')DMIN=CPUMIN IF(ICASOP.EQ.'< ')DMAX=ARG(ILOCTG) IF(ICASOP.EQ.'< ')GOTO690 IF(ICASOP.EQ.'<= ')DMIN=CPUMIN IF(ICASOP.EQ.'<= ')DMAX=ARG(ILOCTG) IF(ICASOP.EQ.'<= ')GOTO690 IF(ICASOP.EQ.'>= ')DMIN=ARG(ILOCTG) IF(ICASOP.EQ.'>= ')DMAX=CPUMAX IF(ICASOP.EQ.'>= ')GOTO690 IF(ICASOP.EQ.'> ')DMIN=ARG(ILOCTG) IF(ICASOP.EQ.'> ')DMAX=CPUMAX IF(ICASOP.EQ.'> ')GOTO690 GOTO690 C 650 CONTINUE IH=IHARG(ILOCTG) IH2=IHARG2(ILOCTG) IHWUSE='P' MESSAG='YES' CALL CHECKN(IH,IH2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR) IF(IERROR.EQ.'YES')GOTO9000 DMIN=VALUE(ILOC) DMAX=VALUE(ILOC) IF(ICASOP.EQ.'= ')GOTO690 IF(ICASOP.EQ.'=ASS')GOTO690 IF(ICASOP.EQ.'< ')DMIN=CPUMIN IF(ICASOP.EQ.'< ')DMAX=VALUE(ILOC) IF(ICASOP.EQ.'< ')GOTO690 IF(ICASOP.EQ.'<= ')DMIN=CPUMIN IF(ICASOP.EQ.'<= ')DMAX=VALUE(ILOC) IF(ICASOP.EQ.'<= ')GOTO690 IF(ICASOP.EQ.'>= ')DMIN=VALUE(ILOC) IF(ICASOP.EQ.'>= ')DMAX=CPUMAX IF(ICASOP.EQ.'>= ')GOTO690 IF(ICASOP.EQ.'> ')DMIN=VALUE(ILOC) IF(ICASOP.EQ.'> ')DMAX=CPUMAX IF(ICASOP.EQ.'> ')GOTO690 GOTO690 C 690 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,691)IPASS,ICASVA,ICASOP,IH,IH2,DMIN, 1DMAX 691 FORMAT('IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4,2E15.7) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C **************************************************************** C ** STEP 7-- C ** DETERMINE THE UPPER LIMIT OF THE INTERVAL OF INTEREST. C ** NOTE THAT FOR THOSE 4 CASES IN WHICH C ** ICASOP IS < <= >= > ** C ** THE UPPER LIMIT OF THE INTERVAL ** C ** HAS ALREADY BEEN DETERMINED AND SO ** C ** ALL OF THE CODE OF THIS SECTION MAY BE SKIPPED. C ** ON THE OTHER HAND WHEN THE OPERATION IS = , C ** (EXPLICITLY OR ASSUMED), ** C ** THE UPPER LIMIT MUST BE DETERMINED. C ** THIS IS DONE BY CHECKING THE NEXT ARGUMENT C ** IN THE LIST. C ** IF THIS NEXT ARGUMENT IS TO , C ** THIS IMPLIES THAT AN UPPER LIMIT WILL BE PROVIDED C ** (IN THE ARGUMENT AFTER THE TO ). C ** HOWEVER, IF THE NEXT ARGUMENT IS NOT A TO , C ** THEN THIS IMPLIES THAT THE LIST CONSISTS C ** OF INDIVIDUAL ELEMENTS OF THE SUBSET C ** AND SO THE UPPER LIMIT WILL BE IDENTICAL C ** TO THE LOWER LIMIT. C **************************************************************** C 700 CONTINUE C ISTEPN='7' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASOP.EQ.'< ')ICASSC='SEAR' IF(ICASOP.EQ.'< ')GOTO790 IF(ICASOP.EQ.'<= ')ICASSC='SEAR' IF(ICASOP.EQ.'<= ')GOTO790 IF(ICASOP.EQ.'>= ')ICASSC='SEAR' IF(ICASOP.EQ.'>= ')GOTO790 IF(ICASOP.EQ.'> ')ICASSC='SEAR' IF(ICASOP.EQ.'> ')GOTO790 C ILOCTG=ILOCTG+1 C IF(ILOCTG.GT.NUMARG)GOTO710 IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO710 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND. 1IHARG2(ILOCTG).EQ.'ET ')GOTO720 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND. 1IHARG2(ILOCTG).EQ.'PT ')GOTO720 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO750 GOTO730 C 710 CONTINUE ILOCTG=ILOCTG-1 JMAX=ILOCTG ICASSC='STOP' DMAX=DMIN GOTO790 C 720 CONTINUE ILOCTG=ILOCTG-1 JMAX=ILOCTG ICASSC='SEAR' DMAX=DMIN GOTO790 C 730 CONTINUE ILOCTG=ILOCTG-1 JMAX=ILOCTG ICASSC='CONT' DMAX=DMIN GOTO790 C 750 CONTINUE ILOCTG=ILOCTG+1 JMAX=ILOCTG IF(ILOCTG.GT.NUMARG)GOTO760 IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO760 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND. 1IHARG2(ILOCTG).EQ.'ET ')GOTO760 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND. 1IHARG2(ILOCTG).EQ.'PT ')GOTO760 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO760 GOTO770 C 760 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,761) 761 FORMAT('***** ERROR IN DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,762) 762 FORMAT(' THE WORD TO SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,763) 763 FORMAT(' BEEN FOLLOWED BY A NUMBER OR') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,764) 764 FORMAT(' BY A PARAMETER NAME, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,765)IHARG(ILOCTG),IHARG2(ILOCTG) 765 FORMAT(' TO WAS FOLLOWED BY THE WORD ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,766) 766 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,767)(IANS(I),I=1,IWIDTH) 767 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 770 CONTINUE IF(IARGT(ILOCTG).EQ.'NUMB')GOTO775 IF(IARGT(ILOCTG).EQ.'WORD')GOTO776 C IBRAN=770 WRITE(ICOUT,771)IBRAN CALL DPWRST('XXX','BUG ') WRITE(ICOUT,772)ILOCTG,IARGT(ILOCTG) 771 FORMAT('***** INTERNAL ERROR IN DPSUB3--', 1'IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ',I8) CALL DPWRST('XXX','BUG ') 772 FORMAT('ILOCTG, IARGT(ILOCTG) = ',I8,2X,A4) IERROR='YES' GOTO9000 C 775 CONTINUE DMAX=ARG(ILOCTG) GOTO780 C 776 CONTINUE IH=IHARG(ILOCTG) IH2=IHARG2(ILOCTG) IHWUSE='P' MESSAG='YES' CALL CHECKN(IH,IH2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR) IF(IERROR.EQ.'YES')GOTO9000 DMAX=VALUE(ILOC) GOTO780 C 780 CONTINUE ILOCTG=ILOCTG+1 ICASSC='CONT' IF(ILOCTG.GT.NUMARG)ICASSC='STOP' IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND. 1IHARG2(ILOCTG).EQ.' ')ICASSC='STOP' IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND. 1IHARG2(ILOCTG).EQ.'ET ')ICASSC='SEAR' IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND. 1IHARG2(ILOCTG).EQ.'PT ')ICASSC='SEAR' ILOCTG=ILOCTG-1 JMAX=ILOCTG C 790 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,791)IPASS,ICASVA,ICASOP,IH,IH2,DMIN, 1DMAX 791 FORMAT('IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4,2E15.7) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C *************************************************** C ** STEP 8-- ** C ** TO ALLOW FOR ROUNDOFF ERRORS IN THE ** C ** STORAGE OF NUMBERS, ** C ** JUDICIOUSLY EXPAND THE INTERVAL OF INTEREST ** C ** BY AN EPSILON AMOUNT. ** C *************************************************** C ISTEPN='8' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGQ.EQ.'OFF')GOTO804 WRITE(ICOUT,801) 801 FORMAT(' AT THE BEGINNING OF STEP 8--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,802)DMIN,DMAX 802 FORMAT('DMIN,DMAX = ',2E15.7) CALL DPWRST('XXX','BUG ') 804 CONTINUE C IF(DMIN.LE.DMAX)GOTO809 HOLD=DMIN DMIN=DMAX DMAX=HOLD 809 CONTINUE C IF(DMIN.EQ.CPUMIN)GOTO819 IF(DMIN.EQ.CPUMAX)GOTO819 IF(ABS(DMIN).EQ.0.0)EPS=0.000001 IF(ABS(DMIN).NE.0.0)EPS=ABS(DMIN*0.000001) IF(ICASOP.EQ.'= ')DMIN=DMIN-EPS IF(ICASOP.EQ.'=ASS')DMIN=DMIN-EPS IF(ICASOP.EQ.'< ')DMIN=DMIN-EPS IF(ICASOP.EQ.'<= ')DMIN=DMIN-EPS IF(ICASOP.EQ.'>= ')DMIN=DMIN-EPS IF(ICASOP.EQ.'> ')DMIN=DMIN+EPS 819 CONTINUE C IF(DMAX.EQ.CPUMAX)GOTO829 IF(DMAX.EQ.CPUMIN)GOTO829 IF(ABS(DMAX).EQ.0.0)EPS=0.000001 IF(ABS(DMAX).NE.0.0)EPS=ABS(DMAX*0.000001) IF(ICASOP.EQ.'= ')DMAX=DMAX+EPS IF(ICASOP.EQ.'=ASS')DMAX=DMAX+EPS IF(ICASOP.EQ.'< ')DMAX=DMAX-EPS IF(ICASOP.EQ.'<= ')DMAX=DMAX+EPS IF(ICASOP.EQ.'>= ')DMAX=DMAX+EPS IF(ICASOP.EQ.'> ')DMAX=DMAX+EPS 829 CONTINUE C 890 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,891)IPASS,ICASVA,ICASOP,IH,IH2 891 FORMAT('IPASS,ICASVA,ICASOP,IH,IH2 = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') IF(IBUGQ.EQ.'ON')WRITE(ICOUT,892)EPS,DMIN,DMAX,CPUMIN,CPUMAX 892 FORMAT('EPS,DMIN,DMAX,CPUMIN,CPUMAX = ',5E15.7) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C **************************************************** C ** STEP 9-- ** C ** DEFINE THE ISUB(.) VECTOR-- ** C ** FOR ANY K (K = 1 TO NIOLD), ** C ** IF THE K-TH ELEMENT OF THE ** C ** SUBSET SPECIFICATION VARIABLE ** C ** (THE VARIABLE SPECIFIED AFTER SUBSET ** C ** IN THE COMMAND LINE) ** C ** IS WITHIN THE SPECIFIED (DMIN,DMAX) LIMITS, ** C ** THEN ISUB(K) SHOULD RESULT IN A VALUE OF 1; ** C ** BUT IF THE K-TH ELEMENT OF THE ** C ** SUBSET SPECIFICATION VARIABLE ** C ** IS OUTSIDE THE SPECIFIED (DMIN,DMAX) LIMITS, ** C ** THEN ISUB(K) SHOULD RESULT IN A 0 . ** C **************************************************** C ISTEPN='9' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGQ.EQ.'ON')WRITE(ICOUT,901)ILOCS1,IHSET,IHSET2,ICASVA,ISETV, 1MAXCOL 901 FORMAT('ILOCS1,IHSET,IHSET2,ICASVA,ISETV,MAXCOL = ', 1I8,2X,A4,2X,A4,2X,A4,I8,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C IF(ICASVA.EQ.'UNKN')GOTO910 IF(ICASVA.EQ.'I ')GOTO930 IF(ISETV.LE.MAXCOL)GOTO940 IF(ISETV.EQ.MAXCP1)GOTO950 CCCCC IF(ISETV.EQ.MAXCP2)GOTO960 IF(ISETV.EQ.MAXCP2)GOTO950 IF(ISETV.EQ.MAXCP3)GOTO950 IF(ISETV.EQ.MAXCP4)GOTO950 IF(ISETV.EQ.MAXCP5)GOTO950 IF(ISETV.EQ.MAXCP6)GOTO950 C 910 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,911) 911 FORMAT('***** INTERNAL ERROR IN DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,912) 912 FORMAT(' IMPROPER VALUE FOR ICASVA AND/OR ISETV') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,913)ICASVA,ISETV,MAXCOL,MAXCP1,MAXCP2 913 FORMAT(' ICASVA,ISETV,MAXCOL,MAXCP1,MAXCP2 = ',A4,4I8) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 930 CONTINUE NS=0 ND=0 DO931I=1,NIOLD TARGET=I IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO932 IF(ICASQU.EQ.'SUBS')GOTO933 IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO934 IF(ICASQU.EQ.'EXCE')GOTO935 GOTO931 932 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 NS=NS+1 GOTO931 933 CONTINUE ND=ND+1 GOTO931 934 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 ND=ND+1 GOTO931 935 CONTINUE NS=NS+1 GOTO931 931 CONTINUE GOTO990 C 940 CONTINUE NS=0 ND=0 DO941I=1,NIOLD IJ=MAXN*(ISETV-1)+I VIJ=V(IJ) IF(IBUGQ.EQ.'ON')WRITE(9,947)I,NIOLD,ISETV,DMIN,DMAX,VIJ 947 FORMAT('I,NIOLD,ISETV,DMIN,DMAX,VIJ = ', 13I8,3E12.4) TARGET=VIJ IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO942 IF(ICASQU.EQ.'SUBS')GOTO943 IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO944 IF(ICASQU.EQ.'EXCE')GOTO945 GOTO941 942 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 NS=NS+1 GOTO941 943 CONTINUE ND=ND+1 GOTO941 944 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 ND=ND+1 GOTO941 945 CONTINUE NS=NS+1 GOTO941 941 CONTINUE GOTO990 C 950 CONTINUE NS=0 ND=0 DO951I=1,NIOLD CCCCC TARGET=PRED(I) IF(ISETV.EQ.MAXCP1)TARGET=PRED(I) IF(ISETV.EQ.MAXCP2)TARGET=RES(I) IF(ISETV.EQ.MAXCP3)TARGET=YPLOT(I) IF(ISETV.EQ.MAXCP4)TARGET=XPLOT(I) IF(ISETV.EQ.MAXCP5)TARGET=X2PLOT(I) IF(ISETV.EQ.MAXCP6)TARGET=TAGPLO(I) IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO952 IF(ICASQU.EQ.'SUBS')GOTO953 IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO954 IF(ICASQU.EQ.'EXCE')GOTO955 GOTO951 952 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 NS=NS+1 GOTO951 953 CONTINUE ND=ND+1 GOTO951 954 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 ND=ND+1 GOTO951 955 CONTINUE NS=NS+1 GOTO951 951 CONTINUE GOTO990 C CC960 CONTINUE CCCCC NS=0 CCCCC ND=0 CCCCC DO961I=1,NIOLD CCCCC TARGET=RES(I) CCCCC IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) CCCCC1GOTO962 CCCCC IF(ICASQU.EQ.'SUBS')GOTO963 CCCCC IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) CCCCC1GOTO964 CCCCC IF(ICASQU.EQ.'EXCE')GOTO965 CCCCC GOTO961 CC962 CONTINUE CCCCC ITEMP=ISUB(I) CCCCC IF(ITEMP.EQ.00)ISUB(I)=10 CCCCC IF(ITEMP.EQ.10)ISUB(I)=10 CCCCC IF(ITEMP.EQ.01)ISUB(I)=11 CCCCC IF(ITEMP.EQ.11)ISUB(I)=11 CCCCC NS=NS+1 CCCCC GOTO961 CC963 CONTINUE CCCCC ND=ND+1 CCCCC GOTO961 CC964 CONTINUE CCCCC ITEMP=ISUB(I) CCCCC IF(ITEMP.EQ.00)ISUB(I)=00 CCCCC IF(ITEMP.EQ.10)ISUB(I)=00 CCCCC IF(ITEMP.EQ.01)ISUB(I)=01 CCCCC IF(ITEMP.EQ.11)ISUB(I)=01 CCCCC ND=ND+1 CCCCC GOTO961 CC965 CONTINUE CCCCC NS=NS+1 CCCCC GOTO961 CC961 CONTINUE CCCCC GOTO990 C 990 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,991)IPASS,ICASQU,DMIN,DMAX,EPS, 1NIOLD,NS,ND 991 FORMAT('IPASS,ICASQU,DMIN,DMAX,EPS,NIOLD,NS,ND = ', 1I8,2X,A4,3E15.7,3I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') IF(IBUGQ.EQ.'OFF')GOTO994 DO992I=1,NIOLD WRITE(ICOUT,993)I,ISUB(I) 993 FORMAT('I,ISUB(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') 992 CONTINUE 994 CONTINUE C C ************************************************* C ** STEP 10-- ** C ** WRITE OUT A MESSAGE FOR THIS STEP ** C ** INDICATING ** C ** THE SUBSET VARIABLE NAME, ** C ** THE SUBSET MINIMUM, ** C ** THE SUBSET MAXIMUM, ** C ** THE INPUT NUMBER OF OBSERVATIONS (LOCAL), ** C ** THE NUMBER OF OBSERVATIONS IGNORED ** C ** AND THE OUTPUT NUMBER OF OBSERVATIONS ** C ** (THAT IS, THE SUBSET SAMPLE SIZE). ** C ** ALSO, CHECK THAT NS IS POSITIVE. ** C ************************************************* C ISTEPN='10' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASQU.EQ.'EXCE')GOTO1020 GOTO1010 C 1010 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1019 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1011) 1011 FORMAT('***** NOTE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1012)IHARG(ILOCS1),IHARG2(ILOCS1) 1012 FORMAT(' SUBSET VARIABLE = ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1013)DMIN 1013 FORMAT(' SUBSET MINIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1014)DMAX 1014 FORMAT(' SUBSET MAXIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1015)NIOLD 1015 FORMAT(' INPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1016)ND 1016 FORMAT(' NUMBER OF OBSERVATIONS IGNORED = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1017)NS 1017 FORMAT(' OUTPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') 1019 CONTINUE GOTO1050 C 1020 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1029 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1021) 1021 FORMAT('***** NOTE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1022)IHARG(ILOCS1),IHARG2(ILOCS1) 1022 FORMAT(' EXCEPTED SUBSET VARIABLE = ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1023)DMIN 1023 FORMAT(' EXCEPTED SUBSET MINIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1024)DMAX 1024 FORMAT(' EXCEPTED SUBSET MAXIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1025)NIOLD 1025 FORMAT(' INPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1026)ND 1026 FORMAT(' NUMBER OF OBSERVATIONS IGNORED = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1027)NS 1027 FORMAT(' OUTPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') 1029 CONTINUE GOTO1050 C 1050 CONTINUE CCCCC IF(NS.GE.1)GOTO1059 CCCCC WRITE(ICOUT,999) CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,1051) C1051 FORMAT('***** ERROR IN DPSUB3--') CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,1052) C1052 FORMAT(' THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.') CCCCC CALL DPWRST('XXX','BUG ') CCCCC IERROR='YES' CCCCC GOTO9000 C1059 CONTINUE C NUMSV=IPASS C 300 CONTINUE C 1100 CONTINUE DO1110I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=00 IF(ITEMP.EQ.11)ISUB(I)=11 1110 CONTINUE C C ************************************* C ** STEP 11-- ** C ** PUT ISUB(.) IN FINAL 0,1 FORM ** C ************************************* C ISTEPN='11' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C DO1210I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=0 IF(ITEMP.EQ.10)ISUB(I)=0 IF(ITEMP.EQ.01)ISUB(I)=1 IF(ITEMP.EQ.11)ISUB(I)=1 1210 CONTINUE C C ***************************************** C ** STEP 12-- ** C ** IF THERE WERE 2 OR MORE SUBSET ** C ** VARIABLES, GATHER INFORMATION ** C ** FOR A FINAL SUMMARY MESSAGE BY ** C ** DETERMINING THE FINAL NUMBER OF ** C ** ELEMENTS IN THE SUBSET ** C ** (AFTER ALL VARIABLES HAVE ** C ** BEEN INDIVIDUALLY ACCOUNTED FOR). ** C ***************************************** C 1500 CONTINUE C ISTEPN='12' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMSV.LE.1)GOTO1590 NS=0 DO1510I=1,NIOLD IF(ISUB(I).EQ.1)NS=NS+1 1510 CONTINUE 1590 CONTINUE C C ************************************************* C ** STEP 13-- ** C ** IF THERE WERE 2 OR MORE SUBSET VARIABLES, ** C ** WRITE OUT A FINAL MESSAGE ** C ** SUMMARIZING FOR ALL VARIABLES ** C ** THE NUMBER OF SUBSET VARIABLES ** C ** THE INPUT NUMBER OF OBSERVATIONS (LOCAL), ** C ** THE NUMBER OF OBSERVATIONS IGNORED ** C ** AND THE OUTPUT NUMBER OF OBSERVATIONS ** C ** (THAT IS, THE SUBSET SAMPLE SIZE). ** C ** ALSO, CHECK THAT NS IS POSITIVE. ** C ************************************************* C ISTEPN='13' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMSV.LE.1)GOTO1690 ND=NIOLD-NS C IF(IFEEDB.EQ.'OFF')GOTO1609 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1601) 1601 FORMAT('***** SUBSET/EXCEPT SUMMARY--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1602)NUMSV 1602 FORMAT(' NUMBER OF SPECIFICATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1605)NIOLD 1605 FORMAT(' INPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1606)ND 1606 FORMAT(' NUMBER OF OBSERVATIONS IGNORED = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1607)NS 1607 FORMAT(' OUTPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') 1609 CONTINUE C IF(NS.GE.1)GOTO1619 CCCCC THE FOLLOWING LINE WAS INSERTED FEBRUARY 1989 CCCCC TO SUPPRESS ERROR MESSAGE FOR EMPTY SUBSET FEBRUARY 1989 CCCCC UNLESS FEEDBACK SWITCH IS ON FEBRUARY 1989 IF(IFEEDB.EQ.'OFF')GOTO1619 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1611) 1611 FORMAT('***** ERROR IN DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1612) 1612 FORMAT(' THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1619 CONTINUE C 1690 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGQ.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPSUB3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)NIOLD,ILOCS,NS 9012 FORMAT('NIOLD,ILOCS,NS = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IBUGQ,IERROR 9014 FORMAT('IBUGQ,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)NUMARG,NUMNAM,MAXNAM,N,MAXN 9015 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',5I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)IWIDTH,ILOCS,ILOCS2,ILOCTG 9016 FORMAT('IWIDTH,ILOCS,ILOCS2,ILOCTG = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)NUMSV,ND 9017 FORMAT('NUMSV,ND = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)ICASQU,ICASVA,ICASOP,ICASSC 9018 FORMAT('ICASQU,ICASVA,ICASOP,ICASSC = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') DO9020I=1,NIOLD WRITE(ICOUT,9021)I,ISUB(I) 9021 FORMAT('I,ISUB(I) = ',2I8) CALL DPWRST('XXX','BUG ') 9020 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR) C C NOTE--THIS SUBROUTINE IS IDENTICAL TO THE DPSUB2 SUBROUTINE C AND THE DPSUB3 SUBROUTINE C AND HAS BEEN DUPLICATED TO THEM ONLY FOR ECONOMY OF MAPPING PURPOSES C THAT IS, TO SAVE STORAGE IN THE MAPPING. C FOR VIRTUAL OPERATING SYSTEMS, THIS DUPLICATION IS NEEDLESS. C ANY CALLS TO SUBROUTINES DPSUB2 AND SPSUB3 COULD BE CHANGED C TO CALLS TO DPSUBS. C C PURPOSE--DEFINE AN INTEGER 0-1 VECTOR ISUB C WHICH WILL BE USED IN OTHER SUBROUTINES C FOR EXTRACTING SUBSETS. C NOTE THAT IF THE WORDS SUBSET OR EXCEPT IS NOT C IN THE ARGUMENT LIST, C THEN THE OUTPUT PARAMETER WILL BE SET TO NUMARG+1. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--JANUARY 1978. C UPDATED --JANUARY 1978. C UPDATED --FEBRUARY 1978. C UPDATED --MAY 1978. C UPDATED --OCTOBER 1978. C UPDATED --NOVEMBER 1978. C UPDATED --FEBRUARY 1979. C UPDATED --NOVEMBER 1980. C UPDATED --JANUARY 1981. C UPDATED --JULY 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --DECEMBER 1981. C UPDATED --MARCH 1982. C UPDATED --MAY 1982. C UPDATED --MARCH 1988. ALLOW NOT EQUAL <> >< NOT= C UPDATED --JANUARY 1989. CHECK FOR EMPTY SUBSETS (ALAN) C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGQ CHARACTER*4 IERROR C CHARACTER*4 ICASSC CHARACTER*4 ICASQU CHARACTER*4 ICASVA CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CHARACTER*4 ICASOP CHARACTER*4 IHSET CHARACTER*4 IHSET2 CHARACTER*4 IH CHARACTER*4 IH2 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='DPSU' ISUBN2='BS ' C IERROR='NO' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C C ******************************** C ** TREAT THE SUBSET CASE ** C ******************************** C IF(IBUGQ.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)NIOLD,ILOCS,NS 52 FORMAT('NIOLD,ILOCS,NS = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IBUGQ,IERROR 54 FORMAT('IBUGQ,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)NUMARG,NUMNAM,MAXNAM,N,MAXN 55 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)IWIDTH,ILOCS,ILOCS2,ILOCTG 56 FORMAT('IWIDTH,ILOCS,ILOCS2,ILOCTG = ',4I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C **************************************************************** C ** STEP 1-- C ** INITIALIZE THE SUBSET SIZE (NS) TO NIOLD. C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. C ** ALSO CHECK THAT THE RELEVANT NUMBER OF OBSERVATIONS (NIOLD) C ** IS POSITIVE. C **************************************************************** C ISTEPN='1' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NS=NIOLD ILOCS=NUMARG+1 MINNA=0 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2, 1IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IF(NIOLD.GE.1)GOTO190 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,111) 111 FORMAT('***** ERROR IN DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,112) 112 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,113) 113 FORMAT(' (FROM WHICH A SUBSET WAS TO HAVE BEEN ', 1'EXTRACTED)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,114) 114 FORMAT(' IS 0') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 190 CONTINUE C C **************************************************************** C ** STEP 2.1-- C ** INITIALIZE ALL ELEMENTS IN ISUB(.) TO 11 C ** ISUB(.) WILL TAKE ON 4 VALUES AT MOST-- C ** 00, 01, 10, 11 . C ** THE FIRST DIGIT INDICATES WHETHER OR NOT THE GIVEN ELEMENT C ** IS OUT (0) OR IN (1) OF THE LOCAL CUMULATIVE UNION SET. C ** THE SECOND DIGIT INDICATES WHETHER OR NOT THE GIVEN ELEMENT C ** IS OUT (0) OR IN (1) OF THE GLOBAL CUMULATIVE INTERSECTION S C ** THE INITIALIZATION OF ALL ELEMENTS TO 11 C ** THUS INDICATES THAT INITIALLY ALL ELEMENTS (TEMPORARILY) C ** ARE IN THE LOCAL UNION SET, C ** AND INITIALLY ALL ELEMENTS C ** ARE IN THE GLOBAL INTERSECTION SET. C **************************************************************** C ISTEPN='2.1' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C DO200I=1,NIOLD ISUB(I)=11 200 CONTINUE C C ************************************************* C ** STEP 2.2-- ** C ** IF EXISTENT, ** C ** PACK < = INTO <= ** C ** PACK = < INTO =< ** C ** PACK > = INTO >= ** C ** PACK = > INTO => ** C ** THIS IS BECAUSE = SIGNS ARE AUTOMATICALLY ** C ** GIVEN A SPACE IN DPTYPE AND TREATED AS ** C ** AS A SEPARATE WORD. ** C ** NOTE THAT NUMARG WILL BE CHANGED. ** C ************************************************* C ISTEPN='2.2' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL ADJUS2(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) C C ************************************************ C ** STEP 3.1-- ** C ** CHECK TO SEE IF HAVE THE SUBSET CASE. ** C ** CHECK TO SEE IF HAVE THE EXCEPT CASE. ** C ** LOCATE THE POSITION IN THE ARGUMENT LIST ** C ** OF THE WORD SUBSET OR EXCEPT . ** C ************************************************ C ISTEPN='3.1' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C JMAX=0 ICASSC='SEAR' ICASQU='UNKN' NUMSV=0 DO300IPASS=1,100 C IF(IBUGQ.EQ.'OFF')GOTO309 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,301) 301 FORMAT('***** AT THE BEGINNING OF ANOTHER PASS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,302)IPASS,ILOCTG 302 FORMAT('IPASS,ILOCTG = ',2I8) CALL DPWRST('XXX','BUG ') IF(ILOCTG.GE.1) 1WRITE(ICOUT,303)ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG) 303 FORMAT('ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG) = ', 1A4,I8,2X,A4,2X,A4) IF(ILOCTG.GE.1) 1CALL DPWRST('XXX','BUG ') WRITE(ICOUT,304)JMAX 304 FORMAT('JMAX= ',I8) CALL DPWRST('XXX','BUG ') 309 CONTINUE C IF(ICASSC.EQ.'STOP')GOTO1100 JMIN=JMAX+1 IF(JMIN.GT.NUMARG)GOTO1100 IF(JMIN.EQ.NUMARG.AND.IHARG(JMIN).EQ.'AND '.AND. 1IHARG2(JMIN).EQ.' ')GOTO1100 C IF(ICASSC.EQ.'CONT')GOTO600 DO310I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=00 IF(ITEMP.EQ.11)ISUB(I)=11 310 CONTINUE ICASQU='UNKN' DO340J=JMIN,NUMARG J2=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ')GOTO350 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ')GOTO360 340 CONTINUE ILOCS=NUMARG+1 GOTO1100 C 350 CONTINUE ICASQU='SUBS' ILOCS=J2 CCCCC THE FOLLOWING 6 LINES WERE INSERTED MARCH 1988. ILOCS2=ILOCS+2 IHSET=IHARG(ILOCS2) IHSET2=IHARG2(ILOCS2) IF(IHSET.EQ.'<> ')ICASQU='EXCE' IF(IHSET.EQ.'>< ')ICASQU='EXCE' IF(IHSET.EQ.'NOT=')ICASQU='EXCE' GOTO390 C 360 CONTINUE ICASQU='EXCE' ILOCS=J2 GOTO390 C 390 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,391)IPASS,ICASQU,ILOCS 391 FORMAT('IPASS,ICASQU,ILOCS = ',I8,2X,A4,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C ******************************************* C ** STEP 3.2-- ** C ** IF HAVE THE SUBSET CASE, ** C ** INITIALIZE ISUB(.) TO 0X--00 OR 01. ** C ** IF HAVE THE EXCEPT CASE, ** C ** INITIALIZE ISUB(.) TO 1X--10 OR 11. ** C ******************************************* C ISTEPN='3.2' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASQU.EQ.'SUBS')GOTO400 GOTO405 C 400 CONTINUE DO401I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 401 CONTINUE GOTO409 C 405 CONTINUE DO406I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 406 CONTINUE GOTO409 C 409 CONTINUE C C ******************************************************** C ** STEP 4-- ** C ** CHECK VALIDITY OF FIRST ARGUMENT AFTER SUBSET ** C ** OR EXCEPT . ** C ** THIS SHOULD BE THE SUBSET VARIABLE ** C ** OR THE DUMMY INDEX I . ** C ******************************************************** C ISTEPN='4' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASVA='UNKN' ILOCS1=ILOCS+1 JMAX=ILOCS1 IF(ILOCS1.LE.NUMARG)GOTO429 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,411) 411 FORMAT('***** ERROR IN DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,412) 412 FORMAT(' THE WORD SUBSET OR EXCEPT WAS THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,413) 413 FORMAT(' FINAL WORD ON THE COMMAND LINE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,414) 414 FORMAT(' THE WORD SUBSET OR EXCEPT SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,415) 415 FORMAT(' BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,416) 416 FORMAT(' SUBSET X = 4') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,417) 417 FORMAT(' SUBSET X = 4 7 9 15 22') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,418) 418 FORMAT(' SUBSET X = 4 TO 10') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,419) 419 FORMAT(' SUBSET X >= 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,420) 420 FORMAT(' AND SO FORTH.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,421) 421 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,422)(IANS(I),I=1,IWIDTH) 422 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 429 CONTINUE C IHSET=IHARG(ILOCS1) IHSET2=IHARG2(ILOCS1) C IF(IHSET.EQ.'I '.AND.IHSET2.EQ.' ')GOTO430 GOTO440 C 430 CONTINUE ICASVA='I ' IF(NUMNAM.LE.0)GOTO490 DO435I=1,NUMNAM IF(IHNAME(I).EQ.IHSET.AND.IHNAM2(I).EQ.IHSET2.AND. 1IUSE(I).EQ.'V ')GOTO440 435 CONTINUE GOTO490 C 440 CONTINUE ICASVA='V ' 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')GOTO9000 ISETV=IVALUE(ILOC) IF(IBUGQ.EQ.'ON')WRITE(ICOUT,451)ILOCS1,IHSET,IHSET2,ISETV 451 FORMAT('ILOCS1,IHSET,IHSET2,ISETV = ',I8,3X,2A4,3X,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') GOTO490 C 490 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,491)IPASS,IHSET,IHSET2,ICASVA,ISETV 491 FORMAT('IPASS,IHSET,IHSET2,ICASVA,ISETV = ', 1I8,2X,A4,2X,A4,2X,A4,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C **************************************************************** C ** STEP 5-- C ** CHECK TO SEE IF NEXT ARGUMENT IS C ** < C ** <= C ** = C ** >= C ** > C ** <> >< NOT= C ** IF NONE OF THE ABOVE, THEN THE ASSUMED OPERATION IS = . C **************************************************************** C ISTEPN='5' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASOP='UNKN' ILOCS2=ILOCS+2 JMAX=ILOCS2 IF(ILOCS2.LE.NUMARG)GOTO529 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,501) 501 FORMAT('***** ERROR IN DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,502) 502 FORMAT(' THE SUBSET/EXCEPT VARIABLE NAME WAS THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,503) 503 FORMAT(' FINAL WORD ON THE COMMAND LINE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,504) 504 FORMAT(' THE SUBSET/EXCEPT VARIABLE NAME SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,505) 505 FORMAT(' BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,506) 506 FORMAT(' SUBSET X = 4') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,507) 507 FORMAT(' SUBSET X = 4 7 9 15 22') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,508) 508 FORMAT(' SUBSET X = 4 TO 10') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,509) 509 FORMAT(' SUBSET X >= 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,510) 510 FORMAT(' AND SO FORTH.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,521) 521 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,522)(IANS(I),I=1,IWIDTH) 522 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 529 CONTINUE C IHSET=IHARG(ILOCS2) IHSET2=IHARG2(ILOCS2) C IF(IHSET.EQ.'< ')GOTO531 IF(IHSET.EQ.'<= ')GOTO532 IF(IHSET.EQ.'=< ')GOTO532 IF(IHSET.EQ.'= ')GOTO533 IF(IHSET.EQ.'>= ')GOTO534 IF(IHSET.EQ.'=> ')GOTO534 IF(IHSET.EQ.'> ')GOTO535 CCCCC THE FOLLOWING 3 LINES WERE INSERTED MARCH 1988. IF(IHSET.EQ.'<> ')GOTO533 IF(IHSET.EQ.'>< ')GOTO533 IF(IHSET.EQ.'NOT=')GOTO533 GOTO536 C 531 CONTINUE ICASOP='< ' ILOCTG=ILOCS2 GOTO590 C 532 CONTINUE ICASOP='<= ' ILOCTG=ILOCS2 GOTO590 C 533 CONTINUE ICASOP='= ' ILOCTG=ILOCS2 GOTO590 C 534 CONTINUE ICASOP='>= ' ILOCTG=ILOCS2 GOTO590 C 535 CONTINUE ICASOP='> ' ILOCTG=ILOCS2 GOTO590 C 536 CONTINUE ICASOP='=ASS' ILOCTG=ILOCS2-1 GOTO590 C 590 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,591)IPASS,IHSET,IHSET2,ICASVA,ICASOP 591 FORMAT('IPASS,IHSET,IHSET2,ICASVA,ICASOP = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C ************************************************************** C ** STEP 6-- ** C ** DETERMINE THE LOWER LIMIT OF THE INTERVAL OF INTEREST. ** C ** THIS IS DONE BY CHECKING THE FIRST (NEXT) ARGUMENT ** C ** IN THE LIST. ** C ** ALSO, FOR THOSE 4 CASES IN WHICH ** C ** ICASOP IS < <= >= > ** C ** DETERMINE THE UPPER LIMIT OF THE INTERVAL OF INTEREST. ** C ************************************************************** C 600 CONTINUE C ISTEPN='6' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGQ.EQ.'OFF')GOTO609 WRITE(ICOUT,601) 601 FORMAT(' AT THE BEGINNING OF STEP 6 IN DPSUBS--') CALL DPWRST('XXX','BUG ') DO605I=1,NIOLD WRITE(ICOUT,606)I,ISUB(I) 606 FORMAT('I,ISUB(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') 605 CONTINUE 609 CONTINUE C ILOCTG=ILOCTG+1 JMAX=ILOCTG IF(ILOCTG.LE.NUMARG)GOTO629 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,611) 611 FORMAT('***** ERROR IN DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,612) 612 FORMAT(' THE SUBSET/EXCEPT OPERATION < <= = >= >') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,613) 613 FORMAT(' WAS THE FINAL WORD ON THE COMMAND LINE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,614) 614 FORMAT(' THE SUBSET/EXCEPT VARIABLE NAME SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,615) 615 FORMAT(' BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,616) 616 FORMAT(' SUBSET X = 4') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,617) 617 FORMAT(' SUBSET X = 4 7 9 15 22') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,618) 618 FORMAT(' SUBSET X = 4 TO 10') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,619) 619 FORMAT(' SUBSET X >= 7') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,620) 620 FORMAT(' AND SO FORTH.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,621) 621 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,622)(IANS(I),I=1,IWIDTH) 622 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 629 CONTINUE C IF(IARGT(ILOCTG).EQ.'NUMB')GOTO640 IF(IARGT(ILOCTG).EQ.'WORD')GOTO650 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,631) 631 FORMAT('***** INTERNAL ERROR IN DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,632) 632 FORMAT(' AN ARGUMENT TYPE WHICH SHOULD BE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,633) 633 FORMAT(' EITHER A NUMBER OR A WORD, IS NEITHER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,634)IHARG(ILOCTG),IHARG2(ILOCTG) 634 FORMAT(' ARGUMENT = ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,635)ILOCTG 635 FORMAT(' LOCATION IN ARGUMENT LIST = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,636)IARGT(ILOCTG) 636 FORMAT(' ARGUMENT TYPE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,637) 637 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,638)(IANS(I),I=1,IWIDTH) 638 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 640 CONTINUE DMIN=ARG(ILOCTG) DMAX=ARG(ILOCTG) IF(ICASOP.EQ.'= ')GOTO690 IF(ICASOP.EQ.'=ASS')GOTO690 IF(ICASOP.EQ.'< ')DMIN=CPUMIN IF(ICASOP.EQ.'< ')DMAX=ARG(ILOCTG) IF(ICASOP.EQ.'< ')GOTO690 IF(ICASOP.EQ.'<= ')DMIN=CPUMIN IF(ICASOP.EQ.'<= ')DMAX=ARG(ILOCTG) IF(ICASOP.EQ.'<= ')GOTO690 IF(ICASOP.EQ.'>= ')DMIN=ARG(ILOCTG) IF(ICASOP.EQ.'>= ')DMAX=CPUMAX IF(ICASOP.EQ.'>= ')GOTO690 IF(ICASOP.EQ.'> ')DMIN=ARG(ILOCTG) IF(ICASOP.EQ.'> ')DMAX=CPUMAX IF(ICASOP.EQ.'> ')GOTO690 GOTO690 C 650 CONTINUE IH=IHARG(ILOCTG) IH2=IHARG2(ILOCTG) IHWUSE='P' MESSAG='YES' CALL CHECKN(IH,IH2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR) IF(IERROR.EQ.'YES')GOTO9000 DMIN=VALUE(ILOC) DMAX=VALUE(ILOC) IF(ICASOP.EQ.'= ')GOTO690 IF(ICASOP.EQ.'=ASS')GOTO690 IF(ICASOP.EQ.'< ')DMIN=CPUMIN IF(ICASOP.EQ.'< ')DMAX=VALUE(ILOC) IF(ICASOP.EQ.'< ')GOTO690 IF(ICASOP.EQ.'<= ')DMIN=CPUMIN IF(ICASOP.EQ.'<= ')DMAX=VALUE(ILOC) IF(ICASOP.EQ.'<= ')GOTO690 IF(ICASOP.EQ.'>= ')DMIN=VALUE(ILOC) IF(ICASOP.EQ.'>= ')DMAX=CPUMAX IF(ICASOP.EQ.'>= ')GOTO690 IF(ICASOP.EQ.'> ')DMIN=VALUE(ILOC) IF(ICASOP.EQ.'> ')DMAX=CPUMAX IF(ICASOP.EQ.'> ')GOTO690 GOTO690 C 690 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,691)IPASS,ICASVA,ICASOP,IH,IH2,DMIN, 1DMAX 691 FORMAT('IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4,2E15.7) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C **************************************************************** C ** STEP 7-- C ** DETERMINE THE UPPER LIMIT OF THE INTERVAL OF INTEREST. C ** NOTE THAT FOR THOSE 4 CASES IN WHICH C ** ICASOP IS < <= >= > ** C ** THE UPPER LIMIT OF THE INTERVAL ** C ** HAS ALREADY BEEN DETERMINED AND SO ** C ** ALL OF THE CODE OF THIS SECTION MAY BE SKIPPED. C ** ON THE OTHER HAND WHEN THE OPERATION IS = , C ** (EXPLICITLY OR ASSUMED), ** C ** THE UPPER LIMIT MUST BE DETERMINED. C ** THIS IS DONE BY CHECKING THE NEXT ARGUMENT C ** IN THE LIST. C ** IF THIS NEXT ARGUMENT IS TO , C ** THIS IMPLIES THAT AN UPPER LIMIT WILL BE PROVIDED C ** (IN THE ARGUMENT AFTER THE TO ). C ** HOWEVER, IF THE NEXT ARGUMENT IS NOT A TO , C ** THEN THIS IMPLIES THAT THE LIST CONSISTS C ** OF INDIVIDUAL ELEMENTS OF THE SUBSET C ** AND SO THE UPPER LIMIT WILL BE IDENTICAL C ** TO THE LOWER LIMIT. C **************************************************************** C 700 CONTINUE C ISTEPN='7' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASOP.EQ.'< ')ICASSC='SEAR' IF(ICASOP.EQ.'< ')GOTO790 IF(ICASOP.EQ.'<= ')ICASSC='SEAR' IF(ICASOP.EQ.'<= ')GOTO790 IF(ICASOP.EQ.'>= ')ICASSC='SEAR' IF(ICASOP.EQ.'>= ')GOTO790 IF(ICASOP.EQ.'> ')ICASSC='SEAR' IF(ICASOP.EQ.'> ')GOTO790 C ILOCTG=ILOCTG+1 C IF(ILOCTG.GT.NUMARG)GOTO710 IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO710 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND. 1IHARG2(ILOCTG).EQ.'ET ')GOTO720 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND. 1IHARG2(ILOCTG).EQ.'PT ')GOTO720 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO750 GOTO730 C 710 CONTINUE ILOCTG=ILOCTG-1 JMAX=ILOCTG ICASSC='STOP' DMAX=DMIN GOTO790 C 720 CONTINUE ILOCTG=ILOCTG-1 JMAX=ILOCTG ICASSC='SEAR' DMAX=DMIN GOTO790 C 730 CONTINUE ILOCTG=ILOCTG-1 JMAX=ILOCTG ICASSC='CONT' DMAX=DMIN GOTO790 C 750 CONTINUE ILOCTG=ILOCTG+1 JMAX=ILOCTG IF(ILOCTG.GT.NUMARG)GOTO760 IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO760 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND. 1IHARG2(ILOCTG).EQ.'ET ')GOTO760 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND. 1IHARG2(ILOCTG).EQ.'PT ')GOTO760 IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO '.AND. 1IHARG2(ILOCTG).EQ.' ')GOTO760 GOTO770 C 760 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,761) 761 FORMAT('***** ERROR IN DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,762) 762 FORMAT(' THE WORD TO SHOULD HAVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,763) 763 FORMAT(' BEEN FOLLOWED BY A NUMBER OR') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,764) 764 FORMAT(' BY A PARAMETER NAME, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,765)IHARG(ILOCTG),IHARG2(ILOCTG) 765 FORMAT(' TO WAS FOLLOWED BY THE WORD ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,766) 766 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,767)(IANS(I),I=1,IWIDTH) 767 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 770 CONTINUE IF(IARGT(ILOCTG).EQ.'NUMB')GOTO775 IF(IARGT(ILOCTG).EQ.'WORD')GOTO776 C IBRAN=770 WRITE(ICOUT,771)IBRAN CALL DPWRST('XXX','BUG ') WRITE(ICOUT,772)ILOCTG,IARGT(ILOCTG) 771 FORMAT('***** INTERNAL ERROR IN DPSUBS--', 1'IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ',I8) CALL DPWRST('XXX','BUG ') 772 FORMAT('ILOCTG, IARGT(ILOCTG) = ',I8,2X,A4) IERROR='YES' GOTO9000 C 775 CONTINUE DMAX=ARG(ILOCTG) GOTO780 C 776 CONTINUE IH=IHARG(ILOCTG) IH2=IHARG2(ILOCTG) IHWUSE='P' MESSAG='YES' CALL CHECKN(IH,IH2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR) IF(IERROR.EQ.'YES')GOTO9000 DMAX=VALUE(ILOC) GOTO780 C 780 CONTINUE ILOCTG=ILOCTG+1 ICASSC='CONT' IF(ILOCTG.GT.NUMARG)ICASSC='STOP' IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND. 1IHARG2(ILOCTG).EQ.' ')ICASSC='STOP' IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND. 1IHARG2(ILOCTG).EQ.'ET ')ICASSC='SEAR' IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND. 1IHARG2(ILOCTG).EQ.'PT ')ICASSC='SEAR' ILOCTG=ILOCTG-1 JMAX=ILOCTG C 790 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,791)IPASS,ICASVA,ICASOP,IH,IH2,DMIN, 1DMAX 791 FORMAT('IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4,2E15.7) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C *************************************************** C ** STEP 8-- ** C ** TO ALLOW FOR ROUNDOFF ERRORS IN THE ** C ** STORAGE OF NUMBERS, ** C ** JUDICIOUSLY EXPAND THE INTERVAL OF INTEREST ** C ** BY AN EPSILON AMOUNT. ** C *************************************************** C ISTEPN='8' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGQ.EQ.'OFF')GOTO804 WRITE(ICOUT,801) 801 FORMAT(' AT THE BEGINNING OF STEP 8--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,802)DMIN,DMAX 802 FORMAT('DMIN,DMAX = ',2E15.7) CALL DPWRST('XXX','BUG ') 804 CONTINUE C IF(DMIN.LE.DMAX)GOTO809 HOLD=DMIN DMIN=DMAX DMAX=HOLD 809 CONTINUE C IF(DMIN.EQ.CPUMIN)GOTO819 IF(DMIN.EQ.CPUMAX)GOTO819 IF(ABS(DMIN).EQ.0.0)EPS=0.000001 IF(ABS(DMIN).NE.0.0)EPS=ABS(DMIN*0.000001) IF(ICASOP.EQ.'= ')DMIN=DMIN-EPS IF(ICASOP.EQ.'=ASS')DMIN=DMIN-EPS IF(ICASOP.EQ.'< ')DMIN=DMIN-EPS IF(ICASOP.EQ.'<= ')DMIN=DMIN-EPS IF(ICASOP.EQ.'>= ')DMIN=DMIN-EPS IF(ICASOP.EQ.'> ')DMIN=DMIN+EPS 819 CONTINUE C IF(DMAX.EQ.CPUMAX)GOTO829 IF(DMAX.EQ.CPUMIN)GOTO829 IF(ABS(DMAX).EQ.0.0)EPS=0.000001 IF(ABS(DMAX).NE.0.0)EPS=ABS(DMAX*0.000001) IF(ICASOP.EQ.'= ')DMAX=DMAX+EPS IF(ICASOP.EQ.'=ASS')DMAX=DMAX+EPS IF(ICASOP.EQ.'< ')DMAX=DMAX-EPS IF(ICASOP.EQ.'<= ')DMAX=DMAX+EPS IF(ICASOP.EQ.'>= ')DMAX=DMAX+EPS IF(ICASOP.EQ.'> ')DMAX=DMAX+EPS 829 CONTINUE C 890 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,891)IPASS,ICASVA,ICASOP,IH,IH2 891 FORMAT('IPASS,ICASVA,ICASOP,IH,IH2 = ', 1I8,2X,A4,2X,A4,2X,A4,2X,A4) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') IF(IBUGQ.EQ.'ON')WRITE(ICOUT,892)EPS,DMIN,DMAX,CPUMIN,CPUMAX 892 FORMAT('EPS,DMIN,DMAX,CPUMIN,CPUMAX = ',5E15.7) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C C **************************************************** C ** STEP 9-- ** C ** DEFINE THE ISUB(.) VECTOR-- ** C ** FOR ANY K (K = 1 TO NIOLD), ** C ** IF THE K-TH ELEMENT OF THE ** C ** SUBSET SPECIFICATION VARIABLE ** C ** (THE VARIABLE SPECIFIED AFTER SUBSET ** C ** IN THE COMMAND LINE) ** C ** IS WITHIN THE SPECIFIED (DMIN,DMAX) LIMITS, ** C ** THEN ISUB(K) SHOULD RESULT IN A VALUE OF 1; ** C ** BUT IF THE K-TH ELEMENT OF THE ** C ** SUBSET SPECIFICATION VARIABLE ** C ** IS OUTSIDE THE SPECIFIED (DMIN,DMAX) LIMITS, ** C ** THEN ISUB(K) SHOULD RESULT IN A 0 . ** C **************************************************** C ISTEPN='9' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGQ.EQ.'ON')WRITE(ICOUT,901)ILOCS1,IHSET,IHSET2,ICASVA,ISETV, 1MAXCOL 901 FORMAT('ILOCS1,IHSET,IHSET2,ICASVA,ISETV,MAXCOL = ', 1I8,2X,A4,2X,A4,2X,A4,I8,I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') C IF(ICASVA.EQ.'UNKN')GOTO910 IF(ICASVA.EQ.'I ')GOTO930 IF(ISETV.LE.MAXCOL)GOTO940 IF(ISETV.EQ.MAXCP1)GOTO950 CCCCC IF(ISETV.EQ.MAXCP2)GOTO960 IF(ISETV.EQ.MAXCP2)GOTO950 IF(ISETV.EQ.MAXCP3)GOTO950 IF(ISETV.EQ.MAXCP4)GOTO950 IF(ISETV.EQ.MAXCP5)GOTO950 IF(ISETV.EQ.MAXCP6)GOTO950 C 910 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,911) 911 FORMAT('***** INTERNAL ERROR IN DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,912) 912 FORMAT(' IMPROPER VALUE FOR ICASVA AND/OR ISETV') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,913)ICASVA,ISETV,MAXCOL,MAXCP1,MAXCP2 913 FORMAT(' ICASVA,ISETV,MAXCOL,MAXCP1,MAXCP2 = ',A4,4I8) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 930 CONTINUE NS=0 ND=0 DO931I=1,NIOLD TARGET=I IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO932 IF(ICASQU.EQ.'SUBS')GOTO933 IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO934 IF(ICASQU.EQ.'EXCE')GOTO935 GOTO931 932 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 NS=NS+1 GOTO931 933 CONTINUE ND=ND+1 GOTO931 934 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 ND=ND+1 GOTO931 935 CONTINUE NS=NS+1 GOTO931 931 CONTINUE GOTO990 C 940 CONTINUE NS=0 ND=0 DO941I=1,NIOLD IJ=MAXN*(ISETV-1)+I VIJ=V(IJ) IF(IBUGQ.EQ.'ON')WRITE(9,947)I,NIOLD,ISETV,DMIN,DMAX,VIJ 947 FORMAT('I,NIOLD,ISETV,DMIN,DMAX,VIJ = ', 13I8,3E12.4) TARGET=VIJ IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO942 IF(ICASQU.EQ.'SUBS')GOTO943 IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO944 IF(ICASQU.EQ.'EXCE')GOTO945 GOTO941 942 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 NS=NS+1 GOTO941 943 CONTINUE ND=ND+1 GOTO941 944 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 ND=ND+1 GOTO941 945 CONTINUE NS=NS+1 GOTO941 941 CONTINUE GOTO990 C 950 CONTINUE NS=0 ND=0 DO951I=1,NIOLD CCCCC TARGET=PRED(I) IF(ISETV.EQ.MAXCP1)TARGET=PRED(I) IF(ISETV.EQ.MAXCP2)TARGET=RES(I) IF(ISETV.EQ.MAXCP3)TARGET=YPLOT(I) IF(ISETV.EQ.MAXCP4)TARGET=XPLOT(I) IF(ISETV.EQ.MAXCP5)TARGET=X2PLOT(I) IF(ISETV.EQ.MAXCP6)TARGET=TAGPLO(I) IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO952 IF(ICASQU.EQ.'SUBS')GOTO953 IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) 1GOTO954 IF(ICASQU.EQ.'EXCE')GOTO955 GOTO951 952 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=10 IF(ITEMP.EQ.10)ISUB(I)=10 IF(ITEMP.EQ.01)ISUB(I)=11 IF(ITEMP.EQ.11)ISUB(I)=11 NS=NS+1 GOTO951 953 CONTINUE ND=ND+1 GOTO951 954 CONTINUE ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=01 IF(ITEMP.EQ.11)ISUB(I)=01 ND=ND+1 GOTO951 955 CONTINUE NS=NS+1 GOTO951 951 CONTINUE GOTO990 C CC960 CONTINUE CCCCC NS=0 CCCCC ND=0 CCCCC DO961I=1,NIOLD CCCCC TARGET=RES(I) CCCCC IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) CCCCC1GOTO962 CCCCC IF(ICASQU.EQ.'SUBS')GOTO963 CCCCC IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX) CCCCC1GOTO964 CCCCC IF(ICASQU.EQ.'EXCE')GOTO965 CCCCC GOTO961 CC962 CONTINUE CCCCC ITEMP=ISUB(I) CCCCC IF(ITEMP.EQ.00)ISUB(I)=10 CCCCC IF(ITEMP.EQ.10)ISUB(I)=10 CCCCC IF(ITEMP.EQ.01)ISUB(I)=11 CCCCC IF(ITEMP.EQ.11)ISUB(I)=11 CCCCC NS=NS+1 CCCCC GOTO961 CC963 CONTINUE CCCCC ND=ND+1 CCCCC GOTO961 CC964 CONTINUE CCCCC ITEMP=ISUB(I) CCCCC IF(ITEMP.EQ.00)ISUB(I)=00 CCCCC IF(ITEMP.EQ.10)ISUB(I)=00 CCCCC IF(ITEMP.EQ.01)ISUB(I)=01 CCCCC IF(ITEMP.EQ.11)ISUB(I)=01 CCCCC ND=ND+1 CCCCC GOTO961 CC965 CONTINUE CCCCC NS=NS+1 CCCCC GOTO961 CC961 CONTINUE CCCCC GOTO990 C 990 CONTINUE IF(IBUGQ.EQ.'ON')WRITE(ICOUT,991)IPASS,ICASQU,DMIN,DMAX,EPS, 1NIOLD,NS,ND 991 FORMAT('IPASS,ICASQU,DMIN,DMAX,EPS,NIOLD,NS,ND = ', 1I8,2X,A4,3E15.7,3I8) IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ') IF(IBUGQ.EQ.'OFF')GOTO994 DO992I=1,NIOLD WRITE(ICOUT,993)I,ISUB(I) 993 FORMAT('I,ISUB(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') 992 CONTINUE 994 CONTINUE C C ************************************************* C ** STEP 10-- ** C ** WRITE OUT A MESSAGE FOR THIS STEP ** C ** INDICATING ** C ** THE SUBSET VARIABLE NAME, ** C ** THE SUBSET MINIMUM, ** C ** THE SUBSET MAXIMUM, ** C ** THE INPUT NUMBER OF OBSERVATIONS (LOCAL), ** C ** THE NUMBER OF OBSERVATIONS IGNORED ** C ** AND THE OUTPUT NUMBER OF OBSERVATIONS ** C ** (THAT IS, THE SUBSET SAMPLE SIZE). ** C ** ALSO, CHECK THAT NS IS POSITIVE. ** C ************************************************* C ISTEPN='10' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASQU.EQ.'EXCE')GOTO1020 GOTO1010 C 1010 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1019 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1011) 1011 FORMAT('***** NOTE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1012)IHARG(ILOCS1),IHARG2(ILOCS1) 1012 FORMAT(' SUBSET VARIABLE = ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1013)DMIN 1013 FORMAT(' SUBSET MINIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1014)DMAX 1014 FORMAT(' SUBSET MAXIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1015)NIOLD 1015 FORMAT(' INPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1016)ND 1016 FORMAT(' NUMBER OF OBSERVATIONS IGNORED = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1017)NS 1017 FORMAT(' OUTPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') 1019 CONTINUE GOTO1050 C 1020 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1029 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1021) 1021 FORMAT('***** NOTE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1022)IHARG(ILOCS1),IHARG2(ILOCS1) 1022 FORMAT(' EXCEPTED SUBSET VARIABLE = ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1023)DMIN 1023 FORMAT(' EXCEPTED SUBSET MINIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1024)DMAX 1024 FORMAT(' EXCEPTED SUBSET MAXIMUM = ',E17.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1025)NIOLD 1025 FORMAT(' INPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1026)ND 1026 FORMAT(' NUMBER OF OBSERVATIONS IGNORED = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1027)NS 1027 FORMAT(' OUTPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') 1029 CONTINUE GOTO1050 C 1050 CONTINUE CCCCC IF(NS.GE.1)GOTO1059 CCCCC WRITE(ICOUT,999) CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,1051) C1051 FORMAT('***** ERROR IN DPSUBS--') CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,1052) C1052 FORMAT(' THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.') CCCCC CALL DPWRST('XXX','BUG ') CCCCC IERROR='YES' CCCCC GOTO9000 C1059 CONTINUE C NUMSV=IPASS C 300 CONTINUE C 1100 CONTINUE DO1110I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=00 IF(ITEMP.EQ.10)ISUB(I)=00 IF(ITEMP.EQ.01)ISUB(I)=00 IF(ITEMP.EQ.11)ISUB(I)=11 1110 CONTINUE C C ************************************* C ** STEP 11-- ** C ** PUT ISUB(.) IN FINAL 0,1 FORM ** C ************************************* C ISTEPN='11' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C DO1210I=1,NIOLD ITEMP=ISUB(I) IF(ITEMP.EQ.00)ISUB(I)=0 IF(ITEMP.EQ.10)ISUB(I)=0 IF(ITEMP.EQ.01)ISUB(I)=1 IF(ITEMP.EQ.11)ISUB(I)=1 1210 CONTINUE C C ***************************************** C ** STEP 12-- ** C ** IF THERE WERE 2 OR MORE SUBSET ** C ** VARIABLES, GATHER INFORMATION ** C ** FOR A FINAL SUMMARY MESSAGE BY ** C ** DETERMINING THE FINAL NUMBER OF ** C ** ELEMENTS IN THE SUBSET ** C ** (AFTER ALL VARIABLES HAVE ** C ** BEEN INDIVIDUALLY ACCOUNTED FOR). ** C ***************************************** C 1500 CONTINUE C ISTEPN='12' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMSV.LE.1)GOTO1590 NS=0 DO1510I=1,NIOLD IF(ISUB(I).EQ.1)NS=NS+1 1510 CONTINUE 1590 CONTINUE C C ************************************************* C ** STEP 13-- ** C ** IF THERE WERE 2 OR MORE SUBSET VARIABLES, ** C ** WRITE OUT A FINAL MESSAGE ** C ** SUMMARIZING FOR ALL VARIABLES ** C ** THE NUMBER OF SUBSET VARIABLES ** C ** THE INPUT NUMBER OF OBSERVATIONS (LOCAL), ** C ** THE NUMBER OF OBSERVATIONS IGNORED ** C ** AND THE OUTPUT NUMBER OF OBSERVATIONS ** C ** (THAT IS, THE SUBSET SAMPLE SIZE). ** C ** ALSO, CHECK THAT NS IS POSITIVE. ** C ************************************************* C ISTEPN='13' IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMSV.LE.1)GOTO1690 ND=NIOLD-NS C IF(IFEEDB.EQ.'OFF')GOTO1609 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1601) 1601 FORMAT('***** SUBSET/EXCEPT SUMMARY--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1602)NUMSV 1602 FORMAT(' NUMBER OF SPECIFICATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1605)NIOLD 1605 FORMAT(' INPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1606)ND 1606 FORMAT(' NUMBER OF OBSERVATIONS IGNORED = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1607)NS 1607 FORMAT(' OUTPUT NUMBER OF OBSERVATIONS = ',I8) CALL DPWRST('XXX','BUG ') 1609 CONTINUE C IF(NS.GE.1)GOTO1619 C AUGUST, 1987: FOR EMPTY SUBSETS, DO NO PRINT ERROR MESSAGE C UNLESS FEEDBACK SWITCH IS ON IF(IFEEDB.EQ.'OFF')GOTO1619 C END ADD WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1611) 1611 FORMAT('***** ERROR IN DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1612) 1612 FORMAT(' THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1619 CONTINUE C 1690 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGQ.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPSUBS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)NIOLD,ILOCS,NS 9012 FORMAT('NIOLD,ILOCS,NS = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IBUGQ,IERROR 9014 FORMAT('IBUGQ,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)NUMARG,NUMNAM,MAXNAM,N,MAXN 9015 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',5I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)IWIDTH,ILOCS,ILOCS2,ILOCTG 9016 FORMAT('IWIDTH,ILOCS,ILOCS2,ILOCTG = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)NUMSV,ND 9017 FORMAT('NUMSV,ND = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)ICASQU,ICASVA,ICASOP,ICASSC 9018 FORMAT('ICASQU,ICASVA,ICASOP,ICASSC = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') DO9020I=1,NIOLD WRITE(ICOUT,9021)I,ISUB(I) 9021 FORMAT('I,ISUB(I) = ',2I8) CALL DPWRST('XXX','BUG ') 9020 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPSUM2(Y,W,N,XTEMP1,XTEMP2,MAXNXT, 1 ICAPSW,ICAPTY, 1 IBUGA3,IERROR) C C PURPOSE--THIS ROUTINE GENERATES A SUMMARY C OF THE DATA IN THE INPUT VECTOR Y. C NOTE--ASSUMPTION--MODEL IS RESPONSE = CONSTANT + ERROR. C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR C OF EQUALLY-SPACED OBSERVATIONS C TO BE SMOOTHED. C N = THE INTEGER NUMBER OF C OBSERVATIONS IN THE VECTOR Y. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--JULY 1981. C UPDATED --NOVEMBER 1981. C UPDATED --FEBRUARY 1982. C UPDATED --MAY 1982. C UPDATED --OCTOBER 2002. SUPPORT FOR HTML OUTPUT C (ADD ICAPSW, ICAPTY TO CALL C LIST) C UPDATED --OCTOBER 2003. SUPPORT FOR LATEX OUTPUT C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C EXTERNAL RANGE C CHARACTER*4 ICAPSW CHARACTER*4 ICAPTY CHARACTER*1 IBASLC C CHARACTER*4 IBUGA3 CHARACTER*4 IERROR C CHARACTER*4 IWRITE C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C DIMENSION Y(*) DIMENSION W(*) DIMENSION XTEMP1(*) DIMENSION XTEMP2(*) 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='DPSU' ISUBN2='M2 ' C IERROR='NO' 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 DPSUM2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)N,IBUGA3 52 FORMAT('N,IBUGA3 = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') DO56I=1,N WRITE(ICOUT,57)I,Y(I),W(I) 57 FORMAT('I,Y(I),W(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') 56 CONTINUE 90 CONTINUE C C ******************************************** C ** STEP 1-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C ISTEPN='1' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(N.LT.1)GOTO110 GOTO119 110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,111) 111 FORMAT('***** ERROR IN DPSUM2--THE NUMBER OF OBSERVATIONS ', 1'IN THE RESPONSE VARIABLE IS NON-POSITIVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,112)N 112 FORMAT('SAMPLE SIZE = ',I8) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 119 CONTINUE C IF(N.EQ.1)GOTO120 GOTO129 120 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,121) 121 FORMAT('***** NOTE FROM DPSUM2--THE RESPONSE VARIABLE ', 1'ONLY HAS 1 ELEMENT') CALL DPWRST('XXX','BUG ') GOTO9000 129 CONTINUE C HOLD=Y(1) DO135I=2,N IF(Y(I).NE.HOLD)GOTO139 135 CONTINUE 130 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,131)HOLD 131 FORMAT('***** NOTE FROM DPSUM2--THE RESPONSE VARIABLE ', 1'HAS ALL ELEMENTS = ',E15.7) CALL DPWRST('XXX','BUG ') GOTO9000 139 CONTINUE C C ********************************************** C ** STEP 3-- ** C ** COMPUTE VARIOUS MEASURES OF LOCATION-- ** C ** 1) MIDRANGE ** C ** 2) MEAN ** C ** 3) MIDMEAN ** C ** 4) MEDIAN ** C ********************************************** C ISTEPN='3' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IWRITE='OFF' C CALL MIDRAN(Y,N,IWRITE,YMIDR,IBUGA3,IERROR) CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR) CALL MIDMEA(Y,N,IWRITE,XTEMP1,MAXNXT,YMIDM,IBUGA3,IERROR) CALL MEDIAN(Y,N,IWRITE,XTEMP1,MAXNXT,YMED,IBUGA3,IERROR) C C ********************************************** C ** STEP 4-- ** C ** COMPUTE VARIOUS MEASURES OF DISPERSION ** C ** 1) RANGE ** C ** 2) STANDARD DEVIATION ** C ** 3) AVERAGE ABSOLUTE DEVIATION ** C ** 4) MINIMUM ** C ** 5) LOWER QUARTILE ** C ** 6) LOWER HINGE ** C ** 7) UPPER HINGE ** C ** 8) UPPER QUARTILE ** C ** 9) MAXIMUM ** C ********************************************** C ISTEPN='4' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL RANGE(Y,N,IWRITE,YRANGE,IBUGA3,IERROR) CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR) CALL AAD(Y,N,IWRITE,XTEMP1,MAXNXT,YAAD,IBUGA3,IERROR) CALL MINIM(Y,N,IWRITE,YMIN,IBUGA3,IERROR) CALL LOWQUA(Y,N,IWRITE,XTEMP1,MAXNXT,YLOWQ,IBUGA3,IERROR) CALL LOWHIN(Y,N,IWRITE,XTEMP1,MAXNXT,YLOWH,IBUGA3,IERROR) CALL UPPHIN(Y,N,IWRITE,XTEMP1,MAXNXT,YUPPH,IBUGA3,IERROR) CALL UPPQUA(Y,N,IWRITE,XTEMP1,MAXNXT,YUPPQ,IBUGA3,IERROR) CALL MAXIM(Y,N,IWRITE,YMAX,IBUGA3,IERROR) C C **************************************************************** C ** STEP 5-- C ** COMPUTE VARIOUS DISTRIBUTIONAL MEASURES-- C ** 1) STANDARDIZED THIRD CENTRAL MOMENT C ** 2) STANDARDIZED FOURTH CENTRAL MOMENT C ** 3) STANDARDIZED WILK-SHAPIRO STATISTIC C ** 4) UNIFORM PROBABILITY PLOT CORRELATION COEFF C ** 5) NORMAL PROBABILITY PLOT CORRELATION COEFF C ** 6) TUKEY LAMBDA = -0.5 PROBABILITY PLOT CORRELATION COEFF C ** 7) CAUCHY PROBABILITY PLOT CORRELATION COEFF C **************************************************************** C ISTEPN='5' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL STMOM3(Y,N,IWRITE,YST3MO,IBUGA3,IERROR) CALL STMOM4(Y,N,IWRITE,YST4MO,IBUGA3,IERROR) CALL STWS(Y,N,IWRITE,YSTWS,IBUGA3,IERROR) CALL UNIPPC(Y,N,IWRITE,XTEMP1,XTEMP2,MAXNXT,YUNIPP, 1IBUGA3,IERROR) CALL NORPPC(Y,N,IWRITE,XTEMP1,XTEMP2,MAXNXT,YNORPP, 1IBUGA3,IERROR) ALAMBA=-0.5 CALL LAMPPC(Y,N,ALAMBA,IWRITE,XTEMP1,XTEMP2,MAXNXT,YLAMPP, 1IBUGA3,IERROR) CALL CAUPPC(Y,N,IWRITE,XTEMP1,XTEMP2,MAXNXT,YCAUPP, 1IBUGA3,IERROR) C C ************************************************************* C ** STEP 6-- ** C ** COMPUTE VARIOUS RANDOMNESS MEASURES ** C ** 1) AUTOCORRELATION COEFFICIENT ** C ** 2) STANDARDIZED LENGTH OF LONGEST RUN (UP OR DOWN) ** C ** 3) STANDARDIZED NUMBER OF RUNS (UP + DOWN) ** C ************************************************************* C ISTEPN='6' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL AUTOCR(Y,N,IWRITE,YAUTOC,IBUGA3,IERROR) CCCCC CALL STLLRU(Y,N,IWRITE,YSTLLR,IBUGA3,IERROR) YSTLLR=0.0 CCCCC CALL STNRUN(Y,N,IWRITE,YSTNRU,IBUGA3,IERROR) YSTNRU=0.0 C C **************************** C ** STEP 7-- ** C ** WRITE EVERYTHING OUT ** C **************************** C ISTEPN='7' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC OCTOBER 2002: IF CAPTURE SWITCH ON AND SET TO "HTML", THEN CCCCC WRITE OUTPUT IN HTML TABLE FORMAT. C IF(IPRINT.EQ.'OFF')GOTO890 C IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN C WRITE(ICOUT,5101) 5101 FORMAT('') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5107) 5107 FORMAT('') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5999) 5999 FORMAT('
')
        CALL DPWRST('XXX','WRIT')
C
        GOTO890
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
 8001 FORMAT(5X,2A4,' & ')
 8002 FORMAT(5X,A52,'& ')
 8003 FORMAT(5X,2A4)
 8004 FORMAT(5X,A52)
 8005 FORMAT(5X,A1,A1,' ')
 8006 FORMAT(5X,A1,A1,1X,A1,'hline')
 8007 FORMAT(A1,'begin{center}')
 8008 FORMAT(5X,A1,'multicolumn{2}{c} {',A1,'bf Summary Statistics} ')
18008 FORMAT(5X,A1,A1,2X,A1,'hline')
 8010 FORMAT(A1,'end{center}')
 8011 FORMAT(5X,'} ',A1,A1,' ')
 8012 FORMAT(A1,'end{verbatim}')
 8013 FORMAT(A1,'begin{table}')
 8014 FORMAT(A1,'end{table}')
 8015 FORMAT(5X,A1,'begin{tabular} {|r|r|}')
 8016 FORMAT('   ',A1,'end{tabular}')
 8017 FORMAT(A1,'begin{verbatim}')
 8018 FORMAT(' & ')
 8019 FORMAT(1X,A1,A1,1X)
C
        CALL DPCONA(92,IBASLC)
C
C  END VERBATIM, START TABLE ENVIRONMENT
C
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  START TABULAR ENVIORNMENT
C
        WRITE(ICOUT,8015)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8008)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18008)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  WRITE LOCATION AND SCALE MEASURES
C
 8021   FORMAT('LOCATION MEASURES & DISPERSION MEASURES ',
     1         2A1,2X,A1,'hline')
 8041   FORMAT('MIDRANGE = ',E15.7,' & RANGE = ',E15.7,2X,2A1)
 8042   FORMAT('MEAN = ',E15.7,' & STANDARD DEVIATION = ',E15.7,2X,2A1)
 8043   FORMAT('MIDMEAN = ',E15.7,' & AAD = ',
     1        E15.7,2X,2A1)
 8044   FORMAT('MEDIAN = ',E15.7,' & MINIMUM = ',E15.7,2X,2A1)
 8045   FORMAT('  & LOWER QUARTILE = ',E15.7,2X,2A1)
 8046   FORMAT('  & LOWER HINGE = ',E15.7,2X,2A1)
 8047   FORMAT('  & UPPER HINGE = ',E15.7,2X,2A1)
 8048   FORMAT('  & UPPER QUARTILE = ',E15.7,2X,2A1)
 8049   FORMAT('  & MAXIMUM = ',E15.7,2X,2A1,2X,A1,'hline')
        WRITE(ICOUT,8021)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)YMIDR,YRANGE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8042)YMEAN,YSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)YMIDM,YAAD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)YMED,YMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)YLOWQ,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)YLOWH,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8047)YUPPH,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8048)YUPPQ,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)YMAX,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  WRITE RANDOMNESS AND DISTRIBUTIONAL MEASURES
C
 8050   FORMAT('RANDOMNESS MEASURES & DISTRIBUTIONAL MEASURES ',
     1         2A1,2X,A1,'hline')
 8051   FORMAT('AUTOCORRELATION = ',E15.7,' & SKEWNESS = ',E15.7,2X,2A1)
 8055   FORMAT('  & KURTOSIS = ',E15.7,2X,2A1)
 8056   FORMAT('  & WILK-SHAPIRO = ',E15.7,2X,2A1)
 8057   FORMAT('  & UNIFORM PPCC = ',E15.7,2X,2A1)
 8058   FORMAT('  & NORMAL PPCC = ',E15.7,2X,2A1)
 8059   FORMAT('  & TUKEY (-0.5) PPCC = ',E15.7,2X,2A1)
 8060   FORMAT('  & CAUCHY PPCC = ',E15.7,2X,2A1,2X,A1,'hline')
        WRITE(ICOUT,8050)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8051)YAUTOC,YST3MO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8055)YST3MO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8056)YSTWS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8057)YUNIPP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8058)YNORPP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8059)YLAMPP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8060)YCAUPP,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  END CODE
C
        WRITE(ICOUT,8016)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        GOTO890
C
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,805)
  805 FORMAT(
     1'                                SUM',
     1'MARY                               ')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,806)N
  806 FORMAT(
     1'                     NUMBER OF OBSE',
     1'RVATIONS = ',I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,811)
  811 FORMAT(
     1'***********************************',
     1'***********************************',
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,812)
  812 FORMAT(
     1'*        LOCATION MEASURES         ',
     1'*       DISPERSION MEASURES        ',
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,811)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,813)YMIDR,YRANGE
  813 FORMAT(
     1'*  MIDRANGE     = ',E15.7,2X,
     1'*  RANGE        = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,814)YMEAN,YSD
  814 FORMAT(
     1'*  MEAN         = ',E15.7,2X,
     1'*  STAND. DEV.  = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,815)YMIDM,YAAD
  815 FORMAT(
     1'*  MIDMEAN      = ',E15.7,2X,
     1'*  AV. AB. DEV. = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,816)YMED,YMIN
  816 FORMAT(
     1'*  MEDIAN       = ',E15.7,2X,
     1'*  MINIMUM      = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,817)YLOWQ
  817 FORMAT(
     1'*               = ',15X  ,2X,
     1'*  LOWER QUART. = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,818)YLOWH
  818 FORMAT(
     1'*               = ',15X  ,2X,
     1'*  LOWER HINGE  = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,819)YUPPH
  819 FORMAT(
     1'*               = ',15X  ,2X,
     1'*  UPPER HINGE  = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,820)YUPPQ
  820 FORMAT(
     1'*               = ',15X  ,2X,
     1'*  UPPER QUART. = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,821)YMAX
  821 FORMAT(
     1'*               = ',15X  ,2X,
     1'*  MAXIMUM      = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,811)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,831)
  831 FORMAT(
     1'*       RANDOMNESS MEASURES        ',
     1'*     DISTRIBUTIONAL MEASURES      ',
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,811)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,832)YAUTOC,YST3MO
  832 FORMAT(
     1'*  AUTOCO COEF  = ',E15.7,2X,
     1'*  ST. 3RD MOM. = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,833)YSTLLR,YST4MO
CC833 FORMAT(
CCCCC1'*  ST LONG RUN  = ',E15.7,2X,
CCCCC1'*  ST. 4TH MOM. = ',E15.7,2X,
CCCCC1'*')
  833 FORMAT(
     1'*               = ',E15.7,2X,
     1'*  ST. 4TH MOM. = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,834)YSTNRU,YSTWS
CC834 FORMAT(
CCCCC1'*  ST NUM RUNS  = ',E15.7,2X,
CCCCC1'*  ST. WILK-SHA = ',E15.7,2X,
CCCCC1'*')
  834 FORMAT(
     1'*               = ',E15.7,2X,
     1'*  ST. WILK-SHA = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,835)YUNIPP
  835 FORMAT(
     1'*               = ',15X  ,2X,
     1'*  UNIFORM PPCC = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,836)YNORPP
  836 FORMAT(
     1'*               = ',15X  ,2X,
     1'*  NORMAL  PPCC = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,837)YLAMPP
  837 FORMAT(
     1'*               = ',15X  ,2X,
     1'*  TUK -.5 PPCC = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,838)YCAUPP
  838 FORMAT(
     1'*               = ',15X  ,2X,
     1'*  CAUCHY  PPCC = ',E15.7,2X,
     1'*')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,811)
      CALL DPWRST('XXX','BUG ')
C
  890 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 DPSUM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),W(I)
 9017 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSUMM(XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A BATTERY OF SUMMARY STATISTICS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JULY      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1990.  TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --OCTOBER   2002.  SUPPORT FOR HTML OUTPUT
C                                        (ADD ICAPSW TO CALL LIST)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION W(MAXOBV)
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),W(1))
CCCCC END CHANGE
C-----COMMON----------------------------------------------------------
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='DPSU'
      ISUBN2='MM  '
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
      MAXV2=1
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************
C               **  TREAT THE SUMMARY   CASE  **
C               ********************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSUMM--')
      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 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.              **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPSUMM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A SUMMARY ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,NLEFT
      ISUB(I)=1
  515 CONTINUE
      NQ=NLEFT
      GOTO550
C
  520 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPSUMM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FOR WHICH A SUMMARY ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      IS TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
  570 CONTINUE
      NS=J
C
C               ****************************************************************
C               **  STEP 8--
C               **  PREPARE FOR ENTRANCE INTO DPSUM2--
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C               ****************************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,NS
      W(I)=1.0
 1110 CONTINUE
C
C               *********************************
C               **  STEP 9--                   **
C               **  FORM THE SUMMARY.          **
C               *********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPSUMM, AS WE ARE ABOUT TO CALL DPSUM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,MAXN,NS
 1212 FORMAT('NLEFT,MAXN,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I),W(I)
 1216 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 1290 CONTINUE
C
      CALL DPSUM2(Y,W,NS,XTEMP1,XTEMP2,MAXNXT,
     1            ICAPSW,ICAPTY,
     1            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 DPSUMM--')
      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 DPSWAP(IOP3,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
     1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--SWAP (WRITE OUT OR READ IN) THE VECTOR V(.)
C              FROM MASS STORAGE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--MARCH     1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1986.
C     UPDATED         --OCTOBER   1991.  SUN HAS LIMIT ON NUMBER OF WORDS
C                                        THAT CAN BE WRITTEN (ALAN)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IOP3
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
CCCCC CHARACTER*4 IFOUND
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DIMENSION V(*)
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
C  FOLLOWING LINE ADDED OCTOBER 1991.
      INCLUDE 'DPCOHO.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='DPSW'
      ISUBN2='AP  '
C
      ISUBN0='SWAP'
C
      IERROR='NO'
      IWIDTH=(-999)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWAP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSWAP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,IOP3
   53 FORMAT('IBUGS2,IOP3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)V(1),V(2),V(3)
   54 FORMAT('V(1),V(2),V(3) = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMNAM,MAXN,MAXCOL
   55 FORMAT('NUMNAM,MAXN,MAXCOL = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)ISCRNU
   71 FORMAT('ISCRNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ISCRNA
   72 FORMAT('ISCRNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)ISCRST
   73 FORMAT('ISCRST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)ISCRFO
   74 FORMAT('ISCRFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)ISCRAC
   75 FORMAT('ISCRAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)ISCRFO
   76 FORMAT('ISCRFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)ISCRCS
   77 FORMAT('ISCRCS = ',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.'SWAP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ISCRNU
      IFILE=ISCRNA
      ISTAT=ISCRST
      IFORM=ISCRFO
      IACCES=ISCRAC
      IPROT=ISCRPR
      ICURST=ISCRCS
C
      ISUBN0='SWAP'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWAP')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 SCRATCH FILE MAY EXIST  **
C               **********************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     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('***** IMPLEMENTATION ERROR IN DPSWAP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED FIT REQUIRES THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      BEHIND-THE-SCENES USE OF A SCRATCH FILE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      BUT THE USE OF SUCH A SCRATCH FILE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      CANNOT BE DONE BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      THE INTERNAL VARIABLE    ISCRST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      WHICH ALLOWS SUCH SCRATCH FILE USE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)
 1218 FORMAT('      HAS BEEN SET TO    NONE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)ISTAT,ISCRST
 1219 FORMAT('ISTAT,ISCRST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1220)
 1220 FORMAT('      PLEASE CONTACT THE DATAPLOT IMPLEMENTOR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1221)
 1221 FORMAT('      AND HAVE THE ISCRST SETTING CHANGED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)
 1222 FORMAT('      (FROM   NONE   TO   UNKNOWN)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)
 1223 FORMAT('      IN SUBROUTINE INITFO.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 20--                          **
C               **  BRANCH TO THE APPROPRIATE CASE--   **
C               **    1) WRITE OUT TO   MASS STORGE;   **
C               **    2) READ IN   FROM MASS STORAGE.  **
C               *****************************************
C
      ISTEPN='20'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOP3.EQ.'WRIT')GOTO2100
      GOTO2200
C
C               ******************************************
C               **  STEP 21--                           **
C               **  WRITE THE V(.) VECTOR               **
C               **  OUT TO THE MASS STORAGE FILE        **
C               **  WITH NUMERIC DESIGNATION    ISCRNU  **
C               ******************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXN2=0
      MAXCO2=0
      MAXIJ2=0
C
      IF(NUMNAM.LE.0)GOTO2129
      DO2110J=1,NUMNAM
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWAP')GOTO2119
      WRITE(ICOUT,2111)J,IHNAME(J),IHNAM2(J),IUSE(J),IN(J),IVALUE(J)
 2111 FORMAT('J,IHNAME(J),IHNAM2(J),ISE(J),IN(J),IVALUE(J) = ',
     1I8,2X,A4,2X,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 2119 CONTINUE
      IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.'    ')GOTO2110
      IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.'    ')GOTO2110
      IF(IUSE(J).EQ.'V')GOTO2115
      GOTO2110
 2115 CONTINUE
      IROW=IN(J)
      ICOL=IVALUE(J)
      IF(ICOL.GT.MAXCOL)GOTO2110
      IF(IROW.GT.MAXN2)MAXN2=IROW
      IF(ICOL.GT.MAXCO2)MAXCO2=ICOL
 2110 CONTINUE
 2129 CONTINUE
C
      MAXIJ2=MAXN*(MAXCO2-1)+MAXN2
      IF(MAXIJ2.LE.0)GOTO9000
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1WRITE(ICOUT,999)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1CALL DPWRST('XXX','BUG ')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1WRITE(ICOUT,2191)
 2191 FORMAT('***** A SWAP OUT IS ABOUT TO BE EXECUTED.')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1CALL DPWRST('XXX','BUG ')
C
      IDEV='SCRA'
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
CCCCC IF(MAXIJ2.GE.1)WRITE(IOUNIT)(V(IJ),IJ=1,MAXIJ2)
C
C  OCTOBER 1991.  SUN HAS LIMIT (SEEMS TO BE 2,046 WORDS) ON NUMBER OF
C  WORDS THAT CAN BE WRITTEN IN ONE RECORD.  ABOVE LINE REPLACED WITH
C  FOLLOWING BLOCK OF CODE.
C
      IF(MAXIJ2.LT.1)GOTO2199
      MAXWRD=100000
      IF(IHOST1.EQ.'SUN')MAXWRD=2046
      NLOOPF=(MAXIJ2/MAXWRD)+1
      IF(NLOOPF.LT.1)GOTO2197
      DO2192IK=1,NLOOPF
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXIJ2)GOTO2197
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXIJ2)JSTOP=MAXIJ2
      WRITE(IOUNIT) (V(IJ),IJ=JSTART,JSTOP)
 2192 CONTINUE
 2197 CONTINUE
 2199 CONTINUE
C  END CHANGE
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
      GOTO9000
C
C               ******************************************
C               **  STEP 22--                           **
C               **  READ  THE V(.) VECTOR               **
C               **  IN FROM THE MASS STORAGE FILE       **
C               **  WITH NUMERIC DESIGNATION    ISCRNU  **
C               ******************************************
C
 2200 CONTINUE
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(MAXIJ2.LE.0)GOTO9000
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1WRITE(ICOUT,999)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1CALL DPWRST('XXX','BUG ')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1WRITE(ICOUT,2291)
 2291 FORMAT('***** A SWAP IN  IS ABOUT TO BE EXECUTED.')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
     1CALL DPWRST('XXX','BUG ')
C
      IDEV='SCRA'
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
CCCCC IF(MAXIJ2.GE.1)READ(IOUNIT)(V(IJ),IJ=1,MAXIJ2)
C
C  OCTOBER 1991.  SUN HAS LIMIT (SEEMS TO BE 2,046 WORDS) ON NUMBER OF
C  WORDS THAT CAN BE WRITTEN IN ONE RECORD.  ABOVE LINE REPLACED WITH
C  FOLLOWING BLOCK OF CODE.
C
      IF(MAXIJ2.LT.1)GOTO2299
      MAXWRD=100000
      IF(IHOST1.EQ.'SUN')MAXWRD=2046
      NLOOPF=(MAXIJ2/MAXWRD)+1
      IF(NLOOPF.LT.1)GOTO2297
      DO2292IK=1,NLOOPF
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXIJ2)GOTO2297
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXIJ2)JSTOP=MAXIJ2
      READ(IOUNIT) (V(IJ),IJ=JSTART,JSTOP)
 2292 CONTINUE
 2297 CONTINUE
 2299 CONTINUE
C  END CHANGE
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWAP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSWAP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,IOP3
 9013 FORMAT('IBUGS2,IOP3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)MAXN2,MAXCO2,MAXIJ2
 9014 FORMAT('MAXN2,MAXCO2,MAXIJ2 = ',3I8)
      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,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 ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSWA2(IOP3,IFILE,V,MAXIJ2,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--SWAP (WRITE OUT OR READ IN) THE VECTOR V(.)
C              FROM MASS STORAGE.
C              THIS IS A VARIATION OF DPSWAP.  THE DIFFERENCE
C              IS THAT THIS READS/WRITES AN ARBITRARY MATRIX,
C              NOT NECCESSARILY THE INTERNAL V MATRIX, WITH
C              MAXIJ2 DEFINING THE NUMBER OF VALUES TO READ/WRITE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST    1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IOP3
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DOUBLE PRECISION V(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOHO.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='DPSW'
      ISUBN2='A2  '
C
      ISUBN0='SWA2'
C
      IERROR='NO'
      IWIDTH=(-999)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWA2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSWA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,IOP3
   53 FORMAT('IBUGS2,IOP3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)V(1),V(2),V(3)
   54 FORMAT('V(1),V(2),V(3) = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)ISCRNU
   71 FORMAT('ISCRNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ISCRNA
   72 FORMAT('ISCRNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)ISCRST
   73 FORMAT('ISCRST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)ISCRFO
   74 FORMAT('ISCRFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)ISCRAC
   75 FORMAT('ISCRAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)ISCRFO
   76 FORMAT('ISCRFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)ISCRCS
   77 FORMAT('ISCRCS = ',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.'SWA2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ISCRNU
CCCCC PASS IN FILE NAME, RECIPE CODE USES MULTIPLE SCRATCH FILES.
CCCCC IFILE=ISCRNA
      ISTAT=ISCRST
      IFORM=ISCRFO
      IACCES=ISCRAC
      IPROT=ISCRPR
      ICURST=ISCRCS
C
      ISUBN0='SWA2'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWA2')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 SCRATCH FILE MAY EXIST  **
C               **********************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     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('***** IMPLEMENTATION ERROR IN DPSWA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED RECIPE OPERATION REQUIRES THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      BEHIND-THE-SCENES USE OF A SCRATCH FILE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      BUT THE USE OF SUCH A SCRATCH FILE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      CANNOT BE DONE BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      THE INTERNAL VARIABLE    ISCRST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      WHICH ALLOWS SUCH SCRATCH FILE USE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)
 1218 FORMAT('      HAS BEEN SET TO    NONE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)ISTAT,ISCRST
 1219 FORMAT('ISTAT,ISCRST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1220)
 1220 FORMAT('      PLEASE CONTACT THE DATAPLOT IMPLEMENTOR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1221)
 1221 FORMAT('      AND HAVE THE ISCRST SETTING CHANGED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)
 1222 FORMAT('      (FROM   NONE   TO   UNKNOWN)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)
 1223 FORMAT('      IN SUBROUTINE INITFO.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 20--                          **
C               **  BRANCH TO THE APPROPRIATE CASE--   **
C               **    1) WRITE OUT TO   MASS STORGE;   **
C               **    2) READ IN   FROM MASS STORAGE.  **
C               *****************************************
C
      ISTEPN='20'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOP3.EQ.'WRIT')GOTO2100
      GOTO2200
C
C               ******************************************
C               **  STEP 21--                           **
C               **  WRITE THE V(.) VECTOR               **
C               **  OUT TO THE MASS STORAGE FILE        **
C               **  WITH NUMERIC DESIGNATION    ISCRNU  **
C               ******************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1WRITE(ICOUT,999)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1CALL DPWRST('XXX','BUG ')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1WRITE(ICOUT,2191)
 2191 FORMAT('***** A SWAP OUT IS ABOUT TO BE EXECUTED.')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1CALL DPWRST('XXX','BUG ')
C
      IDEV='SCRA'
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
      IF(MAXIJ2.LT.1)GOTO2199
      MAXWRD=100000
      IF(IHOST1.EQ.'SUN')MAXWRD=2046
      NLOOPF=(MAXIJ2/MAXWRD)+1
      IF(NLOOPF.LT.1)GOTO2197
      DO2192IK=1,NLOOPF
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXIJ2)GOTO2197
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXIJ2)JSTOP=MAXIJ2
      WRITE(IOUNIT) (V(IJ),IJ=JSTART,JSTOP)
 2192 CONTINUE
 2197 CONTINUE
 2199 CONTINUE
C  END CHANGE
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
      GOTO9000
C
C               ******************************************
C               **  STEP 22--                           **
C               **  READ  THE V(.) VECTOR               **
C               **  IN FROM THE MASS STORAGE FILE       **
C               **  WITH NUMERIC DESIGNATION    ISCRNU  **
C               ******************************************
C
 2200 CONTINUE
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(MAXIJ2.LE.0)GOTO9000
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1WRITE(ICOUT,999)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1CALL DPWRST('XXX','BUG ')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1WRITE(ICOUT,2291)
 2291 FORMAT('***** A SWAP IN  IS ABOUT TO BE EXECUTED.')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
     1CALL DPWRST('XXX','BUG ')
C
      IDEV='SCRA'
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
      IF(MAXIJ2.LT.1)GOTO2299
      MAXWRD=100000
      IF(IHOST1.EQ.'SUN')MAXWRD=2046
      NLOOPF=(MAXIJ2/MAXWRD)+1
      IF(NLOOPF.LT.1)GOTO2297
      DO2292IK=1,NLOOPF
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXIJ2)GOTO2297
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXIJ2)JSTOP=MAXIJ2
      READ(IOUNIT) (V(IJ),IJ=JSTART,JSTOP)
 2292 CONTINUE
 2297 CONTINUE
 2299 CONTINUE
C  END CHANGE
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSWA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,IOP3
 9013 FORMAT('IBUGS2,IOP3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)MAXIJ2
 9014 FORMAT('MAXIJ2 = ',I8)
      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,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 ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSYMB(IHARG,NUMARG,
     1IDEFSY,
     1ITEXSY,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SYMBOL CHARACTER WHICH MAY
C              BE USED TO DENOTE IN-LINE TEXT SUB-COMMANDS.
C              WHEN A TEXT STRING IS PROCESSED,
C              IT IS SCANNED FOR THE SYMBOL CHARACTER;
C              IF IT IS FOUND, THE IN-LINE SUB-COMMAND
C              BEFORE THE SYMBOL CHARACTER IS EXECUTED
C              RATHER THAN THE LITERAL TEXT SUB-STRING BEING WRITTEN OUT.
C              ANY NUMBER OF SYMBOL CHARACTERS ARE ALLOWED PER LINE.
C              THE SYMBOL CHARACTER CAPABILITY ALLOWS THE ANALYST
C              TO WRITE GREEK, MATH, AND OTHER SPECIAL SYMBOLS.
C              THE SPECIFIED SYMBOL CHARACTER WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXSY.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFSY (A  CHARACTER VARIABLE)
C                     --IBUGD2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--ITEXSY (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFSY
      CHARACTER*4 ITEXSY
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSYMB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFSY
   53 FORMAT('IDEFSY = ',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
      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
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFSY
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ITEXSY=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE SYMBOL CHARACTER (TO DENOTE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT(' GREEK, MATH, AND OTHER SPECIAL SYMBOLS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('IN THE TEXT, TITLE, LABEL, AND LEGEND COMMANDS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)ITEXSY
 1184 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSYMB--')
      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)IDEFSY,ITEXSY
 9013 FORMAT('IDEFSY,ITEXSY = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSYMM(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A SYMMETRY PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--APRIL     1986.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
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 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IDATSW
CCCCC CHARACTER*4 IHP
CCCCC CHARACTER*4 IHP2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(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'
C
      ISUBN1='DPSY'
      ISUBN2='MM  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=3
C
      ICOLR=0
C
C               ***************************************
C               **  TREAT THE SYMMETRY    PLOT CASE  **
C               ***************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SYMM')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSYMM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ,ISUBRO
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='SYMM'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO111
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')RETURN
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')RETURN
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1CALL DPWRST('XXX','BUG ')
C
C               **************************************************************
C               **  STEP 4--                                                **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)     **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.                  **
C               **************************************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPSYMM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A SYMMETRY PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      RETURN
C
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
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='5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     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 DPSYMM')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      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)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SYMM')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ******************************************************
C               **  STEP 6--                                        **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS          **
C               **  INDICATES THAT THE VALUES IN THE                **
C               **  FIRST  VARIABLE ARE NOT DATA POINTS             **
C               **  BUT ALREADY-COMPUTED FREQUENCIES,               **
C               **  AND THE VALUES IN THE SECOND VARIABLE           **
C               **  ARE THE CORRESPONDING X VALUES FOR EACH         **
C               **  FREQUENCY.  IF WE HAVE THE 2-VARIABLE CASE,     **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.  **
C               ******************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IDATSW='RAW'
      IF(NUMV2.EQ.1)IDATSW='RAW'
      IF(NUMV2.EQ.1)GOTO590
      IF(NUMV2.EQ.2)IDATSW='FREQ'
      IF(NUMV2.EQ.2)GOTO509
      GOTO550
C
  509 CONTINUE
      IHRIGH=IHARG(2)
      IHRIG2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLR=IVALUE(ILOCV)
      NRIGHT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT
  511 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NRIGHT.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPSYMM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A SYMMETRY PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,559)
  559 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  560 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,561)
  561 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)NUMV2
  562 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,564)(IANS(I),I=1,IWIDTH)
  564 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPSYMM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A SYMMETRY PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)
  578 FORMAT('      WHEN HAVE 2 VARIABLES SPECIFIED, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,580)
  580 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      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  (FREQUENCIES)--')
      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  (HORIZ. AXIS VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHRIGH,IHRIG2,NRIGHT
  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)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  (BASED ON THE QUALIFIER)           **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     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,IERRO4)
      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
      IF(NUMV2.LE.1)GOTO651
      GOTO652
C
  651 CONTINUE
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)X1(J)=RES(I)
      GOTO660
C
  652 CONTINUE
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)X1(J)=RES(I)
      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)
      GOTO660
C
  660 CONTINUE
      NLOCAL=J
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
C               **  RESET THE VECTOR D(.) TO ALL ONES.             **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SYMM')GOTO5190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5111)
 5111 FORMAT('***** FROM THE MIDDLE  OF DPSYMM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5112)ICASPL,NUMV2,IDATSW,NPLOTP,NPLOTV
 5112 FORMAT('ICASPL,NUMV2,IDATSW,NPLOTP,NPLOTV = ',A4,I8,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO5190
      DO5115I=1,NPLOTP
      WRITE(ICOUT,5116)I,Y(I),X(I),D(I)
 5116 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 5115 CONTINUE
 5190 CONTINUE
C
      CALL DPSYM2(Y1,X1,NLOCAL,ICASPL,IDATSW,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SYMM')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSYMM--')
      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 ')
      IF(NPLOTP.LE.0)GOTO9090
      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
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSYM2(Y,X,N,ICASPL,IDATSW,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A SYMMETRY PLOT.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--APRIL     1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IDATSW
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRIT2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
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='DPSY'
      ISUBN2='M2  '
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 DPSYM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)N
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(N.GE.2)GOTO49
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)
   46 FORMAT('***** ERROR IN DPSYM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)
   47 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,48)
   48 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   49 CONTINUE
C
      HOLD=X(1)
      DO60I=1,N
      IF(X(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DPSYM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL INPUT VERTICAL AXIS 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.'OFF'.AND.ISUBRO.NE.'SYM2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPSYM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,IDATSW,N,NPLOTV
   72 FORMAT('ICASPL,IDATSW,N,NPLOTV = ',A4,2X,A4,2X,I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO90
      DO85I=1,N
      WRITE(ICOUT,86)I,Y(I),X(I)
   86 FORMAT('I,Y(I),X(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   85 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 4--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  AND DETERMINE PLOT COORDINATES  **
C               **************************************
C
      IF(IDATSW.EQ.'RAW')GOTO1100
      IF(IDATSW.EQ.'FREQ')GOTO2100
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPSYM2 ',
     1'AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      IDATSW SHOULD BE EITHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      RAW   OR    FREQ, BUT IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)IDATSW
 1014 FORMAT('      IDATSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ****************************************
C               **  STEP 4.1--                        **
C               **  DETERMINE PLOT COORDINATES        **
C               **  FOR THE 1-VARIABLE CASE           **
C               **  (THAT IS, FOR THE RAW DATA CASE)  **
C               ****************************************
C
 1100 CONTINUE
C
      IWRIT2='OFF'
      MAXND2=1000
      CALL MEDIAN(X,N,IWRIT2,D2,MAXND2,XMED,IBUGG3,IERROR)
      CALL SORT(X,N,D2)
C
      NHALFP=(N+1)/2
      DO1110I=1,NHALFP
      IREV=N-I+1
      Y2(I)=D2(IREV)-XMED
      X2(I)=XMED-D2(I)
 1110 CONTINUE
      DO1120I=1,NHALFP
      D2(I)=1.0
 1120 CONTINUE
      N2=NHALFP
      NPLOTV=2
      GOTO9000
C
C               ********************************************
C               **  STEP 4.2--                            **
C               **  DETERMINE PLOT COORDINATES            **
C               **  FOR THE 2-VARIABLE CASE               **
C               **  (THAT IS, FOR THE GROUPED DATA CASE)  **
C               ********************************************
C
 2100 CONTINUE
C
      CALL SORTC(X,Y,N,D2,Y2)
C
      SUM=0.0
      DO2110I=1,N
      SUM=SUM+Y(I)
 2110 CONTINUE
      NTOT=SUM+0.5
C
      IF(NTOT.LE.1000)GOTO2119
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPSYM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      FOR THE 2-VARIABLE (GROUPED) CASE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      THE UNGROUPED NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      IS TOO LARGE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)NTOT
 2116 FORMAT('      NTOT = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 2119 CONTINUE
C
      K=0
      DO2121I=1,N
      NI=Y2(I)+0.5
      IF(NI.LE.0)GOTO2121
      DO2122J=1,NI
      K=K+1
      X2(K)=D2(I)
 2122 CONTINUE
 2121 CONTINUE
C
      IWRIT2='OFF'
      MAXND2=1000
      CALL MEDIAN(X2,K,IWRIT2,D2,MAXND2,XMED,IBUGG3,IERROR)
      CALL SORT(X2,K,D2)
C
      KHALFP=(K+1)/2
      DO2130I=1,KHALFP
      IREV=K-I+1
      Y2(I)=D2(IREV)-XMED
      X2(I)=XMED-D2(I)
 2130 CONTINUE
      DO2140I=1,KHALFP
      D2(I)=1.0
 2140 CONTINUE
      N2=KHALFP
      NPLOTV=2
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'SYM2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSYM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IDATSW,N2,IERROR
 9012 FORMAT('ICASPL,IDATSW,N2,IERROR = ',A4,2X,A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NHALFP,NTOT,K,KHALFP
 9013 FORMAT('N,NHALFP,NTOT,K,KHALFP = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)N2,NPLOTV
 9014 FORMAT('N2,NPLOTV = ',2I8)
      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
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTABU(Y1,X1,MAXNXT,
     1ISEED,ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 4 KINDS OF TABULATIONS--
C              1) MEAN;
C              2) RANGE;
C              3) STANDARD DEVIATION;
C              4) COUNTS;
C              5) SUM.
C     NOTE   --COMMAND UPGRADED 8/2002 TO SUPPORT FULL RANGE OF
C              SUPPORTED STATISTICS (> 60 AS OF 8/2002)
C     THE OUTPUT WILL BE A TABLE OR ORDERED X VALUES
C     AND CORRESPONDING STATISTICS FOR EACH X VALUE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/11
C     ORIGINAL VERSION--OCTOBER   1987.
C     UPDATED         --JUNE      1990.  TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --APRIL     1993.  SUM
C     UPDATED         --AUGUST    2002.  ADDITIONAL STATISTICS
C     UPDATED         --MARCH     2003.  WEIGHTED MEAN, WEIGHTED SD,
C                                        WEIGHTED VARIANCE
C     UPDATED         --MARCH     2003.  35 "DIFFERENCE OF" STATISTICS
C     UPDATED         --APRIL     2003.  ADD SN AND QN (AND DIFFERENCE
C                                        OF), REQUIRES ADDITIONAL
C                                        SCRATCH ARRAYS
C     UPDATED         --MAY       2003.  ADD WEIGHTED TRIMMED MEAN
C     UPDATED         --OCTOBER   2004.  ADD KEDNELLS TAU
C     UPDATED         --FEBRUARY  2005.  ADD REPEATABILITY SD
C     UPDATED         --FEBRUARY  2005.  ADD REPRODUCABILITY SD
C     UPDATED         --SEPTEMBER 2005.  ADD RATIO
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASTA
      CHARACTER*40 ICTNAM
      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
CCCCC CHARACTER*4 IH
CCCCC CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
CCCCC CHARACTER*4 IHHR2
CCCCC CHARACTER*4 IHHR22
      CHARACTER*4 IHX
      CHARACTER*4 IHX2
C
      CHARACTER*4 IXVAR
      CHARACTER*4 IYVAR
C
      CHARACTER*8 IYNAM
      CHARACTER*8 IXNAM
      CHARACTER*8 IX1NAM
      CHARACTER*8 IX2NAM
C
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
C
      DIMENSION XH1DIS(MAXOBV)
      DIMENSION TEMP(MAXOBV)
      DIMENSION TEMPZ(MAXOBV)
      DIMENSION XTEMP1(MAXOBV)
      DIMENSION Z1(MAXOBV)
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      DIMENSION ITEMP1(MAXOBV)
      DIMENSION ITEMP2(MAXOBV)
      DIMENSION ITEMP3(MAXOBV)
      DIMENSION ITEMP4(MAXOBV)
      DIMENSION ITEMP5(MAXOBV)
      DIMENSION ITEMP6(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (GARBAG(IGARB1),XH1DIS(1))
      EQUIVALENCE (GARBAG(IGARB3),TEMP(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMPZ(1))
      EQUIVALENCE (GARBAG(IGARB5),XTEMP1(1))
      EQUIVALENCE (GARBAG(IGARB6),XTEMP2(1))
      EQUIVALENCE (GARBAG(IGARB7),Z1(1))
      EQUIVALENCE (GARBAG(IGARB8),XTEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5(1))
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOSU.INC'
      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
CCCCC MISCELLANEOUS CHANGES MADE IN MANY PLACES   APRIL 1993
CCCCC SHOULD USE ENTIRE ROUTINE                   APRIL 1993
C
      IERROR='NO'
C
      ISUBN1='DPTA'
      ISUBN2='BU  '
C
      IYNAM=' '
      IXNAM=' '
      IX1NAM=' '
      IX2NAM=' '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=1
C
      ICOLH=0
C
C               ************************************
C               **  TREAT THE TABULATION    CASE  **
C               ************************************
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TABU')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPTABU--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)ICASTA
   52   FORMAT('ICASTA = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ
   53   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TABU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *************************************
C               **  STEP 1.1--                     **
C               **  SEARCH FOR TABULATE COMMANDS   **
C               *************************************
C
      ICASTA='MEAN'
      IYVAR='ON'
      IXVAR='OFF'
C
      IF(ICOM.NE.'TABU')GOTO9000
C
      IF(IHARG(1).EQ.'NUMB'.AND.IHARG2(1).EQ.'ER  ')GOTO201
      IF(IHARG(1).EQ.'COUN'.AND.IHARG2(1).EQ.'T   ')GOTO201
      IF(IHARG(1).EQ.'COUN'.AND.IHARG2(1).EQ.'TS  ')GOTO201
      IF(IHARG(1).EQ.'SIZE'.AND.IHARG2(1).EQ.'    ')GOTO201
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SAMP'.AND.IHARG(2).EQ.'SIZE')GOTO202
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SUBS'.AND.IHARG(2).EQ.'SIZE')GOTO202
C
      IF(IHARG(1).EQ.'SUM '.AND.IHARG2(1).EQ.'    ')GOTO211
      IF(IHARG(1).EQ.'PROD'.AND.IHARG2(1).EQ.'UCT ')GOTO212
      IF(IHARG(1).EQ.'INTE'.AND.IHARG2(1).EQ.'GRAL')GOTO213
C
      IF(IHARG(1).EQ.'MIDR'.AND.IHARG2(1).EQ.'ANGE')GOTO221
      IF(IHARG(1).EQ.'MEAN'.AND.IHARG2(1).EQ.'    ')GOTO222
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'AVER'.AND.IHARG2(1).EQ.'AGE '.AND.
     1IHARG(2).EQ.'ABSO'.AND.
     1IHARG(3).EQ.'DEVI')GOTO413
      IF(IHARG(1).EQ.'AAD '.AND.IHARG2(1).EQ.'    ')GOTO414
C
      IF(IHARG(1).EQ.'AVER'.AND.IHARG2(1).EQ.'AGE ')GOTO222
      IF(IHARG(1).EQ.'MIDM'.AND.IHARG2(1).EQ.'EAN ')GOTO223
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'MEDI'.AND.IHARG2(1).EQ.'AN  '.AND.
     1IHARG(2).EQ.'ABSO'.AND.
     1IHARG(3).EQ.'DEVI')GOTO415
      IF(IHARG(1).EQ.'MAD '.AND.IHARG2(1).EQ.'    ')GOTO416
C
      IF(IHARG(1).EQ.'MEDI'.AND.IHARG2(1).EQ.'AN  ')GOTO224
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'TRIM'.AND.IHARG(2).EQ.'MEAN'.AND.
     1(IHARG(3).NE.'STAN'.AND.IHARG(4).NE.'ERRO'))GOTO225
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WIND'.AND.IHARG(2).EQ.'MEAN')GOTO226
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'MEAN')GOTO226
C
      IF(IHARG(1).EQ.'R   '.AND.IHARG2(1).EQ.'    ')GOTO241
      IF(IHARG(1).EQ.'RANG'.AND.IHARG2(1).EQ.'E   ')GOTO241
      IF(IHARG(1).EQ.'MINI'.AND.IHARG2(1).EQ.'MUM ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(IHARG(1).EQ.'MIN '.AND.IHARG2(1).EQ.'    ')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(IHARG(1).EQ.'MAXI'.AND.IHARG2(1).EQ.'MUM ')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
      IF(IHARG(1).EQ.'MAX '.AND.IHARG2(1).EQ.'    ')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'THE '.AND.IHARG(4).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'MEAN')GOTO253
      IF(IHARG(1).EQ.'VARI'.AND.IHARG2(1).EQ.'ANCE')GOTO254
      IF(IHARG(1).EQ.'VARI'.AND.IHARG2(1).EQ.'    ')GOTO254
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'VAR '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'THE '.AND.IHARG(4).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'VAR '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'VAR '.AND.IHARG(2).EQ.'MEAN')GOTO253
      IF(IHARG(1).EQ.'VAR '.AND.IHARG2(1).EQ.'    ')GOTO254
C
      IF(NUMARG.GE.5.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'OF  '.AND.IHARG(4).EQ.'THE '.AND.
     1IHARG(5).EQ.'MEAN')GOTO261
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'OF  '.AND.IHARG(4).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'MEAN')GOTO263
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'THE '.AND.IHARG(4).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'MEAN')GOTO263
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'MEAN')GOTO266
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI')GOTO264
      IF(IHARG(1).EQ.'SD  '.AND.IHARG2(1).EQ.'    ')GOTO265
      IF(IHARG(1).EQ.'S   '.AND.IHARG2(1).EQ.'    ')GOTO265
C
      IF(IHARG(1).EQ.'RS  '.AND.IHARG2(1).EQ.'    ')GOTO271
      IF(IHARG(1).EQ.'RSD '.AND.IHARG2(1).EQ.'    ')GOTO271
      IF(IHARG(1).EQ.'RELS'.AND.IHARG2(1).EQ.'    ')GOTO271
      IF(IHARG(1).EQ.'RELS'.AND.IHARG2(1).EQ.'D   ')GOTO271
      IF(IHARG(1).EQ.'RV  '.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RVAR'.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RELV'.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RELV'.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RELV'.AND.IHARG2(1).EQ.'AR  ')GOTO272
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'COEF'.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'VARI')GOTO273
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'COEF'.AND.IHARG(2).EQ.'VARI')GOTO274
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'SD  ')GOTO276
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO277
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'VAR ')GOTO278
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'VARI')GOTO278
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LOWE'.AND.IHARG(2).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'FIRS'.AND.IHARG(2).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SECO'.AND.IHARG(2).EQ.'QUAR')GOTO302
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'UPPE'.AND.IHARG(2).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'THIR'.AND.IHARG(2).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LOWE'.AND.IHARG(2).EQ.'HING')GOTO304
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'UPPE'.AND.IHARG(2).EQ.'HING')GOTO305
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'THIR'.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO311
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'3RD '.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO311
      IF(IHARG(1).EQ.'SKEW'.AND.IHARG2(1).EQ.'NESS')GOTO312
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'FOUR'.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO313
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'4TH '.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO313
      IF(IHARG(1).EQ.'KURT'.AND.IHARG2(1).EQ.'OSIS')GOTO314
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'AUTO'.AND.IHARG2(1).EQ.'COVA'.AND.
     1IHARG(2).EQ.'PLOT')GOTO321
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'AUTO'.AND.IHARG2(1).EQ.'CORR'.AND.
     1IHARG(2).EQ.'PLOT')GOTO322
C
      IF(IHARG(1).EQ.'COVA'.AND.IHARG2(1).EQ.'RIAN')GOTO331
      IF(IHARG(1).EQ.'CORR'.AND.IHARG2(1).EQ.'ELAT')GOTO332
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RANK'.AND.IHARG(2).EQ.'COVA')GOTO333
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RANK'.AND.IHARG(2).EQ.'CORR')GOTO334
      IF(IHARG(1).EQ.'COMO'.AND.IHARG2(1).EQ.'VEME')GOTO335
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RANK'.AND.IHARG(2).EQ.'COMO')GOTO336
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'KEND'.AND.IHARG(2).EQ.'TAU ')GOTO337
C
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'DECI')GOTO1111
      GOTO1119
 1111 CONTINUE
      IF(IHARG(1).EQ.'FIRS')GOTO341
      IF(IHARG(1).EQ.'SECO')GOTO342
      IF(IHARG(1).EQ.'THIR')GOTO343
      IF(IHARG(1).EQ.'FOUR')GOTO344
      IF(IHARG(1).EQ.'FIFT')GOTO345
      IF(IHARG(1).EQ.'SIXT')GOTO346
      IF(IHARG(1).EQ.'SEVE')GOTO347
      IF(IHARG(1).EQ.'EIGH')GOTO348
      IF(IHARG(1).EQ.'NINT')GOTO349
 1119 CONTINUE
C
      IF(IHARG(1).EQ.'PERC'.AND.IHARG(2).NE.'BEND'.AND.
     1  IHARG(2).NE.'DEFE')GOTO350
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SIN'.AND.IHARG(2).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SINE'.AND.IHARG(2).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SIN'.AND.IHARG(2).EQ.'AMP')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SINE'.AND.IHARG(2).EQ.'AMP')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SIN'.AND.IHARG(2).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SINE'.AND.IHARG(2).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'INTE')GOTO363
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'SLOP')GOTO364
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'RESS')GOTO365
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'CORR')GOTO366
C
      IF(IHARG(1).EQ.'SN'.AND.IHARG(2).EQ.'SCAL')GOTO493
      IF(IHARG(1).EQ.'QN'.AND.IHARG(2).EQ.'SCAL')GOTO495
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'TAGU')GOTO130
      GOTO139
  130 CONTINUE
      IF(IHARG(2).EQ.'SN')GOTO371
      IF(IHARG(2).EQ.'S/N')GOTO371
      IF(IHARG(2).EQ.'SN0')GOTO371
      IF(IHARG(2).EQ.'S/N0')GOTO371
      IF(IHARG(2).EQ.'SNT')GOTO371
      IF(IHARG(2).EQ.'S/NT')GOTO371
      IF(IHARG(2).EQ.'SN+')GOTO372
      IF(IHARG(2).EQ.'S/N+')GOTO372
      IF(IHARG(2).EQ.'SNL')GOTO372
      IF(IHARG(2).EQ.'SN-')GOTO373
      IF(IHARG(2).EQ.'S/N-')GOTO373
      IF(IHARG(2).EQ.'SNS')GOTO373
      IF(IHARG(2).EQ.'SN00')GOTO374
      IF(IHARG(2).EQ.'SNT2')GOTO374
      IF(IHARG(2).EQ.'S/N2')GOTO374
      IF(IHARG(2).EQ.'SN2')GOTO374
  139 CONTINUE
C
      IF(IHARG(1).EQ.'SN')GOTO381
      IF(IHARG(1).EQ.'S/N')GOTO381
      IF(IHARG(1).EQ.'SN0')GOTO381
      IF(IHARG(1).EQ.'S/N0')GOTO381
      IF(IHARG(1).EQ.'SNT')GOTO381
      IF(IHARG(1).EQ.'S/NT')GOTO381
      IF(IHARG(1).EQ.'SN+')GOTO382
      IF(IHARG(1).EQ.'S/N+')GOTO382
      IF(IHARG(1).EQ.'SNL ')GOTO382
      IF(IHARG(1).EQ.'SN-')GOTO383
      IF(IHARG(1).EQ.'S/N-')GOTO383
      IF(IHARG(1).EQ.'SNS')GOTO383
      IF(IHARG(1).EQ.'SN00')GOTO384
      IF(IHARG(1).EQ.'SNT2')GOTO384
      IF(IHARG(1).EQ.'S/N2')GOTO384
      IF(IHARG(1).EQ.'SN2')GOTO384
C
      IF(IHARG(1).EQ.'CP')GOTO401
      IF(IHARG(1).EQ.'CPK')GOTO402
      IF(IHARG(1).EQ.'CNPK')GOTO398
      IF(IHARG(1).EQ.'CPM')GOTO400
      IF(IHARG(1).EQ.'CC')GOTO399
      IF(IHARG(1).EQ.'CPL')GOTO396
      IF(IHARG(1).EQ.'CPU')GOTO397
      IF(NUMARG.GE.2)THEN
         IF(IHARG(1).EQ.'PERC'.AND.IHARG(2).EQ.'DEFE')GOTO403
         IF(IHARG(1).EQ.'EXPE'.AND.IHARG(2).EQ.'LOSS')GOTO404
      ENDIF
C
      IF(NUMARG.GE.2)THEN
         IF(IHARG(1).EQ.'NORM'.AND.IHARG(2).EQ.'PPCC')GOTO411
      ENDIF
C
      IF(IHARG(1).EQ.'EXTR')GOTO412
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GEOM'.AND.IHARG2(1).EQ.'ETRI'.AND.
     1IHARG(2).EQ.'MEAN')GOTO426
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'GEOM'.AND.IHARG2(1).EQ.'ETRI'.AND.
     1IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO436
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'HARM'.AND.IHARG(2).EQ.'MEAN')GOTO446
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'INTE'.AND.IHARG(2).EQ.'RANG')GOTO456
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'IQ  '.AND.IHARG(2).EQ.'RANG')GOTO456
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'LOCA')GOTO457
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'SCAL')GOTO458
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'VARI')GOTO459
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'SD')GOTO460
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'DEVI')
     1GOTO461
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'COVA')GOTO462
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'CORR')GOTO463
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'MIDV')GOTO464
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.
     1IHARG(2).EQ.'MIDC'.AND.IHARG2(2).EQ.'ORRE')GOTO471
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'MIDC')GOTO465
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'PERC'.AND.IHARG(2).EQ.'BEND'.AND.IHARG(3).EQ.'MIDV')
     1GOTO466
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'HODG'.AND.IHARG(2).EQ.'LEHM')GOTO467
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'QUAN'.AND.IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'ERRO')
     1GOTO468
C
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'QUAN')GOTO469
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'TRIM'.AND.IHARG(2).EQ.'MEAN'.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'ERRO')
     1GOTO470
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'PERC'.AND.IHARG(2).EQ.'BEND'.AND.IHARG(3).EQ.'CORR')
     1GOTO472
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'MEAN')GOTO486
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'SD')GOTO490
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO491
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'TRIM'.AND.
     1IHARG(3).EQ.'MEAB')GOTO492
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DIFF'.AND.IHARG(2).EQ.'OF')THEN
        IF(IHARG(3).EQ.'AVER'.AND.IHARG(4).EQ.'ABSO'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO623
        IF(IHARG(3).EQ.'AAD')GOTO523
        IF(IHARG(3).EQ.'MEAN' .OR. IHARG(3).EQ.'AVER')GOTO501
        IF(IHARG(3).EQ.'MIDM')GOTO502
        IF(IHARG(3).EQ.'MEDI'.AND.IHARG(4).EQ.'ABSO'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO624
        IF(IHARG(3).EQ.'MAD')GOTO524
        IF(IHARG(3).EQ.'MEDI')GOTO503
        IF(IHARG(3).EQ.'TRIM'.AND.IHARG(4).EQ.'MEAN')GOTO504
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'MEAN')GOTO505
        IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'MEAN')GOTO506
        IF(IHARG(3).EQ.'HARM'.AND.IHARG(4).EQ.'MEAN')GOTO507
        IF(IHARG(3).EQ.'HODG'.AND.IHARG(4).EQ.'LEHM')GOTO508
        IF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'LOCA')GOTO509
        IF(IHARG(3).EQ.'SD'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'THE'.AND.IHARG(6).EQ.'MEAN')GOTO738
        IF(IHARG(3).EQ.'SD'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'MEAN')GOTO638
        IF(IHARG(3).EQ.'SD'.AND.IHARG(4).EQ.'MEAN')GOTO538
        IF(IHARG(3).EQ.'SD')GOTO520
        IF(IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI')GOTO521
        IF(IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'THE'.AND.IHARG(6).EQ.'MEAN')GOTO740
        IF(IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'MEAN')GOTO640
        IF(IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'MEAN')GOTO540
        IF(IHARG(3).EQ.'VARI')GOTO522
        IF(IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'RANG')GOTO525
        IF(IHARG(3).EQ.'IQ  '.AND.IHARG(4).EQ.'RANG')GOTO525
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'STAN'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO626
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'SD')GOTO526
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'VARI')GOTO527
        IF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'MIDV')GOTO528
        IF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'SCAL')GOTO529
        IF(IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'BEND'.AND.
     1     IHARG(5).EQ.'MIDV')GOTO530
        IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'STAN'.AND.
     1     IHARG(4).EQ.'DEVI')GOTO631
        IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'SD')GOTO531
        IF(IHARG(3).EQ.'RANG')GOTO532
        IF(IHARG(3).EQ.'MIDR')GOTO533
        IF(IHARG(3).EQ.'QUAN')GOTO534
        IF(IHARG(3).EQ.'SKEW')GOTO535
        IF(IHARG(3).EQ.'KURT')GOTO536
        IF(IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'SD')GOTO537
        IF(IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'VARI')GOTO539
        IF(IHARG(3).EQ.'MINI')GOTO541
        IF(IHARG(3).EQ.'MAXI')GOTO542
        IF(IHARG(3).EQ.'EXTR')GOTO543
        IF(IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'VARI')GOTO554
        IF(IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'VARI')GOTO544
        IF(IHARG(3).EQ.'SN'.AND.IHARG(4).EQ.'SCAL')GOTO645
        IF(IHARG(3).EQ.'SN')GOTO545
        IF(IHARG(3).EQ.'QN'.AND.IHARG(4).EQ.'SCAL')GOTO646
        IF(IHARG(3).EQ.'QN')GOTO546
        IF(IHARG(3).EQ.'SUM')GOTO551
        IF(IHARG(3).EQ.'SUMS')GOTO551
CCCCC   SIZE MAKES NO SENSE IN THIS CONTEXT (GROUP SIZE ARE EQUAL
CCCCC   FOR BOTH VARIABLES, SO ALWAYS ZERO)
CCCCC   IF(IHARG(3).EQ.'SIZE')GOTO552
CCCCC   IF(IHARG(3).EQ.'NUMB')GOTO552
CCCCC   IF(IHARG(3).EQ.'COUN')GOTO552
      ENDIF
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'REPE'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO561
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'REPE'.AND.IHARG(2).EQ.'SD  ')GOTO562
C
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'REPE')GOTO563
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'REPR'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO564
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'REPR'.AND.IHARG(2).EQ.'SD  ')GOTO565
C
      IF(IHARG(1).EQ.'REPR')GOTO566
C
      IF(IHARG(1).EQ.'RATI')GOTO567
C
C               *************************************
C               **  STEP 1.99--                    **
C               **  SINCE NO KEYWORD FOUND,        ZZ
C               **  SET THE DEFAULT                **
C               ** (TABULATE COUNT)                **
C               *************************************
C
      GOTO480
C
C               **********************
C               **  STEP 2--        **
C               **  DEFINE ICASTA.  **
C               **********************
C
  200 CONTINUE
      ICASTA='COUN'
      ICTNAM='COUNT'
      IYVAR='OFF'
      IXVAR='OFF'
      GOTO110
C
  201 CONTINUE
      ICASTA='NUMB'
      ICTNAM='COUNT'
      IYVAR='OFF'
      GOTO111
C
  202 CONTINUE
      ICASTA='NUMB'
      ICTNAM='COUNT'
      IYVAR='OFF'
      GOTO112
C
  211 CONTINUE
      ICASTA='SUM'
      ICTNAM='SUM'
      GOTO111
C
  212 CONTINUE
      ICASTA='PROD'
      ICTNAM='PRODUCT'
      GOTO111
C
  213 CONTINUE
      ICASTA='INTE'
      ICTNAM='INTEGRAL'
      GOTO111
C
  221 CONTINUE
      ICASTA='MIDR'
      ICTNAM='MID-RANGE'
      GOTO111
C
  222 CONTINUE
      ICASTA='MEAN'
      ICTNAM='MEAN'
      GOTO111
C
  223 CONTINUE
      ICASTA='MIDM'
      ICTNAM='MID-MEAN'
      GOTO111
C
  224 CONTINUE
      ICASTA='MEDI'
      ICTNAM='MEDIAN'
      GOTO111
C
  225 CONTINUE
      ICASTA='TRIM'
      ICTNAM='TRIMMED MEAN'
      GOTO112
C
  226 CONTINUE
      ICASTA='WINM'
      ICTNAM='WINSORIZED MEAN'
      GOTO112
C
  241 CONTINUE
      ICASTA='RANG'
      ICTNAM='RANGE'
      GOTO111
C
  242 CONTINUE
      ICASTA='MINI'
      ICTNAM='MINIMUM'
      GOTO111
C
  243 CONTINUE
      ICASTA='MAXI'
      ICTNAM='MAXIMUM'
      GOTO111
C
  251 CONTINUE
      ICASTA='VAME'
      ICTNAM='VARIANCE OF THE MEAN'
      GOTO114
C
  252 CONTINUE
      ICASTA='VAME'
      ICTNAM='VARIANCE OF THE MEAN'
      GOTO113
C
  253 CONTINUE
      ICASTA='VAME'
      ICTNAM='VARIANCE OF THE MEAN'
      GOTO112
C
  254 CONTINUE
      ICASTA='VARI'
      ICTNAM='VARIANCE'
      GOTO111
C
  261 CONTINUE
      ICASTA='SDME'
      ICTNAM='SD OF THE MEAN'
      GOTO115
C
  262 CONTINUE
      ICASTA='SDME'
      ICTNAM='SD OF THE MEAN'
      GOTO114
C
  263 CONTINUE
      ICASTA='SDME'
      ICTNAM='SD OF THE MEAN'
      GOTO113
C
  264 CONTINUE
      ICASTA='SD'
      ICTNAM='STANDARD DEVIATION'
      GOTO112
C
  265 CONTINUE
      ICASTA='SD'
      ICTNAM='STANDARD DEVIATION'
      GOTO111
C
  266 CONTINUE
      ICASTA='SDME'
      ICTNAM='SD OF THE MEAN'
      GOTO112
C
  271 CONTINUE
      ICASTA='RESD'
      ICTNAM='RELATIVE SD'
      GOTO111
C
  272 CONTINUE
      ICASTA='REVA'
      ICTNAM='RELATIVE VARIANCE'
      GOTO111
C
  273 CONTINUE
      ICASTA='CVAR'
      ICTNAM='COEFFICENT OF VARIATION'
      GOTO113
C
  274 CONTINUE
      ICASTA='CVAR'
      ICTNAM='COEFFICIENT OF VARIATION'
      GOTO112
C
  276 CONTINUE
      ICASTA='RESD'
      ICTNAM='RELATIVE SD'
      GOTO112
C
  277 CONTINUE
      ICASTA='RESD'
      ICTNAM='RELATIVE SD'
      GOTO113
C
  278 CONTINUE
      ICASTA='REVA'
      ICTNAM='RELATIVE VARIANCE'
      GOTO112
C
  301 CONTINUE
      ICASTA='LOWQ'
      ICTNAM='LOWER QUARTILE'
      GOTO112
C
  302 CONTINUE
      ICASTA='MIDQ'
      ICTNAM='MID-QUANTILE'
      GOTO112
C
  303 CONTINUE
      ICASTA='UPPQ'
      ICTNAM='UPPER QUARTILE'
      GOTO112
C
  304 CONTINUE
      ICASTA='LOWH'
      ICTNAM='LOWER HINGE'
      GOTO112
C
  305 CONTINUE
      ICASTA='UPPH'
      ICTNAM='UPPER HINGE'
      GOTO112
C
  311 CONTINUE
      ICASTA='SKEW'
      ICTNAM='SKEWNESS'
      GOTO114
C
  312 CONTINUE
      ICASTA='SKEW'
      ICTNAM='SKEWNESS'
      GOTO111
C
  313 CONTINUE
      ICASTA='KURT'
      ICTNAM='KURTOSIS'
      GOTO114
C
  314 CONTINUE
      ICASTA='KURT'
      ICTNAM='KURTOSIS'
      GOTO111
C
  321 CONTINUE
      ICASTA='AUCV'
      ICTNAM='AUTOCOVARIANCE'
      GOTO111
C
  322 CONTINUE
      ICASTA='AUCR'
      ICTNAM='AUTOCORRELATION'
      GOTO111
C
  331 CONTINUE
      ICASTA='COVA'
      IXVAR='ON'
      ICTNAM='COVARIANCE'
      GOTO111
C
  332 CONTINUE
      ICASTA='CORR'
      IXVAR='ON'
      ICTNAM='CORRELATION'
      GOTO111
C
  333 CONTINUE
      ICASTA='RACV'
      IXVAR='ON'
      ICTNAM='RANK COVARIANCE'
      GOTO112
C
  334 CONTINUE
      ICASTA='RACR'
      IXVAR='ON'
      ICTNAM='RANK CORRELATION'
      GOTO112
C
  335 CONTINUE
      ICASTA='COMO'
      IXVAR='ON'
      ICTNAM='COMOVEMENT'
      GOTO111
C
  336 CONTINUE
      ICASTA='RACO'
      IXVAR='ON'
      ICTNAM='RANK COMOVEMENT'
      GOTO112
C
  337 CONTINUE
      ICASTA='KTAU'
      IXVAR='ON'
      ICTNAM='KENDELLS TAU'
      GOTO112
C
  341 CONTINUE
      ICASTA='1DEC'
      ICTNAM='FIRST DECILE'
      GOTO112
C
  342 CONTINUE
      ICASTA='2DEC'
      ICTNAM='SECOND DECILE'
      GOTO112
C
  343 CONTINUE
      ICASTA='3DEC'
      ICTNAM='THIRD DECILE'
      GOTO112
C
  344 CONTINUE
      ICASTA='4DEC'
      ICTNAM='FOURTH DECILE'
      GOTO112
C
  345 CONTINUE
      ICASTA='5DEC'
      ICTNAM='FIFTH DECILE'
      GOTO112
C
  346 CONTINUE
      ICASTA='6DEC'
      ICTNAM='SIXTH DECILE'
      GOTO112
C
  347 CONTINUE
      ICASTA='7DEC'
      ICTNAM='SEVENTH DECILE'
      GOTO112
C
  348 CONTINUE
      ICASTA='8DEC'
      ICTNAM='EIGHTH DECILE'
      GOTO112
C
  349 CONTINUE
      ICASTA='9DEC'
      ICTNAM='NINTH DECILE'
      GOTO112
C
  350 CONTINUE
      ICASTA='PERC'
      ICTNAM='PERCENTILE'
      GOTO111
C
  361 CONTINUE
      ICASTA='SIFR'
      ICTNAM='SINE FREQUENCY'
      GOTO112
C
  362 CONTINUE
      ICASTA='SIAM'
      ICTNAM='SINE AMPLITUDE'
      GOTO112
C
  363 CONTINUE
      ICASTA='LIIN'
      IXVAR='ON'
      ICTNAM='LINEAR INTERCEPT'
      GOTO112
C
  364 CONTINUE
      ICASTA='LISL'
      IXVAR='ON'
      ICTNAM='LINEAR SLOPE'
      GOTO112
C
  365 CONTINUE
      ICASTA='LIRE'
      IXVAR='ON'
      ICTNAM='LINEAR RESSD'
      GOTO112
C
  366 CONTINUE
      ICASTA='LICO'
      IXVAR='ON'
      ICTNAM='LINEAR CORRELATION'
      GOTO112
C
  371 CONTINUE
      ICASTA='SN0'
      ICTNAM='SN0'
      GOTO112
C
  372 CONTINUE
      ICASTA='SN+'
      ICTNAM='SN+'
      GOTO112
C
  373 CONTINUE
      ICASTA='SN-'
      ICTNAM='SN-'
      GOTO112
C
  374 CONTINUE
      ICASTA='SN00'
      ICTNAM='SN00'
      GOTO112
C
  381 CONTINUE
      ICASTA='SN0'
      ICTNAM='SN0'
      GOTO111
C
  382 CONTINUE
      ICASTA='SN+'
      ICTNAM='SN+'
      GOTO111
C
  383 CONTINUE
      ICASTA='SN-'
      ICTNAM='SN-'
      GOTO111
C
  384 CONTINUE
      ICASTA='SN00'
      ICTNAM='SN00'
      GOTO111
C
  396 CONTINUE
      ICASTA='CPL'
      ICTNAM='CPL'
      GOTO111
C
  397 CONTINUE
      ICASTA='CPU'
      ICTNAM='CPU'
      GOTO111
C
  398 CONTINUE
      ICASTA='CNPK'
      ICTNAM='CNPK'
      GOTO111
C
  399 CONTINUE
      ICASTA='CC'
      ICTNAM='CC'
      GOTO111
C
  400 CONTINUE
      ICASTA='CPM'
      ICTNAM='CPM'
      GOTO111
C
  401 CONTINUE
      ICASTA='CP'
      ICTNAM='CP'
      GOTO111
C
  402 CONTINUE
      ICASTA='CPK'
      ICTNAM='CPK'
      GOTO111
C
  403 CONTINUE
      ICASTA='PEDE'
      ICTNAM='PERCENT DEFECTIVE'
      GOTO112
C
  404 CONTINUE
      ICASTA='EXLO'
      ICTNAM='EXPECTED LOSS'
      GOTO112
C
  411 CONTINUE
      ICASTA='NOPP'
      ICTNAM='NORMAL PPCC'
      GOTO112
C
  412 CONTINUE
      ICASTA='EXTR'
      ICTNAM='EXTREME'
      GOTO111
C
  413 CONTINUE
      ICASTA='AAD '
      ICTNAM='AVERAGE ABSOLUTE DEVIATION'
      GOTO113
C
  414 CONTINUE
      ICASTA='AAD '
      ICTNAM='AVERAGE ABSOLUTE DEVIATION'
      GOTO111
C
  415 CONTINUE
      ICASTA='MAD '
      ICTNAM='MEDIAN ABSOLUTE DEVIATION'
      GOTO113
C
  416 CONTINUE
      ICASTA='MAD '
      ICTNAM='MEDIAN ABSOLUTE DEVIATION'
      GOTO111
C
  426 CONTINUE
      ICASTA='GEME'
      ICTNAM='GEOMETRIC MEAN'
      GOTO112
C
  436 CONTINUE
      ICASTA='GESD'
      ICTNAM='GEOMETRIC STANDARD DEVIATION'
      GOTO113
C
  446 CONTINUE
      ICASTA='HAME'
      ICTNAM='HARMONIC MEAN'
      GOTO112
C
  456 CONTINUE
      ICASTA='IQRA'
      ICTNAM='INTERQUARTILE RANGE'
      GOTO112
C
  457 CONTINUE
      ICASTA='BILO'
      ICTNAM='BIWEIGHT LOCATION'
      GOTO112
C
  458 CONTINUE
      ICASTA='BISC'
      ICTNAM='BIWEIGHT SCALE'
      GOTO112
C
  459 CONTINUE
      ICASTA='WIVA'
      ICTNAM='WINSORIZED VARIANCE'
      GOTO112
C
  460 CONTINUE
      ICASTA='WISD'
      ICTNAM='WINSORIZED SD'
      GOTO112
C
  461 CONTINUE
      ICASTA='WISD'
      ICTNAM='WINSORIZED SD'
      GOTO113
C
  462 CONTINUE
      ICASTA='WICV'
      IXVAR='ON'
      ICTNAM='WINSORIZED COVARIANCE'
      GOTO112
C
  463 CONTINUE
      ICASTA='WICR'
      IXVAR='ON'
      ICTNAM='WINSORIZED CORRELATION'
      GOTO112
C
  464 CONTINUE
      ICASTA='BIMV'
      ICTNAM='BIWEIGHT MIDVARIANCE'
      GOTO112
C
  465 CONTINUE
      ICASTA='BIMC'
      IXVAR='ON'
      ICTNAM='BIWEIGHT MIDCOVARIANCE'
      GOTO112
C
  466 CONTINUE
      ICASTA='PBMV'
      ICTNAM='PERCENTAGE BEND MIDVARIANCE'
      GOTO113
C
  467 CONTINUE
      ICASTA='HLEH'
      ICTNAM='HODGES-LEHMAN'
      GOTO112
C
  468 CONTINUE
      ICASTA='QUSE'
      ICTNAM='QUANTILE STANDARD ERROR'
      GOTO113
C
  469 CONTINUE
      ICASTA='QUAN'
      ICTNAM='QUANTILE'
      GOTO111
C
  470 CONTINUE
      ICASTA='TMSE'
      ICTNAM='TRIMMED MEAN STANDARD ERROR'
      GOTO114
C
  471 CONTINUE
      ICASTA='BICR'
      IXVAR='ON'
      ICTNAM='BIWEIGHT CORRELATION'
      GOTO112
C
  472 CONTINUE
      ICASTA='PBCR'
      ICTNAM='PERCENTAGE BEND CORRELATION'
      IXVAR='ON'
      GOTO113
C
  480 CONTINUE
      ICASTA='COUN'
      ICTNAM='COUNTS'
      IYVAR='OFF'
      IXVAR='OFF'
      GOTO110
C
  486 CONTINUE
      ICASTA='WEME'
      ICTNAM='WEIGHTED MEAN'
      IXVAR='ON'
      GOTO112
C
  488 CONTINUE
      ICASTA='WEVA'
      ICTNAM='WEIGHTED VARIANCE'
      IXVAR='ON'
      GOTO112
C
  490 CONTINUE
      ICASTA='WESD'
      ICTNAM='WEIGHTED STANDARD DEVIATION'
      IXVAR='ON'
      GOTO112
C
  491 CONTINUE
      ICASTA='WESD'
      ICTNAM='WEIGHTED STANDARD DEVIATION'
      IXVAR='ON'
      GOTO113
C
  492 CONTINUE
      ICASTA='WETM'
      ICTNAM='WEIGHTED TRIMMED MEAN'
      IXVAR='ON'
      GOTO113
C
  493 CONTINUE
      ICASTA='SNSC'
      ICTNAM='SN'
      GOTO112
C
  495 CONTINUE
      ICASTA='QNSC'
      ICTNAM='QN'
      GOTO112
C
  501 CONTINUE
      ICASTA='DMEA'
      ICTNAM='DIFFERENCE OF MEANS'
      IXVAR='ON'
      GOTO113
C
  502 CONTINUE
      ICASTA='DMDM'
      ICTNAM='DIFFERENCE OF MIDMEANS'
      IXVAR='ON'
      GOTO113
C
  503 CONTINUE
      ICASTA='DMED'
      ICTNAM='DIFFERENCE OF MEDIAN'
      IXVAR='ON'
      GOTO113
C
  504 CONTINUE
      ICASTA='DTRM'
      ICTNAM='DIFFERENCE OF TRIMMED MEANS'
      IXVAR='ON'
      GOTO114
C
  505 CONTINUE
      ICASTA='DWNM'
      ICTNAM='DIFFERENCE OF WINSORIZED MEANS'
      IXVAR='ON'
      GOTO114
C
  506 CONTINUE
      ICASTA='DGEO'
      ICTNAM='DIFFERENCE OF GEOMETRIC MEANS'
      IXVAR='ON'
      GOTO114
C
  507 CONTINUE
      ICASTA='DHAR'
      ICTNAM='DIFFERENCE OF HARMONIC MEANS'
      IXVAR='ON'
      GOTO114
C
  508 CONTINUE
      ICASTA='DHDL'
      ICTNAM='DIFFERENCE OF HODGES-LEHMANN'
      IXVAR='ON'
      GOTO114
C
  509 CONTINUE
      ICASTA='DBIW'
      ICTNAM='DIFFERENCE OF BIWEIGHT LOCATION'
      IXVAR='ON'
      GOTO114
C
  520 CONTINUE
      ICASTA='DSD '
      ICTNAM='DIFFERENCE OF STANDARD DEVIATIONS'
      IXVAR='ON'
      GOTO113
C
  521 CONTINUE
      ICASTA='DSD '
      ICTNAM='DIFFERENCE OF STANDARD DEVIATIONS'
      IXVAR='ON'
      GOTO114
C
  522 CONTINUE
      ICASTA='DVAR'
      ICTNAM='DIFFERENCE OF VARIANCES'
      IXVAR='ON'
      GOTO113
C
  623 CONTINUE
      ICASTA='DAAD'
      ICTNAM='DIFFERENCE OF AVERAGE ABSOLUTE DEVIATIONS'
      IXVAR='ON'
      GOTO115
C
  523 CONTINUE
      ICASTA='DAAD'
      ICTNAM='DIFFERENCE OF AVERAGE ABSOLUTE DEVIATIONS'
      IXVAR='ON'
      GOTO113
C
  624 CONTINUE
      ICASTA='MAAD'
      ICTNAM='DIFFERENCE OF MEDIAN ABSOLUTE DEVIATIONS'
      IXVAR='ON'
      GOTO115
C
  524 CONTINUE
      ICASTA='DMAD'
      ICTNAM='DIFFERENCE OF MEDIAN ABSOLUTE DEVIATIONS'
      IXVAR='ON'
      GOTO113
C
  525 CONTINUE
      ICASTA='DIQR'
      ICTNAM='DIFFERENCE OF INTERQUARTILE RANGES'
      IXVAR='ON'
      GOTO114
C
  626 CONTINUE
      ICASTA='DWSD'
      ICTNAM='DIFFERENCE OF WINSORIZED SD'
      IXVAR='ON'
      GOTO115
C
  526 CONTINUE
      ICASTA='DWSD'
      ICTNAM='DIFFERENCE OF WINSORIZED SD'
      IXVAR='ON'
      GOTO114
C
  527 CONTINUE
      ICASTA='DWVA'
      ICTNAM='DIFFERENCE OF WINSORIZED VARIANCES'
      IXVAR='ON'
      GOTO114
C
  528 CONTINUE
      ICASTA='DBIM'
      ICTNAM='DIFFERENCE OF BIWEIGHT MIDVARIANCES'
      IXVAR='ON'
      GOTO114
C
  529 CONTINUE
      ICASTA='DBIS'
      ICTNAM='DIFFERENCE OF BIWEIGHT SCALE'
      IXVAR='ON'
      GOTO114
C
  530 CONTINUE
      ICASTA='DPBN'
      ICTNAM='DIFFERENCE OF PERCENTAGE BEND MIDVARIANCE'
      IXVAR='ON'
      GOTO115
C
  631 CONTINUE
      ICASTA='DGSD'
      ICTNAM='DIFFERENCE OF GEOMETRIC SD'
      IXVAR='ON'
      GOTO115
C
  531 CONTINUE
      ICASTA='DGSD'
      ICTNAM='DIFFERENCE OF GEOMETRIC SD'
      IXVAR='ON'
      GOTO114
C
  532 CONTINUE
      ICASTA='DRAN'
      ICTNAM='DIFFERENCE OF RANGES'
      IXVAR='ON'
      GOTO113
C
  533 CONTINUE
      ICASTA='DMDR'
      ICTNAM='DIFFERENCE OF MIDRANGES'
      IXVAR='ON'
      GOTO113
C
  534 CONTINUE
      ICASTA='DQUA'
      ICTNAM='DIFFERENCE OF QUANTILES'
      IXVAR='ON'
      GOTO113
C
  535 CONTINUE
      ICASTA='DSKE'
      ICTNAM='DIFFERENCE OF SKEWNESS'
      IXVAR='ON'
      GOTO113
C
  536 CONTINUE
      ICASTA='DKUR'
      ICTNAM='DIFFERENCE OF KURTOSIS'
      IXVAR='ON'
      GOTO113
C
  537 CONTINUE
      ICASTA='DRSD'
      ICTNAM='DIFFERENCE OF RELATIVE SD'
      IXVAR='ON'
      GOTO114
C
  738 CONTINUE
      ICASTA='DSDM'
      ICTNAM='DIFFERENCE OF SD OF THE MEAN'
      IXVAR='ON'
      GOTO116
C
  638 CONTINUE
      ICASTA='DSDM'
      ICTNAM='DIFFERENCE OF SD OF THE MEAN'
      IXVAR='ON'
      GOTO115
C
  538 CONTINUE
      ICASTA='DSDM'
      ICTNAM='DIFFERENCE OF SD OF THE MEAN'
      IXVAR='ON'
      GOTO114
C
  539 CONTINUE
      ICASTA='DRVA'
      ICTNAM='DIFFERENCE OF RELATIVE VARIANCES'
      IXVAR='ON'
      GOTO114
C
  740 CONTINUE
      ICASTA='DVAM'
      ICTNAM='DIFFERENCE OF VARIANCE OF THE MEANS'
      IXVAR='ON'
      GOTO116
C
  640 CONTINUE
      ICASTA='DVAM'
      ICTNAM='DIFFERENCE OF VARIANCE OF THE MEANS'
      IXVAR='ON'
      GOTO115
C
  540 CONTINUE
      ICASTA='DVAM'
      ICTNAM='DIFFERENCE OF VARIANCE OF THE MEANS'
      IXVAR='ON'
      GOTO114
C
  541 CONTINUE
      ICASTA='DMIN'
      ICTNAM='DIFFERENCE OF MINIMUMS'
      IXVAR='ON'
      GOTO113
C
  542 CONTINUE
      ICASTA='DMAX'
      ICTNAM='DIFFERENCE OF MAXIMUMS'
      IXVAR='ON'
      GOTO113
C
  543 CONTINUE
      ICASTA='DEXT'
      ICTNAM='DIFFERENCE OF EXTREMES'
      IXVAR='ON'
      GOTO113
C
  554 CONTINUE
      ICASTA='DCVA'
      ICTNAM='DIFFERENCE OF COEFFICIENT OF VARIATION'
      IXVAR='ON'
      GOTO115
C
  544 CONTINUE
      ICASTA='DCVA'
      ICTNAM='DIFFERENCE OF COEFFICIENT OF VARIATION'
      IXVAR='ON'
      GOTO114
C
  645 CONTINUE
      ICASTA='DSN'
      ICTNAM='DIFFERENCE OF SN'
      IXVAR='ON'
      GOTO114
C
  545 CONTINUE
      ICASTA='DSN'
      ICTNAM='DIFFERENCE OF SN'
      IXVAR='ON'
      GOTO113
C
  646 CONTINUE
      ICASTA='DQN'
      ICTNAM='DIFFERENCE OF QN'
      IXVAR='ON'
      GOTO114
C
  546 CONTINUE
      ICASTA='DQN'
      ICTNAM='DIFFERENCE OF QN'
      IXVAR='ON'
      GOTO113
C
  551 CONTINUE
      ICASTA='DSUM'
      ICTNAM='DIFFERENCE OF SUM'
      IXVAR='ON'
      GOTO113
C
  552 CONTINUE
      ICASTA='DCOU'
      ICTNAM='DIFFERENCE OF COUNTS'
      IXVAR='ON'
      GOTO113
C
  561 CONTINUE
      ICASTA='REPE'
      ICTNAM='REPEATABILITY STANDARD DEVIATION'
      IXVAR='ON'
      GOTO113
C
  562 CONTINUE
      ICASTA='REPE'
      ICTNAM='REPEATABILITY STANDARD DEVIATION'
      IXVAR='ON'
      GOTO112
C
  563 CONTINUE
      ICASTA='REPE'
      ICTNAM='REPEATABILITY STANDARD DEVIATION'
      IXVAR='ON'
      GOTO111
C
  564 CONTINUE
      ICASTA='REPR'
      ICTNAM='REPRODUCABILITY STANDARD DEVIATION'
      IXVAR='ON'
      GOTO113
C
  565 CONTINUE
      ICASTA='REPR'
      ICTNAM='REPRODUCABILITY STANDARD DEVIATION'
      IXVAR='ON'
      GOTO112
C
  566 CONTINUE
      ICASTA='REPR'
      ICTNAM='REPRODUCABILITY STANDARD DEVIATION'
      IXVAR='ON'
      GOTO111
C
  567 CONTINUE
      ICASTA='RATI'
      ICTNAM='RATIO'
      IXVAR='ON'
      GOTO111
C
  110 CONTINUE
      ILASTC=0
      GOTO180
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  114 CONTINUE
      ILASTC=4
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  115 CONTINUE
      ILASTC=5
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  116 CONTINUE
      ILASTC=6
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TABU')
     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(IBUGA2.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(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TABU')THEN
        WRITE(ICOUT,1211)IHLEFT,ICOLL,NLEFT
 1211   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 1 OR LARGER. **
C               ********************************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TABU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPTABU--THE INPUT NUMBER OF OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1313)ICTNAM
 1313   FORMAT('      (FOR WHICH A ',A30,' TABULATION WAS TO')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1315)MINN2
 1315   FORMAT('      HAVE BEEN FORMED MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1316)
 1316   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1317)
 1317   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1318)(IANS(I),I=1,MIN(80,IWIDTH))
 1318     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(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TABU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1480
      DO1400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1420
 1400 CONTINUE
      GOTO1490
 1410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1490
 1420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1490
C
 1480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('***** INTERNAL ERROR IN DPTABU')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)
 1482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1483)
 1483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1484)
 1484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1485)NUMARG
 1485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1486)
 1486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,1487)(IANS(I),I=1,MIN(80,IWIDTH))
 1487   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TABU')THEN
        WRITE(ICOUT,1491)NUMARG,ILOCQ,ICASEQ
 1491   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************************************
C               **  STEP 24.5--                        **
C               **  DETERMINE THE NUMBER OF VARIABLES  **
C               *****************************************
C
      ISTEPN='24.5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
C
C               ******************************************************
C               **  STEP 25--                                       **
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, STANDARD DEVIATION,
C               **  ETC.  IN THE RESULTING STATISTIC 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='25'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(IYVAR.EQ.'OFF'.AND.IXVAR.EQ.'OFF')THEN
        NUMEXP=1
        ITAG1=1
        IY=0
        IX=0
      ELSEIF(IYVAR.EQ.'ON'.AND.IXVAR.EQ.'OFF')THEN
        NUMEXP=2
        ITAG1=2
        IY=1
        IX=0
      ELSEIF(IYVAR.EQ.'ON'.AND.IXVAR.EQ.'ON')THEN
        NUMEXP=3
        ITAG1=3
        IY=1
        IX=2
      ELSE
        NUMEXP=1
        ITAG1=1
        IY=0
        IX=0
      ENDIF
C
 2510 CONTINUE
      IF(NUMEXP.NE.NUMV2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2511)
 2511   FORMAT('***** ERROR IN DPTABU--FOR THIS TABULATE ...')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2518)NUMEXP
 2518   FORMAT('      THE EXPECTED NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2520)
 2520   FORMAT('      SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2521)NUMV2
 2521   FORMAT('      THE SPECIFIED NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2523)
 2523   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2524)(IANS(I),I=1,MIN(80,IWIDTH))
 2524     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      NPTS=NLEFT
      IF(IYVAR.EQ.'ON')THEN
        IHLEFT=IHARG(IY)
        IHLEF2=IHARG2(IY)
        IYNAM(1:4)=IHLEFT
        IYNAM(5:8)=IHLEF2
        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(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TABU')THEN
          WRITE(ICOUT,2541)IHLEFT,ICOLL,NLEFT
 2541     FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
      IF(IXVAR.EQ.'ON')THEN
        IHX=IHARG(IX)
        IHX2=IHARG2(IX)
        IXNAM(1:4)=IHX
        IXNAM(5:8)=IHX2
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHX,IHX2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLX=IVALUE(ILOCV)
        NX=IN(ILOCV)
        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TABU')THEN
          WRITE(ICOUT,2546)IHX,ICOLX,NX
 2546     FORMAT('IHX,ICOLX,NX   = ',A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
      IHHOR=IHARG(ITAG1)
      IHHOR2=IHARG2(ITAG1)
      IX1NAM(1:4)=IHHOR
      IX1NAM(5:8)=IHHOR2
      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(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TABU')THEN
        WRITE(ICOUT,2551)IHHOR,ICOLH,NHOR
 2551   FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IXVAR.EQ.'ON'.AND.NX.NE.NPTS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2571)
 2571   FORMAT('***** ERROR IN DPTABU--FOR A TABULATE ...')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2573)NX
 2573   FORMAT('      THE NUMER OF POINTS FOR THE X VARIABLE,',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2574)NPTS
 2574   FORMAT('      WAS NOT EQUAL TO THE EXPECTED NUMBER OF ',
     1         'POINTS,',I8,' .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2575)IHX,IHX2,NX
 2575   FORMAT('        VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS, ',
     1         I8,' WERE EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2577)
 2577   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2578)(IANS(I),I=1,MIN(IWIDTH,80))
 2578     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(NHOR.NE.NPTS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2581)
 2581   FORMAT('***** ERROR IN DPTABU--FOR A TABULATE ...')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2583)NHOR
 2583   FORMAT('      THE NUMER OF POINTS FOR THE GROUP VARIABLE,',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2584)NPTS
 2584   FORMAT('      WAS NOT EQUAL TO THE EXPECTED NUMBER OF ',
     1         'POINTS,',I8,' .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2585)IHHOR,IHHOR2,NHOR
 2585   FORMAT('        VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS, ',
     1         I8,' WERE EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2587)
 2587   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2588)(IANS(I),I=1,MIN(IWIDTH,80))
 2588     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
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(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TABU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2610
      IF(ICASEQ.EQ.'SUBS')GOTO2620
      IF(ICASEQ.EQ.'FOR')GOTO2630
C
 2610 CONTINUE
      DO2615I=1,NLEFT
      ISUB(I)=1
 2615 CONTINUE
      NQ=NLEFT
      GOTO2650
C
 2620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2650
C
 2630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2650
C
 2650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO2660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO2660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(IYVAR.EQ.'OFF')THEN
        Y1(J)=0.0
      ELSE
        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)
      ENDIF
C
      IJ=MAXN*(ICOLX-1)+I
      IF(IXVAR.EQ.'OFF')THEN
        Z1(J)=0.0
      ELSE
        IF(ICOLX.LE.MAXCOL)Z1(J)=V(IJ)
        IF(ICOLX.EQ.MAXCP1)Z1(J)=PRED(I)
        IF(ICOLX.EQ.MAXCP2)Z1(J)=RES(I)
        IF(ICOLX.EQ.MAXCP3)Z1(J)=YPLOT(I)
        IF(ICOLX.EQ.MAXCP4)Z1(J)=XPLOT(I)
        IF(ICOLX.EQ.MAXCP5)Z1(J)=X2PLOT(I)
        IF(ICOLX.EQ.MAXCP6)Z1(J)=TAGPLO(I)
      ENDIF
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
 2660 CONTINUE
      NLOCAL=J
C
C               *******************************************************
C               **  STEP 8--                                         **
C               **  COMPUTE THE APPROPRIATE TABULATION STATISTIC--   **
C               **  (MEAN, STANDARD DEVIATION, RANGE, COUNT OR SUM). **
C               *******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TABU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPTAB2(Y1,Z1,X1,NLOCAL,NUMV2,ICASTA,ICTNAM,
     1XH1DIS,TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1ISEED,IQUAME,IQUASE,
     1IXVAR,IYVAR,
     1IYNAM,IXNAM,IX1NAM,
     1ICAPSW,ICAPTY,
     1ITABTI,NCTABT,ITABBR,ITABSP,ITABWD,ITABHT,
     1MAXOBV,
     1Y,X,NPLOTP,ISUBRO,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TABU')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTABU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTP,NS,ICASTA
 9013 FORMAT('NPLOTP,NS,ICASTA = ',
     1I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      ENDIF
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTAB2(Y,Z,TAG1,N,NUMV2,ICASTA,ICTNAM,
     1XIDTEM,TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1ISEED,IQUAME,IQUASE,
     1IXVAR,IYVAR,
     1IYNAM,IXNAM,IX1NAM,
     1ICAPSW,ICAPTY,
     1ITABTI,NCTABT,ITABBR,ITABSP,ITABWD,ITABHT,
     1MAXOBV,
     1Y2,X2,NPLOTP,ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A TABULATION
C              OF THE FOLLOWING TYPES--
C                 1) MEAN TABULATION;
C                 2) STANDARD DEVIATION TABULATION;
C                 3) RANGE TABULATION;
C                 4) COUNT TABULATION;
C                 5) SUM TABULATION.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1989. COMMENT OUT CHECK OF NUMSET=N
C     UPDATED         --APRIL     1992. DELETE YMID AND EXTRA 2
C     UPDATED         --APRIL     1993. SUM
C     UPDATED         --AUGUST    2002. USE CMPSTA TO COMPUTE THE
C                                       STATISTICS
C     UPDATED         --AUGUST    2002. GREATLY EXPAND LIST OF
C                                       SUPPORTED STATISICS
C     UPDATED         --AUGUST    2002. OUTPUT TO DPST1F.DAT
C     UPDATED         --AUGUST    2002. SUPPORT FOR HTML OUTPUT
C     UPDATED         --APRIL     2003. ADD SN AND QN (AND DIFFERENCE
C                                       OF), REQUIRED ADDITIONAL
C                                       SCRATCH ARRAYS
C     UPDATED         --OCTOBER   2003. SUPPORT FOR LATEX OUTPUT
C     UPDATED         --SEPTEMBER 2005. IF ALL ELEMENTS IDENTICAL,
C                                       CHANGE FROM ERROR TO WARNING,
C                                       BUT PRINT TABULATION ANYWAY.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASTA
      CHARACTER*40 ICTNAM
      CHARACTER*4 IXVAR
      CHARACTER*4 IYVAR
      CHARACTER*4 IQUAME
      CHARACTER*4 IQUASE
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*80 ITABTI
      CHARACTER*4 ITABBR
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IWRITE
C
      CHARACTER*8 IYNAM
      CHARACTER*8 IXNAM
      CHARACTER*8 IX1NAM
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION Z(*)
      DIMENSION XIDTEM(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
C
      DIMENSION TAG1(*)
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
C
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
      INTEGER ITEMP4(*)
      INTEGER ITEMP5(*)
      INTEGER ITEMP6(*)
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
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='DPTA'
      ISUBN2='B2  '
C
      I2=0
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 DPTAB2--THE NUMBER OF OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,33)
   33   FORMAT('      MUST BE AT LEAST 2;')
        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
      IF(IYVAR.EQ.'OFF')GOTO69
      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('***** WARNING IN DPTAB2--')
      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 ')
CCCCC SEPTEMBER 2005: PERFORM THE TABULATION ANYWAY.
CCCCC IERROR='YES'
CCCCC GOTO9000
   69 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPTAB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASTA,NUMV2
   71 FORMAT('N,ICASTA,NUMV2 = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO72I=1,N
      WRITE(ICOUT,73)I,Y(I),Z(I),TAG1(I)
   73 FORMAT('I, Y(I), Z(I),TAG1(I) = ',I8,3F15.7)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
   90 CONTINUE
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 TABULATION.     **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DISTIN(TAG1,N,IWRITE,XIDTEM,NUMSET,IBUGA3,IERROR)
      CALL SORT(XIDTEM,NUMSET,XIDTEM)
C
      IF(NUMSET.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,191)
  191   FORMAT('***** ERROR IN DPTAB2 SUBROUTINE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,192)
  192   FORMAT('      NUMBER OF SETS    NUMSET = 0 ')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      AN=N
      ANUMSE=NUMSET
C
C               ************************************************
C               **  STEP 4--                                  **
C               **  COMPUTE THE VARIOUS TABULATE STATISTICS   **
C               ************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      J=0
      DO1110ISET1=1,NUMSET
        K=0
        DO1130I=1,N
          IF(XIDTEM(ISET1).EQ.TAG1(I))GOTO1131
          GOTO1130
 1131     CONTINUE
C
          K=K+1
          IF(IYVAR.EQ.'OFF')THEN
            TEMP(K)=0.0
          ELSE
            TEMP(K)=Y(I)
            IF(IXVAR.EQ.'ON')TEMPZ(K)=Z(I)
          ENDIF
 1130   CONTINUE
        NTEMP=K
C
C       AUGUST 2002.  CALL CMPSTA
C
        IF(NTEMP.EQ.0)THEN
          STAT=0.0
        ELSE
          CALL CMPSTA(
     1              TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1              MAXOBV,NTEMP,NTEMP,
     1              NUMV2,ICASTA,
     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1              IQUAME,IQUASE,
     1              STAT,
     1              ISUBRO,IBUGA3,IERROR)
        ENDIF
C
        J=J+1
        Y2(J)=STAT
        X2(J)=XIDTEM(ISET1)
C
 1110 CONTINUE
      N2=J
C
C               *****************************
C               **   STEP 6--              **
C               **   WRITE OUT THE TABLE   **
C               *****************************
C
 6000 CONTINUE
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='TAB2'
      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(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
CCCCC AUGUST 2002: IF CAPTURE SWITCH ON AND SET TO "HTML", THEN
CCCCC WRITE OUTPUT IN HTML TABLE FORMAT.
C
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5101)
 5101   FORMAT('
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5102) 5102 FORMAT('') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5199) 5199 FORMAT('
')
        CALL DPWRST('XXX','WRIT')
C
        GOTO9000
CCCCC OCTOBER 2003: IF CAPTURE SWITCH ON AND SET TO "LATE", THEN
CCCCC WRITE OUTPUT IN LATEX TABLE FORMAT.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
 8007 FORMAT(A1,'begin{center}')
 8009 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8010 FORMAT(A1,'end{center}')
 8012 FORMAT(A1,'end{verbatim}')
 8013 FORMAT(A1,'begin{table}')
C
        CALL DPCONA(92,IBASLC)
C
C  END VERBATIM, START TABLE ENVIRONMENT, TABLE TITLE
C
 8081 FORMAT(5X,'{',A1,'bf ',80A1)
 8181 FORMAT(5X,'{',A1,'bf Tabulated Values of the Statistic')
 8082 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8084 FORMAT(5X,'} ',A1,A1)
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(NCTABT.GT.0)THEN
          WRITE(ICOUT,8007)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8081)IBASLC,(ITABTI(I:I),I=1,NCTABT)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8084)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8082)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8082)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8010)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  START TABULAR ENVIRONMENT, VARIABLE NAMES
C
 8015 FORMAT(5X,A1,'begin{tabular} {|r|r|}')
 8115 FORMAT(5X,A1,'begin{tabular} {rr}')
 8135 FORMAT(5X,A8,' & ',A8,2X,A1,A1)
 8235 FORMAT(5X,A8,' & ',A8,2X,A1,A1,2X,A1,'hline')
 8137 FORMAT(5X,A8,' & ',A8,' AND ',A8,2X,A1,A1)
 8237 FORMAT(5X,A8,' & ',A8,' AND ',A8,2X,A1,A1,2X,A1,'hline')
 8139 FORMAT(5X,' & ',A40,2X,A1,A1)
 8149 FORMAT(5X,A1,A1,2X,A1,'hline')
 8148 FORMAT(5X,A1,'hline')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ITABBR.EQ.'ON')THEN
          WRITE(ICOUT,8015)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8148)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8115)IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(ITABBR.EQ.'RULE')THEN
            WRITE(ICOUT,8148)IBASLC
            CALL DPWRST('XXX','WRIT')
          ENDIF
        ENDIF
C
        WRITE(ICOUT,8139)ICTNAM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        IF(IYVAR.EQ.'ON')THEN
          IF(IXVAR.EQ.'OFF')THEN
            IF(ITABBR.EQ.'ON' .OR. ITABBR.EQ.'RULE')THEN
              WRITE(ICOUT,8235)IX1NAM,IYNAM,IBASLC,IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSE
              WRITE(ICOUT,8135)IX1NAM,IYNAM,IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ENDIF
          ELSE
            IF(ITABBR.EQ.'ON' .OR. ITABBR.EQ.'RULE')THEN
              WRITE(ICOUT,8237)IX1NAM,IYNAM,IXNAM,IBASLC,IBASLC,
     1                         IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSE
              WRITE(ICOUT,8137)IX1NAM,IYNAM,IXNAM,IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ENDIF
          ENDIF
        ENDIF
C
C  WRITE OUT TABULATED VALUES
C
 8210   FORMAT(5X,G15.6,' & ',G15.6,2X,A1,A1)
 8211   FORMAT(5X,G15.6,' & ',G15.6,2X,A1,A1,2X,A1,'hline')
        IF(ITABBR.EQ.'ON')THEN
          DO8200I=1,N2
            WRITE(ICOUT,8211)X2(I),Y2(I),IBASLC,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8200     CONTINUE
        ELSE
          DO8260I=1,N2
            WRITE(ICOUT,8210)X2(I),Y2(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8260     CONTINUE
        ENDIF
C
C  END CODE
C
 8014   FORMAT(A1,'end{table}')
 8016   FORMAT('   ',A1,'end{tabular}')
 8017   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8016)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        GOTO9000
      ENDIF
C
      IF(IYVAR.EQ.'ON')THEN
        IF(IXVAR.EQ.'OFF')THEN
          WRITE(ICOUT,6107)IYNAM
 6107     FORMAT(16X,'*',4X,A8)
          CALL DPWRST('XXX','BUG ')
        ELSE
          WRITE(ICOUT,6109)IYNAM,IXNAM
 6109     FORMAT(16X,'*',4X,A8,' AND ',A8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
      WRITE(ICOUT,6111)IX1NAM,ICTNAM
 6111 FORMAT(4X,A8,4X,'*    ',A40)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(IOUNI1,8111)ICTNAM
 8111 FORMAT(' GROUP-ID 1        ',A40)
      WRITE(ICOUT,6121)
 6121 FORMAT('**********************************************')
      CALL DPWRST('XXX','BUG ')
      DO6160I=1,N2
      WRITE(ICOUT,6161)X2(I),Y2(I)
 6161 FORMAT(G15.6,' * ',G15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(IOUNI1,7161)X2(I),Y2(I)
 7161 FORMAT(G15.6,G15.6)
 6160 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IF(IPRINT.EQ.'OFF')GOTO9219
      WRITE(ICOUT,9212)
 9212 FORMAT(6X,'GROUP-ID AND STATISTIC WRITTEN TO FILE DPST1F.DAT')
      CALL DPWRST('XXX','BUG ')
 9219 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
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 DPTAB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASTA,N,NUMSET,N2,IERROR
 9012 FORMAT('ICASTA,N,NUMSET,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMV2
 9013 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N2
      WRITE(ICOUT,9021)I,Y2(I),X2(I)
 9021 FORMAT('I,Y2(I),X2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTAIL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN (EMPIRICAL) TAIL AREA PLOT
C              (A SYNONYM IS SURVIVAL PLOT)
C              VERTICAL AXIS   = 1-F(X)  (ON A LOG10 SCALE)
C              HORIZONTAL AXIS = SORTED DATA
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/6
C     ORIGINAL VERSION--MAY       1989.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --APRIL     1992. MAXCP31 TO MAXCP6
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 ISUBRO
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
CCCCC CHARACTER*4 IHVA21
CCCCC CHARACTER*4 IHVA22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPTA'
      ISUBN2='IL  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLV2=0
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'TAIL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTAIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAXCOL
   54 FORMAT('MAXCOL = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C
C               **********************************
C               **  TREAT THE TAIL AREA PLOT    **
C               **  =     THE SURVIVAL PLOT     **
C               **********************************
C
C               *******************************************
C               **  STEP 1--                             **
C               **  SEARCH FOR TAIL AREA PLOT            **
C               **  OR SURVIVAL PLOT                     **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='TAIL'
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SURV'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TAIL'.AND.IHARG(1).EQ.'AREA'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
     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
      IF(ICASPL.EQ.'TAIL')GOTO270
C
  260 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPTAIL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,262)
  262 FORMAT('      AT BRANCH POINT 261--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,263)
  263 FORMAT('      ICASPL NOT EQUAL TO    TAIL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,267)
  267 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,268)(IANS(I),I=1,IWIDTH)
  268 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  270 CONTINUE
      MAXV2=1
      GOTO290
C
  290 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 12--                                            **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.               **
C               ***********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPTAIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)IHLEFT,IHLEF2
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH A TAIL AREA PLOT / SURVIVAL PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      IS TO BE GENERATED)')
      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)
 1217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1218)(IANS(I),I=1,IWIDTH)
 1218 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='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
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'TAIL')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  CHECK FOR A VALID NUMBER                 **
C               **  OF VARIABLES                             **
C               **  (EXACTLY 1                               **
C               **  FOR A TAIL AREA PLOT).                   **
C               ***********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO2209
      GOTO2250
C
 2209 CONTINUE
      IF(NUMV2.LE.1)GOTO2290
C
 2250 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2251)
 2251 FORMAT('***** ERROR IN DPTAIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2252)
 2252 FORMAT('      FOR A TAIL AREA PLOT / SURVIVAL PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2253)
 2253 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2254)
 2254 FORMAT('      MUST BE EXACTLY 1  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2255)
 2255 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2256)
 2256 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2257)NUMV2
 2257 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2258)
 2258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2259)(IANS(I),I=1,IWIDTH)
 2259 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
C
C               **********************************************
C               **  STEP 31--                               **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE        VARIABLE; **
C               **  FORM THIS VARIABLE BY                   **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='31'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO3110
      IF(ICASQ.EQ.'SUBS')GOTO3120
      IF(ICASQ.EQ.'FOR')GOTO3130
C
 3110 CONTINUE
      DO3115I=1,NLEFT
      ISUB(I)=1
 3115 CONTINUE
      NQ=NLEFT
      GOTO3150
C
 3120 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3150
C
 3130 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3150
C
 3150 CONTINUE
      IF(NQ.GE.MINN2)GOTO3160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3151)
 3151 FORMAT('***** ERROR IN DPTAIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3152)
 3152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3153)IHLEFT,IHLEF2
 3153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3154)
 3154 FORMAT('      (FOR WHICH AN AUTO OR CROSS-PERIODOGRAM ',
     1'ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3155)
 3155 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3156)MINN2
 3156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3157)
 3157 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3158)
 3158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3159)(IANS(I),I=1,IWIDTH)
 3159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3160 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3170
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
     1WRITE(ICOUT,3166)I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ)
 3166 FORMAT('I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ) = ',6I8,E15.7)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
     1CALL DPWRST('XXX','BUG ')
      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)
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(ICOLL.EQ.MAXCP31)Y1(J)=TAGPLO(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
 3170 CONTINUE
      NS=J
C
C               *************************************************************
C               **  STEP 41--                                              **
C               **  FORM THE VERTICAL AND HORIZONTALAXIS                   **
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY)FOR THE PLOT.   **
C               **  FORM THE CURVE DESIGNATION VARIABLED(.)  .             **
C               **  THIS WILL BE ALL ONES.                                 **
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.'TAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPTAI2(Y1,NS,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'TAIL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTAIL--')
      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 ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTAI2(Y1,N,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN (EMPIRICAL) TAIL AREA PLOT
C              (A SYNONYM IS SURVIVAL PLOT)
C              VERTICAL AXIS   = 1-F(X)  (ON A LOG10 SCALE)
C              HORIZONTAL AXIS = SORTED DATA
C     INPUT ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS
C                               FOR THE FIRST  VARIABLE.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     CAUTION--THE INPUT VARIABLE Y1(.) WILL BE CHANGED HEREIN
C              (IT WILL BE SORTED)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/6
C     ORIGINAL VERSION--MAY       1989.
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
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTA'
      ISUBN2='I2  '
C
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'TAI2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTAI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N,ICASPL,MAXN
   53 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y1(I)
   56 FORMAT('I, Y1(I), = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.2)GOTO119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPTAI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)
  113 FORMAT('      MUST BE AT LEAST 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,114)N
  114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      HOLD=Y1(1)
      DO120I=1,N
      IF(Y1(I).NE.HOLD)GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** ERROR IN DPTAI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,122)
  122 FORMAT('      ALL ELEMENTS IN Y1 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,123)HOLD
  123 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  129 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  COMPUTE COORDINATES FOR TAIL AREA PLOT   **
C               **  (INCORPORATE STAIR-STEP APPEARANCE)      **
C               **  NOTE--THE LOGGING OF THE 1-F(X) WILL     **
C               **        NOTE BE DONE HEREIN BUT WILL       **
C               **        BE DONE IN THE UNDERLYING          **
C               **        GRAPHICS BY LOG SCALE              **
C               ***********************************************
C
C
      CALL SORT(Y1,N,Y1)
C
      ANP1=N+1
      J=0
      DO1100I=1,N
      ARG1=N-I+1
      ARG2=N-I
      J=J+1
      X(J)=Y1(I)
      Y(J)=ARG1/ANP1
      D(J)=1.0
      IF(I.GE.N)GOTO1100
      J=J+1
      X(J)=Y1(I)
      Y(J)=ARG2/ANP1
      D(J)=1.0
 1100 CONTINUE
      NPLOTP=J
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'TAI2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTAI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,ICASPL,MAXN
 9013 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N
      WRITE(ICOUT,9016)I,Y1(I)
 9016 FORMAT('I, Y1(I), = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)NPLOTP,NPLOTV
 9021 FORMAT('NPLOTP,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,NPLOTP
      WRITE(ICOUT,9023)I,Y(I),X(I),D(I)
 9023 FORMAT('I,Y(I),X(I),D(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTBCO(IHARG,NUMARG,IDETBC,MAXTEX,ITEBCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TEXT BORDER COLORS = THE COLORS
C              OF THE BORDER LINE AROUND THE TEXTS.
C              THESE ARE LOCATED IN THE VECTOR ITEBCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDETBC
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ITEBCO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDETBC
      CHARACTER*4 ITEBCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION ITEBCO(*)
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
      ISUBN1='DPTB'
      ISUBN2='CO  '
C
      NUMTEX=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTBCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDETBC
   55 FORMAT('IDETBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ITEBCO(1)
   70 FORMAT('ITEBCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ITEBCO(I)
   76 FORMAT('I,ITEBCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      ITEBCO(1)=IDETBC
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-2
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDETBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETBC
      ITEBCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,ITEBCO(I)
 1276 FORMAT('THE COLOR OF TEXT BORDER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDETBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETBC
      DO1315I=1,NUMTEX
      ITEBCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ITEBCO(I)
 1316 FORMAT('THE COLOR OF ALL TEXT BORDERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTBCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDETBC
 9015 FORMAT('IDETBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ITEBCO(1)
 9030 FORMAT('ITEBCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ITEBCO(I)
 9036 FORMAT('I,ITEBCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTBLI(IHARG,IHARG2,NUMARG,IDETBL,MAXTEX,ITEBLI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPTBLI(IHARG,NUMARG,IDETBL,MAXTEX,ITEBLI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BORDER LINES = THE LINES TYPES
C              OF THE BORDER AROUND THE TEXTS.
C              THESE ARE LOCATED IN THE VECTOR ITEBLI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDETBL
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ITEBLI (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDETBL
      CHARACTER*4 ITEBLI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION ITEBLI(*)
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
      ISUBN1='DPTB'
      ISUBN2='LI  '
C
      NUMTEX=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTBLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDETBL
   55 FORMAT('IDETBL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ITEBLI(1)
   70 FORMAT('ITEBLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ITEBLI(I)
   76 FORMAT('I,ITEBLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO9000
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      IF(NUMARG.EQ.5)GOTO1150
      GOTO1160
C
 1130 CONTINUE
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
      IF(IHARG(5).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
CCCCC IF(IHARG(5).EQ.'ALL')IHOLD1=IHARG(6)
CCCCC IF(IHARG(5).EQ.'ALL')GOTO1300
CCCCC IF(IHARG(6).EQ.'ALL')IHOLD1=IHARG(5)
CCCCC IF(IHARG(6).EQ.'ALL')GOTO1300
CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1 BELOW
      IF(IHARG(5).EQ.'ALL')THEN
        IHOLD1=IHARG(6)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(6).EQ.'ALL')THEN
        IHOLD1=IHARG(5)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      GOTO1200
C
 1160 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      ITEBLI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-3
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+3
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETBL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETBL
      ITEBLI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,ITEBLI(I)
 1276 FORMAT('THE LINE TYPE FOR TEXT BORDER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETBL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETBL
      DO1315I=1,NUMTEX
      ITEBLI(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ITEBLI(I)
 1316 FORMAT('THE LINE TYPE FOR ALL TEXT BORDERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTBLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDETBL
 9015 FORMAT('IDETBL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ITEBLI(1)
 9030 FORMAT('ITEBLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ITEBLI(I)
 9036 FORMAT('I,ITEBLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTBTH(IHARG,IARGT,ARG,NUMARG,PDETBT,MAXTEX,PTEBTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TEXT (BORDER) LINE THICKNESSES = THE THICKNESSES
C              OF THE BORDER LINE AROUND THE TEXTS.
C              THESE ARE LOCATED IN THE VECTOR PTEBTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDETBT
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PTEBTH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PTEBTH(*)
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
      ISUBN1='DPTB'
      ISUBN2='TH  '
C
      NUMTEX=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTBTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDETBT
   55 FORMAT('PDETBT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PTEBTH(1)
   70 FORMAT('PTEBTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PTEBTH(I)
   76 FORMAT('I,PTEBTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDETBT
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      PTEBTH(1)=PDETBT
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-2
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDETBT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDETBT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETBT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETBT
      PTEBTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,PTEBTH(I)
 1276 FORMAT('THE THICKNESS OF TEXT BORDER ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDETBT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDETBT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETBT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETBT
      DO1315I=1,NUMTEX
      PTEBTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PTEBTH(I)
 1316 FORMAT('THE THICKNESS OF ALL TEXT BORDERS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTBTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDETBT
 9015 FORMAT('PDETBT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PTEBTH(1)
 9030 FORMAT('PTEBTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PTEBTH(I)
 9036 FORMAT('I,PTEBTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTCCL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IX1TCO,IX2TCO,IY1TCO,IY2TCO,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK COLOR SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES DESCRIBE
C              THE TIC MARK COLOR ON THE 4 FRAME LINES OF A PLOT.
C              THE CONTENTS OF A TIC MARK COLOR SWITCH ARE
C              A COLOR.
C              THE TIC MARK COLOR SWITCHES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C              IX1TCO,IX2TCO,IY1TCO,IY2TCO
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C     OUTPUT ARGUMENTS--IX1TCO = COLOR FOR BOTTOM HORIZ. TICS
C                     --IX2TCO = COLOR FOR TOP    HORIZ. TICS
C                     --IY1TCO = COLOR FOR LEFT   VERT.  TICS
C                     --IY2TCO = COLOR FOR RIGHT  VERT.  TICS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFCO
C
      CHARACTER*4 IX1TCO
      CHARACTER*4 IX2TCO
      CHARACTER*4 IY1TCO
      CHARACTER*4 IY2TCO
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'COLO')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFCO
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1TCO=IHOLD
      IX2TCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK COLOR (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFCO
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1TCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK COLOR (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFCO
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2TCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK COLOR (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFCO
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1TCO=IHOLD
      IY2TCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK COLOR (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFCO
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1TCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK COLOR (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFCO
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2TCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK COLOR (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFCO
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1TCO=IHOLD
      IX2TCO=IHOLD
      IY1TCO=IHOLD
      IY2TCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK COLOR (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTCDP(ICOM,IHARG,IARGT,IARG,NUMARG,
     1IDEFDP,
     1IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK LABEL DECIMAL PLACES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK LABEL SWITCHES DESCRIBE
C              THE NUMBER OF TIC MARK LABEL DECIMAL PLACES ON THE 4 FRAME LINES
C              THE CONTENTS OF A TIC MARK LABEL DECIMAL PLACE ARE
C              AN INTEGER NUMBER.
C              THE TIC MARK LABEL DECIMAL PLACES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C              IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG  (AN INTEGER VECTOR)
C                     --NUMARG
C                     --IDEFDP
C     OUTPUT ARGUMENTS--IX1ZDP = NUM. DEC. FOR BOTTOM HORIZ. TIC LABELS
C                     --IX2ZDP = NUM. DEC. FOR TOP    HORIZ. TIC LABELS
C                     --IY1ZDP = NUM. DEC. FOR LEFT   VERT.  TIC LABELS
C                     --IY2ZDP = NUM. DEC. FOR RIGHT  VERT.  TIC LABELS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
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(IHARG(NUMARG).EQ.'?')GOTO8100
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI')GOTO1090
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLAC')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DECI'.AND.
     1IHARG(2).EQ.'PLAC')GOTO1090
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'DECI')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'PLAC')GOTO1090
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'DECI')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'PLAC')GOTO1090
C
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(3).EQ.'PLAC')GOTO1090
CCCCC JUNE 1994.  FOLLOWING 3 LINES ADDED (FOR TIC MARK LABEL DECIMAL)
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.
     1IHARG(3).EQ.'DECI')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'LABEL'.AND.
     1IHARG(3).EQ.'PLAC')GOTO1090
CCCCC JUNE 1994.  FOLLOWING 2 LINES ADDED (FOR TIC MARK LABEL DECIMAL)
      IF(NUMARG.GE.4.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(4).EQ.'PLAC')GOTO1090
C
      GOTO9000
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'DECI')GOTO1150
      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFDP
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZDP=IHOLD
      IX2ZDP=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC LABEL DECIMALS (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAVE JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IHOLD.LT.0)WRITE(ICOUT,1183)
 1183 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'DECI')GOTO1250
      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFDP
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZDP=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC LABEL DECIMALS (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAVE JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IHOLD.LT.0)WRITE(ICOUT,1283)
 1283 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO9000
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'DECI')GOTO1350
      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFDP
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZDP=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC LABEL DECIMALS (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAVE JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IHOLD.LT.0)WRITE(ICOUT,1383)
 1383 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO9000
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'DECI')GOTO1450
      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFDP
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZDP=IHOLD
      IY2ZDP=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC LABEL DECIMALS (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAVE JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IHOLD.LT.0)WRITE(ICOUT,1483)
 1483 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO9000
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'DECI')GOTO1550
      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFDP
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZDP=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC LABEL DECIMALS (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAVE JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IHOLD.LT.0)WRITE(ICOUT,1583)
 1583 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO9000
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'DECI')GOTO1650
      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFDP
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZDP=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC LABEL DECIMALS (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAVE JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IHOLD.LT.0)WRITE(ICOUT,1683)
 1683 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO9000
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'DECI')GOTO1750
      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFDP
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZDP=IHOLD
      IX2ZDP=IHOLD
      IY1ZDP=IHOLD
      IY2ZDP=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC LABEL DECIMALS (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAVE JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IHOLD.LT.0)WRITE(ICOUT,1783)
 1783 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO9000
C
 1799 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)
 8111 FORMAT('THE CURRENT NUMBER OF TIC LABEL DECIMAL PLACES IS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IX1ZDP
 8112 FORMAT('            --X1 (BOTTOM HORIZONTAL) = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8113)IX2ZDP
 8113 FORMAT('            --X2 (TOP    HORIZONTAL) = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8114)IY1ZDP
 8114 FORMAT('            --Y1 (LEFT   VERTICAL  ) = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8115)IY2ZDP
 8115 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8116)
 8116 FORMAT('            --NEGATIVE VALUES INDICATE THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8117)
 8117 FORMAT('              NUMBER OF DECIMALS FLOAT AND NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8121)
 8121 FORMAT('THE DEFAULT NUMBER OF TIC LABEL DECIMAL PLACES ARE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8122)
 8122 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8123)
 8123 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8124)
 8124 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8125)
 8125 FORMAT('            --Y2 (BOTTOM VERTICAL  ) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPTCJU(ICOM,IHARG,NUMARG,
     1IX1TJU,IX2TJU,IY1TJU,IY2TJU,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK JUSTIFICATION SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES DESCRIBE
C              THE TIC MARK JUSTIFICATION (THRU, IN, OR OUT) ON THE 4 FRAME LINE
C              THE CONTENTS OF A TIC MARK JUSTIFICATION SWITCH ARE
C              A JUSTIFICATION (THRU, IN, OR OUT).
C              THE TIC MARK JUSTIFICATION SWITCHES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C              IX1TJU,IX2TJU,IY1TJU,IY2TJU
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IX1TJU = JUSTIFICATION FOR BOTTOM HORIZ. TICS
C                     --IX2TJU = JUSTIFICATION FOR TOP    HORIZ. TICS
C                     --IY1TJU = JUSTIFICATION FOR LEFT   VERT.  TICS
C                     --IY2TJU = JUSTIFICATION FOR RIGHT  VERT.  TICS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IX1TJU
      CHARACTER*4 IX2TJU
      CHARACTER*4 IY1TJU
      CHARACTER*4 IY2TJU
C
      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)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'POSI')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'POSI')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'POSI')GOTO1150
      IF(IHARG(NUMARG).EQ.'IN')GOTO1130
      IF(IHARG(NUMARG).EQ.'INSI')GOTO1130
      IF(IHARG(NUMARG).EQ.'OUT')GOTO1140
      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1140
      IF(IHARG(NUMARG).EQ.'THRO')GOTO1150
      IF(IHARG(NUMARG).EQ.'THRU')GOTO1150
      IF(IHARG(NUMARG).EQ.'CENT')GOTO1150
      IERROR='YES'
      GOTO1900
C
 1130 CONTINUE
      IFOUND='YES'
      IX1TJU='IN'
      IX2TJU='IN'
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1900
C
 1140 CONTINUE
      IFOUND='YES'
      IX1TJU='OUT'
      IX2TJU='OUT'
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1145)
 1145 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1146)
 1146 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1900
C
 1150 CONTINUE
      IFOUND='YES'
      IX1TJU='THRU'
      IX2TJU='THRU'
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)
 1156 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
      CALL DPWRST('XXX','BUG ')
 1159 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'POSI')GOTO1250
      IF(IHARG(NUMARG).EQ.'IN')GOTO1230
      IF(IHARG(NUMARG).EQ.'INSI')GOTO1230
      IF(IHARG(NUMARG).EQ.'OUT')GOTO1240
      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1240
      IF(IHARG(NUMARG).EQ.'THRO')GOTO1250
      IF(IHARG(NUMARG).EQ.'THRU')GOTO1250
      IF(IHARG(NUMARG).EQ.'CENT')GOTO1250
      IERROR='YES'
      GOTO1900
C
 1230 CONTINUE
      IFOUND='YES'
      IX1TJU='IN'
C
      IF(IFEEDB.EQ.'OFF')GOTO1239
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1235)
 1235 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1236)
 1236 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
      CALL DPWRST('XXX','BUG ')
 1239 CONTINUE
      GOTO1900
C
 1240 CONTINUE
      IFOUND='YES'
      IX1TJU='OUT'
C
      IF(IFEEDB.EQ.'OFF')GOTO1249
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1245)
 1245 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1246)
 1246 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
      CALL DPWRST('XXX','BUG ')
 1249 CONTINUE
      GOTO1900
C
 1250 CONTINUE
      IFOUND='YES'
      IX1TJU='THRU'
C
      IF(IFEEDB.EQ.'OFF')GOTO1259
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1255)
 1255 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1256)
 1256 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
      CALL DPWRST('XXX','BUG ')
 1259 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'POSI')GOTO1350
      IF(IHARG(NUMARG).EQ.'IN')GOTO1330
      IF(IHARG(NUMARG).EQ.'INSI')GOTO1330
      IF(IHARG(NUMARG).EQ.'OUT')GOTO1340
      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1340
      IF(IHARG(NUMARG).EQ.'THRO')GOTO1350
      IF(IHARG(NUMARG).EQ.'THRU')GOTO1350
      IF(IHARG(NUMARG).EQ.'CENT')GOTO1350
      IERROR='YES'
      GOTO1900
C
 1330 CONTINUE
      IFOUND='YES'
      IX2TJU='IN'
C
      IF(IFEEDB.EQ.'OFF')GOTO1339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1335)
 1335 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1336)
 1336 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
      CALL DPWRST('XXX','BUG ')
 1339 CONTINUE
      GOTO1900
C
 1340 CONTINUE
      IFOUND='YES'
      IX2TJU='OUT'
C
      IF(IFEEDB.EQ.'OFF')GOTO1349
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1345)
 1345 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1346)
 1346 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
      CALL DPWRST('XXX','BUG ')
 1349 CONTINUE
      GOTO1900
C
 1350 CONTINUE
      IFOUND='YES'
      IX2TJU='THRU'
C
      IF(IFEEDB.EQ.'OFF')GOTO1359
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1355)
 1355 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1356)
 1356 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
      CALL DPWRST('XXX','BUG ')
 1359 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'POSI')GOTO1450
      IF(IHARG(NUMARG).EQ.'IN')GOTO1430
      IF(IHARG(NUMARG).EQ.'INSI')GOTO1430
      IF(IHARG(NUMARG).EQ.'OUT')GOTO1440
      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1440
      IF(IHARG(NUMARG).EQ.'THRO')GOTO1450
      IF(IHARG(NUMARG).EQ.'THRU')GOTO1450
      IF(IHARG(NUMARG).EQ.'CENT')GOTO1450
      IERROR='YES'
      GOTO1900
C
 1430 CONTINUE
      IFOUND='YES'
      IY1TJU='IN'
      IY2TJU='IN'
C
      IF(IFEEDB.EQ.'OFF')GOTO1439
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1435)
 1435 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1436)
 1436 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
      CALL DPWRST('XXX','BUG ')
 1439 CONTINUE
      GOTO1900
C
 1440 CONTINUE
      IFOUND='YES'
      IY1TJU='OUT'
      IY2TJU='OUT'
C
      IF(IFEEDB.EQ.'OFF')GOTO1449
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1445)
 1445 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1446)
 1446 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
      CALL DPWRST('XXX','BUG ')
 1449 CONTINUE
      GOTO1900
C
 1450 CONTINUE
      IFOUND='YES'
      IY1TJU='THRU'
      IY2TJU='THRU'
C
      IF(IFEEDB.EQ.'OFF')GOTO1459
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1455)
 1455 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1456)
 1456 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
      CALL DPWRST('XXX','BUG ')
 1459 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'POSI')GOTO1550
      IF(IHARG(NUMARG).EQ.'IN')GOTO1530
      IF(IHARG(NUMARG).EQ.'INSI')GOTO1530
      IF(IHARG(NUMARG).EQ.'OUT')GOTO1540
      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1540
      IF(IHARG(NUMARG).EQ.'THRO')GOTO1550
      IF(IHARG(NUMARG).EQ.'THRU')GOTO1550
      IF(IHARG(NUMARG).EQ.'CENT')GOTO1550
      IERROR='YES'
      GOTO1900
C
 1530 CONTINUE
      IFOUND='YES'
      IY1TJU='IN'
C
      IF(IFEEDB.EQ.'OFF')GOTO1539
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1535)
 1535 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1536)
 1536 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
      CALL DPWRST('XXX','BUG ')
 1539 CONTINUE
      GOTO1900
C
 1540 CONTINUE
      IFOUND='YES'
      IY1TJU='OUT'
C
      IF(IFEEDB.EQ.'OFF')GOTO1549
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1545)
 1545 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1546)
 1546 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
      CALL DPWRST('XXX','BUG ')
 1549 CONTINUE
      GOTO1900
C
 1550 CONTINUE
      IFOUND='YES'
      IY1TJU='THRU'
C
      IF(IFEEDB.EQ.'OFF')GOTO1559
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1555)
 1555 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1556)
 1556 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
      CALL DPWRST('XXX','BUG ')
 1559 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'POSI')GOTO1650
      IF(IHARG(NUMARG).EQ.'IN')GOTO1630
      IF(IHARG(NUMARG).EQ.'INSI')GOTO1630
      IF(IHARG(NUMARG).EQ.'OUT')GOTO1640
      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1640
      IF(IHARG(NUMARG).EQ.'THRO')GOTO1650
      IF(IHARG(NUMARG).EQ.'THRU')GOTO1650
      IF(IHARG(NUMARG).EQ.'CENT')GOTO1650
      IERROR='YES'
      GOTO1900
C
 1630 CONTINUE
      IFOUND='YES'
      IY2TJU='IN'
C
      IF(IFEEDB.EQ.'OFF')GOTO1639
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1635)
 1635 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1636)
 1636 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
      CALL DPWRST('XXX','BUG ')
 1639 CONTINUE
      GOTO1900
C
 1640 CONTINUE
      IFOUND='YES'
      IY2TJU='OUT'
C
      IF(IFEEDB.EQ.'OFF')GOTO1649
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1645)
 1645 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1646)
 1646 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
      CALL DPWRST('XXX','BUG ')
 1649 CONTINUE
      GOTO1900
C
 1650 CONTINUE
      IFOUND='YES'
      IY2TJU='THRU'
C
      IF(IFEEDB.EQ.'OFF')GOTO1659
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1655)
 1655 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1656)
 1656 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
      CALL DPWRST('XXX','BUG ')
 1659 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'POSI')GOTO1750
      IF(IHARG(NUMARG).EQ.'IN')GOTO1730
      IF(IHARG(NUMARG).EQ.'INSI')GOTO1730
      IF(IHARG(NUMARG).EQ.'OUT')GOTO1740
      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1740
      IF(IHARG(NUMARG).EQ.'THRO')GOTO1750
      IF(IHARG(NUMARG).EQ.'THRU')GOTO1750
      IF(IHARG(NUMARG).EQ.'CENT')GOTO1750
      IERROR='YES'
      GOTO1900
C
 1730 CONTINUE
      IFOUND='YES'
      IX1TJU='IN'
      IX2TJU='IN'
      IY1TJU='IN'
      IY2TJU='IN'
C
      IF(IFEEDB.EQ.'OFF')GOTO1739
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1735)
 1735 FORMAT('THE TIC MARKS (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1736)
 1736 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
      CALL DPWRST('XXX','BUG ')
 1739 CONTINUE
      GOTO1900
C
 1740 CONTINUE
      IFOUND='YES'
      IX1TJU='OUT'
      IX2TJU='OUT'
      IY1TJU='OUT'
      IY2TJU='OUT'
C
      IF(IFEEDB.EQ.'OFF')GOTO1749
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1745)
 1745 FORMAT('THE TIC MARKS (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1746)
 1746 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
      CALL DPWRST('XXX','BUG ')
 1749 CONTINUE
      GOTO1900
C
 1750 CONTINUE
      IFOUND='YES'
      IX1TJU='THRU'
      IX2TJU='THRU'
      IY1TJU='THRU'
      IY2TJU='THRU'
C
      IF(IFEEDB.EQ.'OFF')GOTO1759
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1755)
 1755 FORMAT('THE TIC MARKS (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1756)
 1756 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
      CALL DPWRST('XXX','BUG ')
 1759 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTCOF(ICOM,IHARG,IARGT,ARG,NUMARG,
     1DEFTOF,IDEFTU,
     1ITICUN,
     1PX1TOL,PX2TOL,PY1TOB,PY2TOB,
     1PX1TOR,PX2TOR,PY1TOT,PY2TOT,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK OFFSETS
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK OFFSETS DEFINE THE DISTANCE (IN EITHER
C              DATA UNITS OR DATAPLOT PERCENT UNITS) FROM THE FIRST OR
C              LAST TIC MARK TO THE FRAME LIMIT.  NOTE THAT THIS VALUE
C              WILL BE ADDED TO THE CURRENT DATA LIMITS (EITHER DEFINED
C              VIA THE LIMITS COMMAND OR AS AUTOMATICALLY DETERMINED
C              BY DATAPLOT).
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --DEFTOF = DEFAULT OFFSET
C                     --IDEFTU = DEFAULT TIC UNITS
C     OUTPUT ARGUMENTS--
C                     --PX1TOL = BOTTOM HORIZONTAL TIC LEFT OFFSET
C                     --PX2TOL = TOP    HORIZONTAL TIC LEFT OFFSET
C                     --PY1TOB = LEFT   VERTICAL   TIC BOTTOM OFFSET
C                     --PY2TOB = RIGHT  VERTICAL   TIC BOTTOM OFFSET
C                     --PX1TOL = BOTTOM HORIZONTAL TIC LEFT OFFSET
C                     --PX2TOL = TOP    HORIZONTAL TIC LEFT OFFSET
C                     --PY1TOB = LEFT   VERTICAL   TIC BOTTOM OFFSET
C                     --PY2TOB = RIGHT  VERTICAL   TIC BOTTOM OFFSET
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--90/5
C     ORIGINAL VERSION--MAY       1990.
C     UPDATED         --OCTOBER    1991. INSERT FEEDBACK OFF JUMP
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 ITICUN
      CHARACTER*4 IDEFTU
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'OFFS'.AND.
     1IHARG(2).EQ.'UNIT')GOTO2090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'OFFS'.AND.IHARG(3).EQ.'UNIT')GOTO2090
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OFFS')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'OFFS')GOTO1090
      GOTO1900
C
 1090 CONTINUE
      IFOUND='YES'
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      ILEFT=2
      IF(IHARG(2).EQ.'OFFS')ILEFT=3
      IRIGHT=ILEFT+1
      IF(ILEFT.GT.NUMARG)ILEFT=0
      IF(IRIGHT.GT.NUMARG)IRIGHT=0
C
C               *****************************************************
C               **  TREAT THE LEFT OFFSET                          **
C               **  NO ARGUMENT WILL SET THE DEFAULT               **
C               *****************************************************
C
      IF(ILEFT.EQ.0)GOTO1110
      IF(IHARG(ILEFT).EQ.'ON')GOTO1110
      IF(IHARG(ILEFT).EQ.'OFF')GOTO1110
      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1110
      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1110
      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1110
      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1120
      IERROR='YES'
      GOTO1900
C
 1110 CONTINUE
      HOLD=DEFTOF
      GOTO1140
C
 1120 CONTINUE
      HOLD=ARG(ILEFT)
      GOTO1140
C
 1140 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PX1TOL=HOLD
      PX2TOL=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('THE TIC MARK LEFT OFFSET (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)HOLD
 1142 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
C
C               *****************************************************
C               **  TREAT THE RIGHT OFFSET                         **
C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
C               *****************************************************
C
      IF(IRIGHT.EQ.0)GOTO1160
      IF(IHARG(IRIGHT).EQ.'ON')GOTO1170
      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1170
      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1170
      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1170
      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1170
      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1180
      IERROR='YES'
      GOTO1900
C
 1160 CONTINUE
      HOLD=PX1TOR
      GOTO1190
C
 1170 CONTINUE
      HOLD=DEFTOF
      GOTO1190
C
 1180 CONTINUE
      HOLD=ARG(IRIGHT)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PX1TOR=HOLD
      PX2TOR=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1197
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1191)
 1191 FORMAT('THE TIC MARK RIGHT OFFSET (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1192)HOLD
 1192 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
C
 1197 CONTINUE
C
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
C
      ILEFT=2
      IF(IHARG(2).EQ.'OFFS')ILEFT=3
      IRIGHT=ILEFT+1
      IF(ILEFT.GT.NUMARG)ILEFT=0
      IF(IRIGHT.GT.NUMARG)IRIGHT=0
C
C               *****************************************************
C               **  TREAT THE LEFT OFFSET                          **
C               **  NO ARGUMENT WILL SET THE DEFAULT               **
C               *****************************************************
C
      IF(ILEFT.EQ.0)GOTO1210
      IF(IHARG(ILEFT).EQ.'ON')GOTO1210
      IF(IHARG(ILEFT).EQ.'OFF')GOTO1210
      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1210
      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1210
      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1210
      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1220
      IERROR='YES'
      GOTO1900
C
 1210 CONTINUE
      HOLD=DEFTOF
      GOTO1240
C
 1220 CONTINUE
      HOLD=ARG(ILEFT)
      GOTO1240
C
 1240 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PX1TOL=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1249
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1241)
 1241 FORMAT('THE TIC MARK LEFT OFFSET (FOR BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1242)HOLD
 1242 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1249 CONTINUE
C
C               *****************************************************
C               **  TREAT THE RIGHT OFFSET                         **
C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
C               *****************************************************
C
      IF(IRIGHT.EQ.0)GOTO1260
      IF(IHARG(IRIGHT).EQ.'ON')GOTO1270
      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1270
      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1270
      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1270
      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1270
      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1280
      IERROR='YES'
      GOTO1900
C
 1260 CONTINUE
      HOLD=PX2TOR
      GOTO1290
C
 1270 CONTINUE
      HOLD=DEFTOF
      GOTO1290
C
 1280 CONTINUE
      HOLD=ARG(IRIGHT)
      GOTO1290
C
 1290 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PX1TOR=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1297
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1291)
 1291 FORMAT('THE TIC MARK RIGHT OFFSET (FOR BOTTOM HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1292)HOLD
 1292 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
C
 1297 CONTINUE
C
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
C
      ILEFT=2
      IF(IHARG(2).EQ.'OFFS')ILEFT=3
      IRIGHT=ILEFT+1
      IF(ILEFT.GT.NUMARG)ILEFT=0
      IF(IRIGHT.GT.NUMARG)IRIGHT=0
C
C               *****************************************************
C               **  TREAT THE LEFT OFFSET                          **
C               **  NO ARGUMENT WILL SET THE DEFAULT               **
C               *****************************************************
C
      IF(ILEFT.EQ.0)GOTO1310
      IF(IHARG(ILEFT).EQ.'ON')GOTO1310
      IF(IHARG(ILEFT).EQ.'OFF')GOTO1310
      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1310
      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1310
      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1310
      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1320
      IERROR='YES'
      GOTO1900
C
 1310 CONTINUE
      HOLD=DEFTOF
      GOTO1340
C
 1320 CONTINUE
      HOLD=ARG(ILEFT)
      GOTO1340
C
 1340 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PX2TOL=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1349
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1341)
 1341 FORMAT('THE TIC MARK LEFT OFFSET (FOR TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1342)HOLD
 1342 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1349 CONTINUE
C
C               *****************************************************
C               **  TREAT THE RIGHT OFFSET                         **
C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
C               *****************************************************
C
      IF(IRIGHT.EQ.0)GOTO1360
      IF(IHARG(IRIGHT).EQ.'ON')GOTO1370
      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1370
      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1370
      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1370
      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1370
      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1380
      IERROR='YES'
      GOTO1900
C
 1360 CONTINUE
      HOLD=PX2TOR
      GOTO1390
C
 1370 CONTINUE
      HOLD=DEFTOF
      GOTO1390
C
 1380 CONTINUE
      HOLD=ARG(IRIGHT)
      GOTO1390
C
 1390 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PX2TOR=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1397
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1391)
 1391 FORMAT('THE TIC MARK RIGHT OFFSET (FOR TOP HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1392)HOLD
 1392 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
C
 1397 CONTINUE
C
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
C
      ILEFT=2
      IF(IHARG(2).EQ.'OFFS')ILEFT=3
      IRIGHT=ILEFT+1
      IF(ILEFT.GT.NUMARG)ILEFT=0
      IF(IRIGHT.GT.NUMARG)IRIGHT=0
C
C               *****************************************************
C               **  TREAT THE BOTTOM OFFSET                        **
C               **  NO ARGUMENT WILL SET THE DEFAULT               **
C               *****************************************************
C
      IF(ILEFT.EQ.0)GOTO1410
      IF(IHARG(ILEFT).EQ.'ON')GOTO1410
      IF(IHARG(ILEFT).EQ.'OFF')GOTO1410
      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1410
      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1410
      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1410
      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1420
      IERROR='YES'
      GOTO1900
C
 1410 CONTINUE
      HOLD=DEFTOF
      GOTO1440
C
 1420 CONTINUE
      HOLD=ARG(ILEFT)
      GOTO1440
C
 1440 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PY1TOB=HOLD
      PY2TOB=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1449
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1441)
 1441 FORMAT('THE TIC MARK BOTTOM OFFSET (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1442)HOLD
 1442 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1449 CONTINUE
C
C               *****************************************************
C               **  TREAT THE TOP OFFSET                           **
C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
C               *****************************************************
C
      IF(IRIGHT.EQ.0)GOTO1460
      IF(IHARG(IRIGHT).EQ.'ON')GOTO1470
      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1470
      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1470
      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1470
      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1470
      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1480
      IERROR='YES'
      GOTO1900
C
 1460 CONTINUE
      HOLD=PY1TOT
      GOTO1490
C
 1470 CONTINUE
      HOLD=DEFTOF
      GOTO1490
C
 1480 CONTINUE
      HOLD=ARG(IRIGHT)
      GOTO1490
C
 1490 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PY1TOT=HOLD
      PY2TOT=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1497
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1491)
 1491 FORMAT('THE TIC MARK TOP OFFSET (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1492)HOLD
 1492 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
C
 1497 CONTINUE
C
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT VERTICAL TIC OFFSETS ARE TO BE CHANGED    **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
C
      ILEFT=2
      IF(IHARG(2).EQ.'OFFS')ILEFT=3
      IRIGHT=ILEFT+1
      IF(ILEFT.GT.NUMARG)ILEFT=0
      IF(IRIGHT.GT.NUMARG)IRIGHT=0
C
C               *****************************************************
C               **  TREAT THE BOTTOM OFFSET                        **
C               **  NO ARGUMENT WILL SET THE DEFAULT               **
C               *****************************************************
C
      IF(ILEFT.EQ.0)GOTO1510
      IF(IHARG(ILEFT).EQ.'ON')GOTO1510
      IF(IHARG(ILEFT).EQ.'OFF')GOTO1510
      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1510
      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1510
      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1510
      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1520
      IERROR='YES'
      GOTO1900
C
 1510 CONTINUE
      HOLD=DEFTOF
      GOTO1540
C
 1520 CONTINUE
      HOLD=ARG(ILEFT)
      GOTO1540
C
 1540 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PY1TOB=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1549
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1541)
 1541 FORMAT('THE TIC MARK BOTTOM OFFSET (FOR LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1542)HOLD
 1542 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1549 CONTINUE
C
C               *****************************************************
C               **  TREAT THE TOP OFFSET                           **
C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
C               *****************************************************
C
      IF(IRIGHT.EQ.0)GOTO1560
      IF(IHARG(IRIGHT).EQ.'ON')GOTO1570
      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1570
      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1570
      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1570
      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1570
      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1580
      IERROR='YES'
      GOTO1900
C
 1560 CONTINUE
      HOLD=PY1TOT
      GOTO1590
C
 1570 CONTINUE
      HOLD=DEFTOF
      GOTO1590
C
 1580 CONTINUE
      HOLD=ARG(IRIGHT)
      GOTO1590
C
 1590 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PY1TOT=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1597
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1591)
 1591 FORMAT('THE TIC MARK TOP OFFSET (FOR LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1592)HOLD
 1592 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
C
 1597 CONTINUE
C
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT VERTICAL TIC OFFSETS ARE TO BE CHANGED   **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
C
      ILEFT=2
      IF(IHARG(2).EQ.'OFFS')ILEFT=3
      IRIGHT=ILEFT+1
      IF(ILEFT.GT.NUMARG)ILEFT=0
      IF(IRIGHT.GT.NUMARG)IRIGHT=0
C
C               *****************************************************
C               **  TREAT THE BOTTOM OFFSET                        **
C               **  NO ARGUMENT WILL SET THE DEFAULT               **
C               *****************************************************
C
      IF(ILEFT.EQ.0)GOTO1610
      IF(IHARG(ILEFT).EQ.'ON')GOTO1610
      IF(IHARG(ILEFT).EQ.'OFF')GOTO1610
      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1610
      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1610
      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1610
      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1620
      IERROR='YES'
      GOTO1900
C
 1610 CONTINUE
      HOLD=DEFTOF
      GOTO1640
C
 1620 CONTINUE
      HOLD=ARG(ILEFT)
      GOTO1640
C
 1640 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PY2TOB=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1649
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1641)
 1641 FORMAT('THE TIC MARK BOTTOM OFFSET (FOR RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1642)HOLD
 1642 FORMAT('HAS JUST BEEN SET TO ',E16.7)
      CALL DPWRST('XXX','BUG ')
 1649 CONTINUE
C
C               *****************************************************
C               **  TREAT THE TOP OFFSET                           **
C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
C               *****************************************************
C
      IF(IRIGHT.EQ.0)GOTO1660
      IF(IHARG(IRIGHT).EQ.'ON')GOTO1670
      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1670
      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1670
      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1670
      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1670
      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1680
      IERROR='YES'
      GOTO1900
C
 1660 CONTINUE
      HOLD=PY2TOT
      GOTO1690
C
 1670 CONTINUE
      HOLD=DEFTOF
      GOTO1690
C
 1680 CONTINUE
      HOLD=ARG(IRIGHT)
      GOTO1690
C
 1690 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PY2TOT=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1697
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1691)
 1691 FORMAT('THE TIC MARK TOP OFFSET (FOR RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1692)HOLD
 1692 FORMAT('HAS JUST BEEN SET TO ',E16.7)
      CALL DPWRST('XXX','BUG ')
C
 1697 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
C
      ILEFT=2
      IF(IHARG(2).EQ.'OFFS')ILEFT=3
      IRIGHT=ILEFT+1
      IF(ILEFT.GT.NUMARG)ILEFT=0
      IF(IRIGHT.GT.NUMARG)IRIGHT=0
C
C               *****************************************************
C               **  TREAT THE BOTTOM OFFSET                        **
C               **  NO ARGUMENT WILL SET THE DEFAULT               **
C               *****************************************************
C
      IF(ILEFT.EQ.0)GOTO1710
      IF(IHARG(ILEFT).EQ.'ON')GOTO1710
      IF(IHARG(ILEFT).EQ.'OFF')GOTO1710
      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1710
      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1710
      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1710
      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1720
      IERROR='YES'
      GOTO1900
C
 1710 CONTINUE
      HOLD=DEFTOF
      GOTO1740
C
 1720 CONTINUE
      HOLD=ARG(ILEFT)
      GOTO1740
C
 1740 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PX1TOL=HOLD
      PX2TOL=HOLD
      PY1TOB=HOLD
      PY2TOB=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1749
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1741)
 1741 FORMAT('THE TIC MARK BOTTOM OFFSET (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1742)HOLD
 1742 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1743)
 1743 FORMAT('THE TIC MARK LEFT OFFSET (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1742)HOLD
      CALL DPWRST('XXX','BUG ')
 1749 CONTINUE
C
C               *****************************************************
C               **  TREAT THE TOP OFFSET                           **
C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
C               *****************************************************
C
      IF(IRIGHT.EQ.0)GOTO1760
      IF(IHARG(IRIGHT).EQ.'ON')GOTO1770
      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1770
      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1770
      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1770
      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1770
      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1780
      IERROR='YES'
      GOTO1900
C
 1760 CONTINUE
      GOTO1900
C
 1770 CONTINUE
      HOLD=DEFTOF
      GOTO1790
C
 1780 CONTINUE
      HOLD=ARG(IRIGHT)
      GOTO1790
C
 1790 CONTINUE
      IFOUND='YES'
      HOLD=ABS(HOLD)
      PX1TOR=HOLD
      PX2TOR=HOLD
      PY1TOT=HOLD
      PY2TOT=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1797
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1791)
 1791 FORMAT('THE TIC MARK TOP OFFSET (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1792)HOLD
 1792 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1793)
 1793 FORMAT('THE TIC MARK RIGHT OFFSET (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1792)HOLD
      CALL DPWRST('XXX','BUG ')
C
 1797 CONTINUE
C
      GOTO1900
C
 1799 CONTINUE
      GOTO1900
C
C               *****************************************************
C               **  TREAT THE OFFSET UNITS CASE                    **
C               **  NOTE THAT CURRENTLY THERE IS ONLY ONE UNITS    **
C               **  SWITCH, I.E., ALL 4 FRAME LINES WILL USE THE   **
C               **  SAME UNITS.  THE CHOICES ARE "DATA", (OFFSETS  **
C               **  IN UNITS OF THE DATA) AND "ABSOLUTE" (OFFSETS  **
C               **  IN DATAPLOT 0. TO 100. PERCENT UNITS).         **
C               *****************************************************
C
 2090 CONTINUE
      IFOUND='YES'
C
      IF(IHARG(NUMARG).EQ.'ON')GOTO2150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO2150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO2150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO2150
      IF(IHARG(NUMARG).EQ.'FLOA')GOTO2150
      IF(IHARG(NUMARG).EQ.'DATA')GOTO2160
      IF(IHARG(NUMARG).EQ.'SCRE')GOTO2170
      IF(IHARG(NUMARG).EQ.'ABSO')GOTO2170
      GOTO2150
C
 2150 CONTINUE
      ITICUN=IDEFTU
CCCCC THE FOLLOWING LINE (AND THE CONTINUE) WERE ADDED OCTOBER 1991
      IF(IFEEDB.EQ.'OFF')GOTO2159
      WRITE(ICOUT,2151)ITICUN
 2151 FORMAT('TIC MARK OFFSETS WILL BE CALCULATED IN ',A4,
     1' UNITS.')
      CALL DPWRST('XXX','BUG ')
 2159 CONTINUE
      GOTO1900
C
 2160 CONTINUE
      ITICUN='DATA'
CCCCC THE FOLLOWING LINE (AND THE CONTINUE) WERE ADDED OCTOBER 1991
      IF(IFEEDB.EQ.'OFF')GOTO2169
      WRITE(ICOUT,2161)
 2161 FORMAT('TIC MARK OFFSETS WILL BE CALCULATED IN DATA',
     1' UNITS.')
      CALL DPWRST('XXX','BUG ')
 2169 CONTINUE
      GOTO1900
C
 2170 CONTINUE
      ITICUN='ABSO'
CCCCC THE FOLLOWING LINE (AND THE CONTINUE) WERE ADDED OCTOBER 1991
      IF(IFEEDB.EQ.'OFF')GOTO2179
      WRITE(ICOUT,2171)
 2171 FORMAT('TIC MARK OFFSETS WILL BE CALCULATED IN',
     1' DATAPLOT SCREEN UNITS.')
      CALL DPWRST('XXX','BUG ')
 2179 CONTINUE
      GOTO1900
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTCPA(ICOM,IHARG,NUMARG,
     1IDEFPA,
     1IX1TPA,IX2TPA,IY1TPA,IY2TPA,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK PATTERN SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES DESCRIBE
C              THE TIC MARK PATTERN ON THE 4 FRAME LINES OF A PLOT.
C              THE CONTENTS OF A TIC MARK PATTERN SWITCH ARE
C              A PATTERN.
C              THE TIC MARK PATTERN SWITCHES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C              IX1TPA,IX2TPA,IY1TPA,IY2TPA
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFPA
C     OUTPUT ARGUMENTS--IX1TPA = PATTERN FOR BOTTOM HORIZ. TICS
C                     --IX2TPA = PATTERN FOR TOP    HORIZ. TICS
C                     --IY1TPA = PATTERN FOR LEFT   VERT.  TICS
C                     --IY2TPA = PATTERN FOR RIGHT  VERT.  TICS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFPA
C
      CHARACTER*4 IX1TPA
      CHARACTER*4 IX2TPA
      CHARACTER*4 IY1TPA
      CHARACTER*4 IY2TPA
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'PATT')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFPA
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1TPA=IHOLD
      IX2TPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK PATTERN (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFPA
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1TPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK PATTERN (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFPA
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2TPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK PATTERN (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFPA
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1TPA=IHOLD
      IY2TPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK PATTERN (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFPA
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1TPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK PATTERN (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFPA
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2TPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK PATTERN (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFPA
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1TPA=IHOLD
      IX2TPA=IHOLD
      IY1TPA=IHOLD
      IY2TPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK PATTERN (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTCSZ(ICOM,IHARG,IARGT,ARG,NUMARG,
     1DEFTL,
     1PX1TLE,PX2TLE,PY1TLE,PY2TLE,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK SIZES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES DEFINE THE SIZE (LENGTH)
C              OF THE MAJOR TIC MARKS ON THE 4 FRAME LINES OF A PLOT.
C              (THE SIZE OF THE MINOR TIC MARKS IS ALWAYS
C              1/2 THE SIZE OF THE MAJOR TIC MARKS.)
C              THE TIC MARK SIZE SWITCHES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C              PX1TLE,PX2TLE,PY1TLE,PY2TLE,
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --DEFTL
C     OUTPUT ARGUMENTS--
C                     --PX1TLE = BOTTOM HORIZONTAL TIC LENGTH
C                     --PX2TLE = TOP    HORIZONTAL TIC LENGTH
C                     --PY1TLE = LEFT   VERTICAL   TIC LENGTH
C                     --PY2TLE = RIGHT  VERTICAL   TIC LENGTH
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'SIZE')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IERROR='YES'
      GOTO1900
C
 1150 CONTINUE
      HOLD=DEFTL
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1TLE=HOLD
      PX2TLE=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK SIZE (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)HOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1250
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
      IERROR='YES'
      GOTO1900
C
 1250 CONTINUE
      HOLD=DEFTL
      GOTO1280
C
 1260 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX1TLE=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK SIZE (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)HOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1350
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
      IERROR='YES'
      GOTO1900
C
 1350 CONTINUE
      HOLD=DEFTL
      GOTO1380
C
 1360 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX2TLE=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK SIZE (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)HOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1450
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
      IERROR='YES'
      GOTO1900
C
 1450 CONTINUE
      HOLD=DEFTL
      GOTO1480
C
 1460 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1TLE=HOLD
      PY2TLE=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK SIZE (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)HOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1550
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
      IERROR='YES'
      GOTO1900
C
 1550 CONTINUE
      HOLD=DEFTL
      GOTO1580
C
 1560 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY1TLE=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK SIZE (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)HOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1650
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
      IERROR='YES'
      GOTO1900
C
 1650 CONTINUE
      HOLD=DEFTL
      GOTO1680
C
 1660 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY2TLE=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK SIZE (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)HOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1750
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
      IERROR='YES'
      GOTO1900
C
 1750 CONTINUE
      HOLD=DEFTL
      GOTO1780
C
 1760 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PX1TLE=HOLD
      PX2TLE=HOLD
      PY1TLE=HOLD
      PY2TLE=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK SIZE (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)HOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTCTH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PTICTH,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK THICKNESS SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES DESCRIBE
C              THE TIC MARK THICKNESS ON THE 4 FRAME LINES OF A PLOT.
C              THE CONTENTS OF A TIC MARK THICKNESS SWITCH ARE
C              A THICKNESS.
C              CURRENTLY, THE TIC MARK THICKNESS FOR ALL 4 SIDES
C              MUST BE THE SAME AND ARE CONTAINED IN THE VARIABLE
C              PTICTH
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C     OUTPUT ARGUMENTS--PTICTH = THICKNESS FOR ALL 4 FRAME SIDE TICS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      REAL        PDEFTH
C
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      REAL        PHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'THIC')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      PHOLD=PDEFTH
      GOTO1180
C
 1160 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PTICTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK THICKNESS (FOR ALL  ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      PHOLD=PDEFTH
      GOTO1280
C
 1260 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PTICTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK THICKNESS (FOR ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)PHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      PHOLD=PDEFTH
      GOTO1380
C
 1360 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PTICTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK THICKNESS (FOR ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)PHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      PHOLD=PDEFTH
      GOTO1480
C
 1460 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PTICTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK THICKNESS (FOR ALL',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)PHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      PHOLD=PDEFTH
      GOTO1580
C
 1560 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PTICTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK THICKNESS (FOR ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)PHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      PHOLD=PDEFTH
      GOTO1680
C
 1660 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PTICTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK THICKNESS (FOR ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)PHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      PHOLD=PDEFTH
      GOTO1780
C
 1760 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PTICTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK THICKNESS (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)PHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTEBA(IHARG,IARGT,ARG,NUMARG,ADETBA,MAXTEX,ATEXBA,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TEXT BASES.
C              THESE ARE LOCATED IN THE VECTOR ATEXBA(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --ADETBA
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ATEXBA (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION ATEXBA(*)
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
      ISUBN1='DPTE'
      ISUBN2='BA  '
C
      NUMTEX=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTEBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ADETBA
   55 FORMAT('ADETBA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ATEXBA(1)
   70 FORMAT('ATEXBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ATEXBA(I)
   76 FORMAT('I,ATEXBA(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=ADETBA
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      ATEXBA(1)=ADETBA
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-1
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADETBA
      IF(IHOLD1.EQ.'OFF')HOLD2=ADETBA
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADETBA
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADETBA
      ATEXBA(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,ATEXBA(I)
 1276 FORMAT('THE BASE OF TEXT ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADETBA
      IF(IHOLD1.EQ.'OFF')HOLD2=ADETBA
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADETBA
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADETBA
      DO1315I=1,NUMTEX
      ATEXBA(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ATEXBA(I)
 1316 FORMAT('THE BASE OF ALL TEXTS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTEBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ADETBA
 9015 FORMAT('ADETBA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ATEXBA(1)
 9030 FORMAT('ATEXBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ATEXBA(I)
 9036 FORMAT('I,ATEXBA(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTECH(IHARG,NUMARG,
     1IDEFTC,
     1ITERCH,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TERMINATOR CHARACTOR WHICH MAY
C              BE USED TO PUT MULTIPLE COMMAND STATEMENTS
C              ON A SINGLE COMMAND LINE.
C              WHEN A COMMAND LINE IS READ,
C              IT IS SEARCHED FOR THE TERMINATOR CHARACTER;
C              IF IT IS FOUND, THE COMMAND STATEMENT
C              BEFORE THE TERMINATOR CHARACTOR IS EXECUTED;
C              AFTER EXECUTION, THE COMMAND STAEMENT AFTER THE
C              TERMINATOR CHARACTOR IS EXECUTED.
C              ANY NUMBER OF TERMINATOR CHARACTORS ARE ALLOWED PER LINE.
C              THE COMMAND CHARACTER CAPABILITY ALLOWS THE ANALYST
C              TO PACK SEVERAL COMMANDS PER LINE.
C              THE SPECIFIED TERMINATOR CHARACTOR WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITERCH.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFTC (A  CHARACTER VARIABLE)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--ITERCH (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFTC
      CHARACTER*4 ITERCH
      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 DPTECH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFTC
   53 FORMAT('IDEFTC = ',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.0)GOTO1150
      GOTO1110
C
 1110 CONTINUE
      IF(NUMARG.LE.1)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
      IHOLD=IDEFTC
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ITERCH=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ITERCH
 1181 FORMAT('THE TERMINATOR CHARACTOR HAVE 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 DPECH--')
      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)IDEFTC,ITERCH
 9013 FORMAT('IDEFTC,ITERCH = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTEXT(IANS,IANSLC,IWIDTH,
CCCCC SUBROUTINE DPTEXT(IANS,IWIDTH,           SEPTEMBER 1993
     1ITEXTE,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,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
     1IMPSW2,AMPSCH,AMPSCW,
     1IBUGD2,IFOUND,IERROR)
C
CCCCC SUBROUTINE DPTEXT(IANS,IWIDTH,
CCCCC1ITEXTE,NCTEX,
CCCCC1PXSTAR,PYSTAR,PXEND,PYEND,
CCCCC1IGRASW,IDIASW,
CCCCC1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
CCCCC1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
CCCCC1ILINPA,ILINCO,PLINTH,
CCCCC1ATEXBA,
CCCCC1ITEBLI,ITEBCO,PTEBTH,
CCCCC1ITEFSW,ITEFCO,
CCCCC1ITEPTY,ITEPLI,ITEPCO,PTEPTH,PTEPSP,
CCCCC1ITEXCR,ITEXLF,PTEXMR,
CCCCC1ITEXSY,ITEXSP,
CCCCC1ITEXFO,ITEXCA,ITEXJU,ITEXDI,ATEXAN,ITEXFI,ITEXCO,
CCCCC1PTEXHE,PTEXWI,PTEXVG,PTEXHG,PTEXTH,
CCCCC1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
CCCCC1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
CCCCC1NUMDEV,IDMANU,IDMODE,IDMOD2,IDMOD3,
CCCCC1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
CCCCC1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--WRITE OUT A TEXT STRING.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --DECEMBER    1986.
C     UPDATED         --JULY        1988.
C     UPDATED         --JANUARY     1989.  CALL LIST FOR OFFSET
C                                          VARIABLES (ALAN)
C     UPDATED         --MARCH       1993.
C     UPDATED         --SEPTEMBER   1993. ALLOW LOWER CASE
C     UPDATED         --MARCH       1997. DEVICE FONT SUPPORT
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IANS
CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
      CHARACTER*4 IANSLC
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 ITEBLI
      CHARACTER*4 ITEBCO
      CHARACTER*4 ITEFSW
      CHARACTER*4 ITEFCO
      CHARACTER*4 ITEPTY
      CHARACTER*4 ITEPLI
      CHARACTER*4 ITEPCO
C
      CHARACTER*4 ITEXTE
      CHARACTER*4 ITEXFO
      CHARACTER*4 ITEXCA
      CHARACTER*4 ITEXJU
      CHARACTER*4 ITEXDI
      CHARACTER*4 ITEXFI
      CHARACTER*4 ITEXCO
C
      CHARACTER*4 ITEXCR
      CHARACTER*4 ITEXLF
C
      CHARACTER*4 ITEXSY
      CHARACTER*4 ITEXSP
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IFUNC
C
      CHARACTER*1 IREPCH
C
      CHARACTER*4 IMPSW2
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
C
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 ICOPSW
      CHARACTER*4 IBACCO
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
C
      CHARACTER*4 ITEXCV
C
      DIMENSION PRV(6)
      DIMENSION PDIARV(4)
      DIMENSION ITEXCV(10)
      DIMENSION PTEXRV(5)
C
      DIMENSION IANS(*)
CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
      DIMENSION IANSLC(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION ATEXBA(*)
      DIMENSION ITEBLI(*)
      DIMENSION ITEBCO(*)
      DIMENSION PTEBTH(*)
      DIMENSION ITEFSW(*)
      DIMENSION ITEFCO(*)
      DIMENSION ITEPTY(*)
      DIMENSION ITEPLI(*)
      DIMENSION ITEPCO(*)
      DIMENSION PTEPTH(*)
      DIMENSION PTEPSP(*)
C
      DIMENSION ITEXTE(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IFUNC(*)
C
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
CCCCC DIMENSION ICTEXT(130)
      INCLUDE 'DPCOPA.INC'
      DIMENSION ICTEXT(MAXCH)
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
      PGRAXF=PRV(1)
      PGRAYF=PRV(2)
      PDIAXC=PRV(3)
      PDIAYC=PRV(4)
      PDIAX2=PRV(5)
      PDIAY2=PRV(6)
C
      PDIAHE=PDIARV(1)
      PDIAWI=PDIARV(2)
      PDIAVG=PDIARV(3)
      PDIAHG=PDIARV(4)
C
      ITEXFO=ITEXCV(1)
      ITEXCA=ITEXCV(2)
      ITEXJU=ITEXCV(3)
      ITEXDI=ITEXCV(4)
      ITEXCR=ITEXCV(5)
      ITEXLF=ITEXCV(6)
      ITEXSY=ITEXCV(7)
      ITEXSP=ITEXCV(8)
      ITEXFI=ITEXCV(9)
      ITEXCO=ITEXCV(10)
C
      PTEXHE=PTEXRV(1)
      PTEXWI=PTEXRV(2)
      PTEXVG=PTEXRV(3)
      PTEXHG=PTEXRV(4)
      PTEXTH=PTEXRV(5)
C
      IFOUND='NO'
      IERROR='NO'
C
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      J2=0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TEXT')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTEXT--')
      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(I),I=1,IWIDTH) = ',25A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,55)NCTEX
CCC55 FORMAT('NCTEX= ',I8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,56)(ITEXTE(I),I=1,NCTEX)
CCC56 FORMAT('(ITEXTE(I),I=1,NCTEX) = ',25A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PDIAXC,PDIAYC
   58 FORMAT('PDIAXC,PDIAYC = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)PXSTAR,PYSTAR
   59 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)PXEND,PYEND
   60 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)ATEXBA(1)
   62 FORMAT('ATEXBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ITEBLI(1),ITEBCO(1),PTEBTH(1)
   63 FORMAT('ITEBLI(1),ITEBCO(1),PTEBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ITEFSW(1),ITEFCO(1)
   64 FORMAT('ITEFSW(1),ITEFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)ITEPTY(1),ITEPLI(1),ITEPCO(1),PTEPTH(1),PTEPSP(1)
   65 FORMAT('ITEPTY(1),ITEPLI(1),ITEPCO(1),PTEPTH(1),PTEPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ITEXCR,ITEXLF,PTEXMR
   66 FORMAT('ITEXCR,ITEXLF,PTEXMR = ',A4,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ITEXSY,ITEXSP,ITEXFO,ITEXCA,ITEXJU
   67 FORMAT('ITEXSY,ITEXSP,ITEXFO,ITEXCA,ITEXJU = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)ITEXDI,ATEXAN
   68 FORMAT('ITEXDI,ATEXAN = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)ITEXFI,ITEXCO
   69 FORMAT('ITEXFI,ITEXCO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXHE
   70 FORMAT('PTEXHE= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)PTEXWI
   71 FORMAT('PTEXWI= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)PTEXVG
   72 FORMAT('PTEXVG= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)PTEXHG
   73 FORMAT('PTEXHG= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)PTEXTH
   74 FORMAT('PTEXTH = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)NUMNAM
   75 FORMAT('NUMNAM= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO76I=1,NUMNAM
      WRITE(ICOUT,77)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
   77 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)= ',
     1I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   76 CONTINUE
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND,IREPCH
   87 FORMAT('IFOUND,IREPCH = ',A4,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************************************
C               **  STEP 1--                                       **
C               **  EXTRACT THE TEXT STRING FROM THE COMMAND LINE  **
C               *****************************************************
C
C               *****************************************
C               **  STEP 1.1--                         **
C               **  DETERMINE THE COMMAND              **
C               **  (TEXT) AND ITS LOCATION            **
C               **  ON THE LINE.                       **
C               **  DETERMINE THE START POSITION       **
C               **  (XSTART) OF THE FIRST CHARACTER    **
C               **  FOR THE STRING TO BE PRINTED.      **
C               *****************************************
C
      DO1115I=1,IWIDTH
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
C
CCCCC IF(IP4.GT.IWIDTH)GOTO1130
      IF(IP3.EQ.IWIDTH)GOTO1190
      IF(IP4.EQ.IWIDTH)GOTO1190
      IF(IANS(I).EQ.'T'.AND.IANS(IP1).EQ.'E'.AND.
     1IANS(IP2).EQ.'X'.AND.IANS(IP3).EQ.'T'.AND.
     1IANS(IP4).EQ.' ')GOTO1190
 1115 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPTEXT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      NO MATCH FOR COMMAND.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1190 CONTINUE
C
C               **********************************************************
C               **  STEP 1.2--                                          **
C               **  DEFINE THE STOP  POSITION (ISTOP) FOR THE STRING.   **
C               **********************************************************
C
      IFOUND='YES'
C
      ISTART=IP5
      ISTOP=0
      IF(ISTART.GT.IWIDTH)GOTO1229
      DO1220I=ISTART,IWIDTH
      IREV=IWIDTH-I+ISTART
      IF(IANS(IREV).NE.' ')GOTO1225
 1220 CONTINUE
      GOTO1229
 1225 CONTINUE
      ISTOP=IREV
 1229 CONTINUE
C
C               *****************************************
C               **  STEP 1.3--                         **
C               **  COPY OVER THE STRING OF INTEREST.  **
C               *****************************************
C
      IF(ISTART.GT.ISTOP)GOTO1380
      IF(ISTOP.EQ.0)GOTO1380
C  SEPTEMBER, 1987 (CHECK IF MAXIMUM SIZE STRING EXCEEDED)
      ITEMP=ISTOP-ISTART+1
      IF(ITEMP.GT.MAXCH)ITEMP=MAXCH
      ISTOP=ISTART+ITEMP-1
C
      J=0
      DO1310I=ISTART,ISTOP
      J=J+1
      J2=J
CCCCC THE FOLLOWING LINE WAS CHANGED     SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
CCCCC CHECK FOR CASE "ASIS"              OCTOBER   1993
CCCCC ITEXTE(J)=IANS(I)
      IF(ITEXCA.EQ.'ASIS')THEN
        ITEXTE(J)=IANSLC(I)
      ELSE
        ITEXTE(J)=IANS(I)
      ENDIF
 1310 CONTINUE
      NCTEX=J2
      GOTO1390
 1380 CONTINUE
      NCTEX=0
 1390 CONTINUE
C
C               ******************************************
C               **  STEP 1.4--                          **
C               **  COPY OVER THE ORIGINAL TEXT STRING  **
C               **  SO AS TO PRESERVE IT IN COMMON.     **
C               ******************************************
C
 1400 CONTINUE
      NCTEXT=NCTEX
      IF(NCTEX.LE.0)GOTO1490
      DO1410I=1,NCTEX
      ICTEXT(I)=ITEXTE(I)
 1410 CONTINUE
 1490 CONTINUE
C
C               ******************************************************
C               **  STEP 1.4--                                    **
C               **  CALL THE SUBROUTINE DPREPL                      **
C               **  WHICH WILL SCAN THE STRING FOR ALL OCCURRANCES  **
C               **  OF THE SUBSTRING VALU()                         **
C               **  AND REPLACE THEM BY THEIR LITERAL VALUES.       **
C               ******************************************************
C
      IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGD2,IERROR)
C
C               ********************************
C               **  STEP 2--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
C  JULY, 1988.  BUG: IF DEVICE 1 OFF AND DEVICE 2 ON,
C  STARTING COORDINATES PX1 AND PY1 WERE NOT GETTING SET.
C  MOVE FROM INSIDE LOOP TO HERE.
      PX1=PXSTAR
      PY1=PYSTAR
C  END BUG FIX
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 3--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************
C               **  STEP 4--               **
C               **  WRITE OUT THE TEXT     **
C               *****************************
C
      IFONT=ITEXFO
      ICASE=ITEXCA
      IJUST=ITEXJU
      IDIR=ITEXDI
      ANGLE=ATEXAN
      IFILL=ITEXFI
      ICOL=ITEXCO
      PHEIGH=PTEXHE
      PWIDTH=PTEXWI
      PHOGAP=PTEXHG
      PVEGAP=PTEXVG
      PTHICK=PTEXTH
      ISYMBL=ITEXSY
      ISPAC=ITEXSP
C
C  JULY, 1988.  MOVE FOLLOWING 4 LINES TO BEFORE LOOP.
CCCCC IF(IDEVIC.GE.2)GOTO1610
CCCCC PX1=PXSTAR
CCCCC PY1=PYSTAR
C1610 CONTINUE
C
      IF(NCTEXT.GE.1)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
CCCCC MARCH 1993.  MOVE FOLLOWING SECTION OUTSIDE LOOP.
CCCCC IF(IDEVIC.GE.2)GOTO1690
CCCCC PXEND=PX99
CCCCC PYEND=PY99
CCCCC IF(ITEXCR.EQ.'ON')PXEND=PTEXMR
CCCCC IF(ITEXLF.EQ.'ON')PYEND=PYSTAR-PTEXHE-PTEXVG
C
CCCCC PXSTAR=PXEND
CCCCC PYSTAR=PYEND
C
 1690 CONTINUE
C
C               ************************************
C               **  STEP 5--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C  MARCH, 1993.  BUG: IF DEVICE 1 OFF AND DEVICE 2 ON,
C  NEW VALUES OF PXSTAR AND PYSTAR NOT SET.
C  MOVE FROM INSIDE LOOP TO HERE.
      PXEND=PX99
      PYEND=PY99
      IF(ITEXCR.EQ.'ON')PXEND=PTEXMR
      IF(ITEXLF.EQ.'ON')PYEND=PYSTAR-PTEXHE-PTEXVG
C
      PXSTAR=PXEND
      PYSTAR=PYEND
C  END CHANGE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IERROR=IERRG4
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TEXT')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTEXT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NCTEX
 9015 FORMAT('NCTEX  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(ITEXTE(I),I=1,NCTEX)
 9016 FORMAT('(ITEXTE(I),I =1,NCTEX) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)NCTEXT
 9017 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)(ICTEXT(I),I=1,NCTEXT)
 9018 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)PXSTAR,PYSTAR
 9019 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)PXEND,PYEND
 9020 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ILINPA(1),ILINCO(1),PLINTH(1)
 9021 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)ATEXBA(1)
 9022 FORMAT('ATEXBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ITEBLI(1),ITEBCO(1),PTEBTH(1)
 9023 FORMAT('ITEBLI(1),ITEBCO(1),PTEBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ITEFSW(1),ITEFCO(1)
 9024 FORMAT('ITEFSW(1),ITEFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)ITEPTY(1),ITEPLI(1),ITEPCO(1),PTEPTH(1),PTEPSP(1)
 9025 FORMAT('ITEPTY(1),ITEPLI(1),ITEPCO(1),PTEPTH(1),PTEPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)ITEXCR,ITEXLF,PTEXMR
 9026 FORMAT('ITEXCR,ITEXLF,PTEXMR = ',A4,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ITEXSY,ITEXSP,ITEXFO,ITEXCA,ITEXJU
 9027 FORMAT('ITEXSY,ITEXSP,ITEXFO,ITEXCA,ITEXJU = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)ITEXDI,ATEXAN
 9028 FORMAT('ITEXDI,ATEXAN = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)PX1,PY1
 9033 FORMAT('PX1, PY1  = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PX99,PY99
 9034 FORMAT('PX99,PY99 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IMANUF,IMODEL
 9035 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)IFOUND
 9038 FORMAT('IFOUND = ',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 ')
      WRITE(ICOUT,9041)IREPCH
 9041 FORMAT('IREPCH = ',A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTFCO(IHARG,NUMARG,IDETFC,MAXTEX,ITEFCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TEXT FILL COLORS = THE COLORS
C              OF THE (BACKGROUND) FILL WITHIN THE TEXTS.
C              THESE ARE LOCATED IN THE VECTOR ITEFCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDETFC
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ITEFCO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDETFC
      CHARACTER*4 ITEFCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION ITEFCO(*)
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
      ISUBN1='DPTF'
      ISUBN2='CO  '
C
      NUMTEX=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDETFC
   55 FORMAT('IDETFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ITEFCO(1)
   70 FORMAT('ITEFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ITEFCO(I)
   76 FORMAT('I,ITEFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      ITEFCO(1)=IDETFC
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-2
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDETFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETFC
      ITEFCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,ITEFCO(I)
 1276 FORMAT('THE FILL COLOR OF TEXT ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDETFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETFC
      DO1315I=1,NUMTEX
      ITEFCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ITEFCO(I)
 1316 FORMAT('THE FILL COLOR OF ALL TEXTS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDETFC
 9015 FORMAT('IDETFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ITEFCO(1)
 9030 FORMAT('ITEFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ITEFCO(I)
 9036 FORMAT('I,ITEFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTFSW(IHARG,NUMARG,IDETFS,MAXTEX,ITEFSW,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TEXT FILL SWITCHES = THE ON/OFF SWITCHES
C              OF THE (BACKGROUND) FILL WITHIN THE TEXTS.
C              THESE ARE LOCATED IN THE VECTOR ITEFSW(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDETFS
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ITEFSW (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDETFS
      CHARACTER*4 ITEFSW
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION ITEFSW(*)
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
      ISUBN1='DPTF'
      ISUBN2='SW  '
C
      NUMTEX=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDETFS
   55 FORMAT('IDETFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ITEFSW(1)
   70 FORMAT('ITEFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ITEFSW(I)
   76 FORMAT('I,ITEFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='ON'
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      ITEFSW(1)='ON'
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-2
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETFS
      ITEFSW(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,ITEFSW(I)
 1276 FORMAT('THE FILL SWITCH FOR TEXT ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETFS
      DO1315I=1,NUMTEX
      ITEFSW(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ITEFSW(I)
 1316 FORMAT('THE FILL SWITCH FOR ALL TEXTS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDETFS
 9015 FORMAT('IDETFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ITEFSW(1)
 9030 FORMAT('ITEFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ITEFSW(I)
 9036 FORMAT('I,ITEFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTHIC(IHARG,IARGT,ARG,NUMARG,
     1PDEFTH,
     1PTEXTH,
C  DECEMBER 1987: SET ALL THICKNESS (CAN THEN
C  OVERRIDE ANY INDIVIDUALLY)
     1PFRATH,PTICTH,PTIZTH,PVGRTH,PHGRTH,PTITTH,PX1LTH,PX2LTH,PY1LTH,
     1PY2LTH,PLEGTH,MAXLG,PBOPTH,PBOFTH,MAXBX,PARRTH,MAXAR,
     1PSEGTH,MAXSG,PLINTH,MAXLN,PCHATH,MAXCH2,PFILTH,MAXFL,
     1PPATTH,MAXPT,PSPITH,MAXSP,PBABTH,PBAPTH,MAXBA,PREPTH,MAXRG,
     1PMABTH,PMAPTH,MAXMR,PTEBTH,PTEPTH,MAXTX,
C  END CHANGE
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE THICKNESS FOR TEXT CHARACTERS.
C              THE THICKNESS FOR TEXT CHARACTERS WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PTEXTH.
C     NOTE--THE THICKNESS IS IN STANDARDIZED UNITS (0.0 TO 100.0).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PDEFTH
C                     --IBUGD2
C     OUTPUT ARGUMENTS--PTEXTH
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  SET ALL THICKNESS PARAMETERS (ALAN)
C     UPDATED         --SEPTEMBER 1993.  FIX BUG FORMAT STATEMENT
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
C  DECEMBER 1987
      DIMENSION PLEGTH(*)
      DIMENSION PBOPTH(*)
      DIMENSION PBOFTH(*)
      DIMENSION PARRTH(*)
      DIMENSION PSEGTH(*)
      DIMENSION PLINTH(*)
      DIMENSION PCHATH(*)
      DIMENSION PFILTH(*)
      DIMENSION PPATTH(*)
      DIMENSION PSPITH(*)
      DIMENSION PBABTH(*)
      DIMENSION PBAPTH(*)
      DIMENSION PREPTH(*)
      DIMENSION PMABTH(*)
      DIMENSION PMAPTH(*)
      DIMENSION PTEBTH(*)
      DIMENSION PTEPTH(*)
C  END CHANGE
      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 DPTHIC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PDEFTH
   53 FORMAT('PDEFTH = ',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 THICKNESS 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 DPTHIC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR THICKNESS ',
     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 THICKNESS OF 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      (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('           THICKNESS 1 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PTEXTH=PDEFTH
      GOTO1180
C
 1160 CONTINUE
      PTEXTH=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
C  DECEMBER 1987: SET ALL THICKNESSES TO THE SET VALUE
      PFRATH=PTEXTH
      PTICTH=PTEXTH
      PTIZTH=PTEXTH
      PVGRTH=PTEXTH
      PHGRTH=PTEXTH
      PTITTH=PTEXTH
      PX1LTH=PTEXTH
      PX2LTH=PTEXTH
      PY1LTH=PTEXTH
      PY2LTH=PTEXTH
      DO2010I=1,MAXLG
      PLEGTH(I)=PTEXTH
 2010 CONTINUE
      DO2020I=1,MAXBX
      PBOPTH(I)=PTEXTH
      PBOFTH(I)=PTEXTH
 2020 CONTINUE
      DO2030I=1,MAXAR
      PARRTH(I)=PTEXTH
 2030 CONTINUE
      DO2040I=1,MAXSG
      PSEGTH(I)=PTEXTH
 2040 CONTINUE
      DO2050I=1,MAXLN
      PLINTH(I)=PTEXTH
 2050 CONTINUE
      DO2060I=1,MAXCH2
      PCHATH(I)=PTEXTH
 2060 CONTINUE
      DO2070I=1,MAXFL
      PFILTH(I)=PTEXTH
 2070 CONTINUE
      DO2080I=1,MAXPT
      PPATTH(I)=PTEXTH
 2080 CONTINUE
      DO2090I=1,MAXSP
      PSPITH(I)=PTEXTH
 2090 CONTINUE
      DO2100I=1,MAXBA
      PBABTH(I)=PTEXTH
      PBAPTH(I)=PTEXTH
 2100 CONTINUE
      DO2110I=1,MAXRG
      PREPTH(I)=PTEXTH
 2110 CONTINUE
      DO2120I=1,MAXMR
      PMABTH(I)=PTEXTH
      PMAPTH(I)=PTEXTH
 2120 CONTINUE
      DO2130I=1,MAXTX
      PTEBTH(I)=PTEXTH
      PTEPTH(I)=PTEXTH
 2130 CONTINUE
C  END CHANGE
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE THICKNESS (FOR TEXT CHARACTERS)  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PTEXTH
 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)PTEXTH
 8111 FORMAT('THE CURRENT (TEXT) THICKNESS IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)PDEFTH
 8112 FORMAT('THE DEFAULT (TEXT) THICKNESS 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 DPTHIC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
CCCCC THE FOLLOWING LINE WAS FIXED    SEPTEMBER 1993
C9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',,A4,2X,A4,2X,A4)
 9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PTEXTH
 9013 FORMAT('PTEXTH = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTIC(ICOM,IHARG,NUMARG,
     1IX1TSW,IX2TSW,IY1TSW,IY2TSW,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC MARK SWITCHES CONTAINED IN THE
C              4 VARIABLES IX1TSW,IX2TSW,IY1TSW,IY2TSW
C              SUCH TIC MARK SWITCHES TURN ON OR OFF
C              THE TIC MARKS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --IX1TSW = LOWER HORIZONTAL FRAME TIC MARKS
C                     --IX2TSW = UPPER HORIZONTAL FRAME TIC MARKS
C                     --IY1TSW = LEFT  VERTICAL   FRAME TIC MARKS
C                     --IY2TSW = RIGHT VERTICAL   FRAME TIC MARKS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1988. (ALLOW FOR TIC NUMBER COMMAND)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IX1TSW
      CHARACTER*4 IX2TSW
      CHARACTER*4 IY1TSW
      CHARACTER*4 IY2TSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'POSI')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'HW')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'LABE')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLAC')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OFFS')GOTO1900
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'COLO')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'COOR')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'POSI')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'SIZE')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'HW')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'DECI')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'PLAC')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'NUMB')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'OFFS')GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1160
      IF(IHARG(NUMARG).EQ.'MARK')GOTO1160
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1150
C
 1150 CONTINUE
      IHOLD='ON'
      GOTO1180
C
 1160 CONTINUE
      IHOLD='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1TSW=IHOLD
      IX2TSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARKS (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAVE JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1260
      IF(IHARG(NUMARG).EQ.'MARK')GOTO1260
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1260
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      GOTO1250
C
 1250 CONTINUE
      IHOLD='ON'
      GOTO1280
C
 1260 CONTINUE
      IHOLD='OFF'
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1TSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARKS (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAVE JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1360
      IF(IHARG(NUMARG).EQ.'MARK')GOTO1360
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1360
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      GOTO1350
C
 1350 CONTINUE
      IHOLD='ON'
      GOTO1380
C
 1360 CONTINUE
      IHOLD='OFF'
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2TSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARKS (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAVE JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(NUMARG.LE.0)GOTO1460
      IF(IHARG(NUMARG).EQ.'MARK')GOTO1460
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1460
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      GOTO1450
C
 1450 CONTINUE
      IHOLD='ON'
      GOTO1480
C
 1460 CONTINUE
      IHOLD='OFF'
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1TSW=IHOLD
      IY2TSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARKS (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAVE JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(NUMARG.LE.0)GOTO1560
      IF(IHARG(NUMARG).EQ.'MARK')GOTO1560
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1560
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      GOTO1550
C
 1550 CONTINUE
      IHOLD='ON'
      GOTO1580
C
 1560 CONTINUE
      IHOLD='OFF'
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1TSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARKS (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAVE JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(NUMARG.LE.0)GOTO1660
      IF(IHARG(NUMARG).EQ.'MARK')GOTO1660
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1660
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      GOTO1650
C
 1650 CONTINUE
      IHOLD='ON'
      GOTO1680
C
 1660 CONTINUE
      IHOLD='OFF'
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2TSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARKS (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAVE JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(NUMARG.LE.0)GOTO1760
      IF(IHARG(NUMARG).EQ.'MARK')GOTO1760
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1760
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      GOTO1750
C
 1750 CONTINUE
      IHOLD='ON'
      GOTO1780
C
 1760 CONTINUE
      IHOLD='OFF'
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1TSW=IHOLD
      IX2TSW=IHOLD
      IY1TSW=IHOLD
      IY2TSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARKS (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAVE JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTICA(IHARG,NUMARG,IDEFCA,ITITCA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE CASE FOR THE TITLE
C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
C              THE CASE FOR THE TITLE WILL BE PLACED
C              IN THE HOLLERITH VARIABLE ITITCA.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCA
C     OUTPUT ARGUMENTS--ITITCA
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCA
      CHARACTER*4 ITITCA
      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)GOTO1199
      IF(IHARG(1).EQ.'CASE')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
      IF(NUMARG.EQ.1)GOTO1150
      GOTO1160
C
 1150 CONTINUE
      ITITCA=IDEFCA
      GOTO1180
C
 1160 CONTINUE
      ITITCA=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)ITITCA
 1181 FORMAT('THE TITLE CASE HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPTICL(IHARG,NUMARG,IDEFCO,ITITCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE TITLE
C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
C              THE COLOR FOR THE TITLE WILL BE PLACED
C              IN THE HOLLERITH VARIABLE ITITCO.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C     OUTPUT ARGUMENTS--ITITCO
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCO
      CHARACTER*4 ITITCO
      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)GOTO1199
      IF(IHARG(1).EQ.'COLO')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
      IF(NUMARG.EQ.1)GOTO1150
      GOTO1160
C
 1150 CONTINUE
      ITITCO=IDEFCO
      GOTO1180
C
 1160 CONTINUE
      ITITCO=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)ITITCO
 1181 FORMAT('THE TITLE COLOR HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPTIFO(IHARG,NUMARG,IDEFFO,ITITFO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FONT FOR THE TITLE
C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
C              THE FONT FOR THE TITLE WILL BE PLACED
C              IN THE HOLLERITH VARIABLE ITITFO.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFO
C     OUTPUT ARGUMENTS--ITITFO
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFFO
      CHARACTER*4 ITITFO
      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)GOTO1199
      IF(IHARG(1).EQ.'FONT')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
      IF(NUMARG.EQ.1)GOTO1150
      GOTO1160
C
 1150 CONTINUE
      ITITFO=IDEFFO
      GOTO1180
C
 1160 CONTINUE
      ITITFO=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)ITITFO
 1181 FORMAT('THE TITLE FONT HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END