PROGRAM DATAPLOT C C PURPOSE--THIS IS THE MAIN ROUTINE FOR DATAPLOT-- C THE INTERACTIVE GRAPHICAL DATA ANALYSIS LANGUAGE. C C THE MAIN ROUTINE FOR DATAPLOT IS MAIN. C MAIN CALLS 6 SEARCH SUBROUTINES-- C MAINGR--SEARCH FOR AND EXECUTE GRAPHICS COMMANDS. C MAINPC--SEARCH FOR AND EXECUTE PLOT CONTROL COMMANDS. C MAINOD--SEARCH FOR AND EXECUTE OUTPUT DEVICE COMMANDS. C MAINAN--SEARCH FOR AND EXECUTE ANALYSIS COMMANDS. C MAINSU--SEARCH FOR AND EXECUTE SUPPORT COMMANDS. C MAINDG--SEARCH FOR AND EXECUTE DIAGRAMMATIC GRAPHICSM COMMAN C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--88/9 C ORIGINAL VERSION--NOVEMBER 10, 1977. C UPDATED --OCTOBER 1978. C UPDATED --NOVEMBER 1978. C UPDATED --JANUARY 1979. C UPDATED --FEBRUARY 1979. C UPDATED --JUNE 1979. C UPDATED --JULY 1979. C UPDATED --SEPTEMBER 1980. C UPDATED --FEBRUARY 1981. C UPDATED --MARCH 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --OCTOBER 1981. C UPDATED --MAY 1982. C UPDATED --SEPTEMBER 1983. C UPDATED --JULY 1988. CHANGE HELP MAX FROM NO LIMIT TO 20 C UPDATED --SEPTEMBER 1988. 3D PROJECTION (ORTHOGRAP./PERSPECT.) C UPDATED --DECEMBER 1988. ADD ISEED TO CALL TO MAINGR (DPFRAC) C UPDATED --DECEMBER 1988. RESET DATA, IO, PC, ETC & RESET2 C UPDATED --DECEMBER 1988. SET WRITE FORMAT C UPDATED --DECEMBER 1988. SET READ REWIND C UPDATED --DECEMBER 1988. SET WRITE REWIND C UPDATED --DECEMBER 1988. SUP ERR MESS FOR BACKSLASH IN FALSE IF C UPDATED --DECEMBER 1988. FIX NON-STOR OF SET/PROBE IF IN LOOP C UPDATED --DECEMBER 1988. LOWESS FRACTION C UPDATED --JANAURY 1989. # CHAR IN AUTO-X3LABEL FOR NOR. P.P. C UPDATED --JANUARY 1989. FIX 4-PLOT OF NON-EX VAR STAYED SMALL C UPDATED --JANUARY 1989. 4-PLOT CODE AS A SEPARATE SUBROUTINE C UPDATED --JANUARY 1989. ADD BOOTSTRAP SIZE TO MAINGR/SU C UPDATED --FEBRUARY 1989. ADD 3-D COMMON C UPDATED --FEBRUARY 1989. ADD DEVICE & SET COMMON (ALAN) C UPDATED --APRIL 1989. DELETE SOME ARGS IN CALLS TO DP4PLO C UPDATED --APRIL 1989. SOFT-CODE BACKSLASH FOR UNIX C UPDATED --MAY 1989. VERSION COMMAND C UPDATED --JUNE 1989. CHANGE BACKSLASH TO # FOR IBM-PC & COM C UPDATED --JUNE 1989. BACKSLASH TO # FOR IBM-PC & COMPAQ C UPDATED --JUNE 1989. BACKSLASH ADDED TO MAINSU ARG LIST C UPDATED --JUNE 1989. SUPPRESS ERROR MESSAGE FOR \ IN COMMENT C UPDATED --JUNE 1989. ICAPSW AND IPRDEF DEFINED FOR CAPTURE C UPDATED --JULY 1989. SOME IANSLC ENTRIES TOO LONG/SHORT C UPDATED --NOVEMBER 1989. LOWESS FRACTION DEFAULT TO .1 C UPDATED --NOVEMBER 1989. SELECTIVE PRINTING OF YATES COEF C UPDATED --MAY 1990. UPDATE X11 SCREEN IF NEEDED. C DEFINE NON-PRINTING CHARACTERS AFTER C CALL INITMC. C UPDATED --JUNE 1990. IGUNIT=IPR (FIX DEF TO DPPL1F.DAT) C UPDATED --JUNE 1990. ADD SOME INCLUDE FILES C UPDATED --JUNE 1990. NORMAL PLOT C UPDATED --JUNE 1990. MENU SUBSYSTEM C UPDATED --JULY 1990. X-WINDOWS UPDATE (ALAN) C UPDATED --JULY 1990. COMMENT OUT IHOST1/2 DEF. C UPDATED --JULY 1990. FREE R CHART FROM R (REPEAT) C UPDATED --AUGUST 1990. ADD 11 MENU CHAR SECTIONS C UPDATED --AUGUST 1990. FIRST PASS AT WINDOW SYSTEM C UPDATED --AUGUST 1990. WINDOW SYSTEM COMMON C UPDATED --JUNE 1991. TURBO-C GUI MENU C UPDATED --JUNE 1991. KILL OLD TC WINDOW LOGIC. C UPDATED --JULY 1991. AUTO-VGA WHITH TURBO-C MENU C UPDATED --OCTOBER 1991. ADD BLOCK DATA (ALAN) C UPDATED --FEBRUARY 1992. ALLOW ARGS ON DP COMMAND LINE C UPDATED --MARCH 1992. EXEC & WRITE TO FILE C UPDATED --MARCH 1992. EXEC & WRITE TO LASER PRINTER C UPDATED --APRIL 1992. BAR EXPANSION FACTORS ... ... C UPDATED --APRIL 1992. NPLOTP ADDED TO MAINSU ARGS C UPDATED --APRIL 1992. NPLOTP ADDED TO DPSET ARGS C UPDATED --APRIL 1992. NPLOTP ADDED TO DPPROB ARGS C UPDATED --APRIL 1992. LINE FOR NOS/VE COMMAND LINE C UPDATED --MAY 1992. DEFINE/OPEN DEVICE 3 AS POST C UPDATED --JUNE 1992. EMPTY THE COMMAND LOG FILE C UPDATED --JULY 1992. ADD EDITOR (FED) C UPDATED --AUGUST 1992. FIX X3LABEL AUTOMATIC INTERACTIONS C UPDATED --AUGUST 1992. REWRITE ... AUTOMATIC SECTION C UPDATED (MAKE GO-TO-LESS) C UPDATED --AUGUST 1992. PASS ... AUTOMATIC SWITCHES C UPDATED TO MAINPC C UPDATED --AUGUST 1992. ARGUMENT LIST TO DPGRAP C UPDATED --NOVEMBER 1992. ALLOW NESTED IF BLOCKS C UPDATED --FEBRUARY 1993. IPRITY ADDED TO DPSET ARGS C UPDATED --FEBRUARY 1993. IPRITY ADDED TO DPPROB ARGS C UPDATED --FEBRUARY 1993. ERROR MESSAGE 8112 AUGMENTED C UPDATED --FEBRUARY 1993. MENU IDMANU(1) VGA => TURB C UPDATED --FEBRUARY 1993. INITIAL VALUE FOR IPLATF C UPDATED --JULY 1993. ADD ALAN'S NAME TO BANNER C UPDATED --SEPTEMBER 1993. AUTO LABELS: ALLOW for C UPDATED --SEPTEMBER 1993. X2LABEL AUTO ==> BLANK C UPDATED --SEPTEMBER 1993. Y2LABEL AUTO ==> BLANK C UPDATED --SEPTEMBER 1993. CCAM ==> CAML in title C UPDATED --DECEMBER 1993. 6-PLOT C UPDATED --DECEMBER 1993. DEFAULT PATH FOR IBM-PC C UPDATED --JANUARY 1994. WEIB MINMAX TO DPCOS2.INC C UPDATED --FEBRUARY 1994. ARGUMENTS TO DPLOEX C UPDATED --MARCH 1994. ARGUMENTS TO MAINAN, MAINSU C UPDATED --AUGUST 1994. EXECUTE SUBSET OF MACRO C UPDATED --APRIL 1995. IUNFOF, IUNFNR, IUNFMC C UPDATED --MAY 1995. EQUIVALENCE SOME ARRAYS TO COMMON C UPDATED --JULY 1995. ALWAYS CALL C:\DATAPLOT\DPLOGF C UPDATED --JULY 1995. FIT SETTINGS IN DPSET/DPPROB C UPDATED --AUGUST 1995. IFTORD (SET FOURIER ORDER C C UPDATED --FEBRUARY 1996. INITIALIZE MENU PATH C UPDATED --FEBRUARY 1996. MOVE CALL TCINCF TO AFTER MENU PATH C UPDATED --FEBRUARY 1996. MOVE CALL TCINCO FROM INITOD C UPDATED --MARCH 1996. IRHSTG (SET RELATIVE HISTOGRAM C C UPDATED --MARCH 1996. ARGUMENT LIST TO MAINSU C UPDATED --APRIL 1996. DPCODD INCLUDE FILE FOR DDS C UPDATED --JULY 1996. INITIALIZE IWBFLG VARIABLE C UPDATED --JANUARY 1997. CHECK FOR SUCCESSFUL OPENING C OF DPPL2F.DAT FILE C UPDATED --APRIL 1997. DPCOPM INCLUDE FILE C UPDATED --NOVEMBER 1997. DON'T STORE "GUI" COMMANDS C UPDATED --DECEMBER 1997. REPLOT COMMAND C UPDATED --JANUARY 1998. CALL DPFLSH FOR TCL/TK C UPDATED --MAY 1998. HAZARD PLOT UPDATE C UPDATED --SEPTEMBER 1998. MAINDG ARGUMENT LIST C UPDATED --AUGUST 1999. MAINPC, DPGRAP ARGUMENT LIST C UPDATED --SEPTEMBER 1999. ADD R-F SPREAD PLOT C UPDATED --SEPTEMBER 1999. ADD SCATTER PLOT MATRIX C UPDATED --SEPTEMBER 1999. ADD CONDITITIONING PLOT C UPDATED --JANUARY 2000. ARGUMENT LIST TO DPREP2 C UPDATED --MARCH 2002. ACTIVATE VERSION COMMAND C (DATE WILL BE UPDATED C APPROXIMATELY ONCE A MONTH) C UPDATED --MARCH 2002. ARGUMENT LIST TO DP4PLO, DP6PLO C UPDATED --JUNE 2002. ADD PARTIAL REGRESSION PLOT C UPDATED --JUNE 2002. ADD PARTIAL RESIDUAL PLOT C UPDATED --JUNE 2002. ADD PARTIAL LEVERAGE PLOT C UPDATED --JULY 2002. ELSE CLAUSE FOR IF C UPDATED --JANUARY 2005. BUG IN NESTED IF'S C UPDATED --FEBRUARY 2005. CHECK FOR REPEAT SD PLOT C FOR REPEAT COMMAND C UPDATED --MARCH 2006. OPNPLOT COMMON BLOCK C UPDATED --OCTOBER 2006. CALL LIST TO DP4PLO C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IVGMSW CHARACTER*4 IHGMSW C CHARACTER*4 IMPSW CHARACTER*4 IERASV CCCCC THE FOLLOWING LINE WAS ADDED JULY 1991 (JJF) CHARACTER*4 IFEESV C CHARACTER*4 ICOMT C CHARACTER*4 ISQUAR CHARACTER*4 ITOPIC CHARACTER*4 IPROSW CHARACTER*4 IOFILE C CHARACTER*4 IFOUND CHARACTER*4 IERROR CHARACTER*4 IMACOL CHARACTER*4 ICASAN CHARACTER*4 ICASPL CHARACTER*4 ICONT CHARACTER*4 IAND1 CHARACTER*4 IAND2 C CHARACTER*4 IMAFIL C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*4 ILOOST CHARACTER*4 IHPNV CHARACTER*4 IHPNV2 CHARACTER*4 IANSLO CHARACTER*4 IBUGLO C CHARACTER*4 IMACRO CHARACTER*12 IMACCS C CHARACTER*4 IBUGI2 CHARACTER*4 ICOMHO CHARACTER*4 ICOMH2 C CHARACTER*4 IBUGUG CHARACTER*4 IBUGU2 CHARACTER*4 IBUGU3 CHARACTER*4 IBUGU4 C CHARACTER*4 ISUBRO C CHARACTER*4 IBUGEX CHARACTER*4 IBUGE2 C CHARACTER*4 IBUGHE CHARACTER*4 IBUGH2 C CHARACTER*4 IREPST CHARACTER*1 IANSSV CCCCC DECEMBER 1997. ADD FOLLOWING 2 LINES CHARACTER*4 IPLTST CHARACTER*1 IPLTSV C CHARACTER*80 ISACNC C CHARACTER*1 IC1 CHARACTER*4 IC4 C CHARACTER*4 IAUTSW CHARACTER*4 IAUTEX C CHARACTER*4 ICASIF CCCCC FOLLOWING 2 LINES ADDED NOVEMBER 1992. PARAMETER(MAXIF=10) CHARACTER*4 ICASI2(MAXIF) CHARACTER*4 ICASI3(MAXIF) C CHARACTER*4 IIFSW C CCCCC THE FOLLOWING SECTION WAS CHANGED AUGUST 1992 CCCCC CHARACTER*4 IX3AUT CCCCC CHARACTER*4 ITIAUT CCCCC CHARACTER*4 IY1AUT CCCCC CHARACTER*4 IX1AUT CHARACTER*4 ITIAUT CHARACTER*4 IX1AUT CHARACTER*4 IX2AUT CHARACTER*4 IX3AUT CHARACTER*4 IY1AUT CHARACTER*4 IY2AUT C CHARACTER*4 I4PLOT CHARACTER*4 IERAS2 CHARACTER*4 ICOPS2 CHARACTER*4 ICHAP2 CHARACTER*4 ILINP2 CHARACTER*4 IFEED9 C CCCCC CHARACTER*4 IANSRS JANUARY 1989 CCCCC CHARACTER*4 IANSLP JANUARY 1989 CCCCC CHARACTER*4 IANSHI JANUARY 1989 CCCCC CHARACTER*4 IANSNP JANUARY 1989 C CHARACTER*4 IEXPSW CHARACTER*12 IEXPCO CHARACTER*4 IEXPAL CHARACTER*12 IEX1CO CHARACTER*4 IEX1AL CHARACTER*12 IEX2CO CHARACTER*4 IEX2AL CHARACTER*12 IEX3CO CHARACTER*4 IEX3AL CHARACTER*12 IEX4CO CHARACTER*4 IEX4AL CHARACTER*12 IEX5CO CHARACTER*4 IEX5AL C CHARACTER*4 IHELSW CHARACTER*12 IHELCO CHARACTER*4 IHELAL CHARACTER*12 IHE1CO CHARACTER*4 IHE1AL CHARACTER*12 IHE2CO CHARACTER*4 IHE2AL CHARACTER*12 IHE3CO CHARACTER*4 IHE3AL CHARACTER*12 IHE4CO CHARACTER*4 IHE4AL CHARACTER*12 IHE5CO CHARACTER*4 IHE5AL CHARACTER*12 IHE6CO CHARACTER*4 IHE6AL CHARACTER*12 IHE7CO CHARACTER*4 IHE7AL CHARACTER*12 IHE8CO CHARACTER*4 IHE8AL CHARACTER*12 IHE9CO CHARACTER*4 IHE9AL C CCCCC THE FOLLOWING SECTION WAS ADDED JUNE 1990 CHARACTER*4 IMENSW CHARACTER*12 IMENCO CHARACTER*4 IMENAL CHARACTER*12 IME1CO CHARACTER*4 IME1AL CHARACTER*12 IME2CO CHARACTER*4 IME2AL CHARACTER*12 IME3CO CHARACTER*4 IME3AL CHARACTER*12 IME4CO CHARACTER*4 IME4AL CHARACTER*12 IME5CO CHARACTER*4 IME5AL CHARACTER*12 IME6CO CHARACTER*4 IME6AL CHARACTER*12 IME7CO CHARACTER*4 IME7AL CHARACTER*12 IME8CO CHARACTER*4 IME8AL CHARACTER*12 IME9CO CHARACTER*4 IME9AL C CCCCC THE FOLLOWING 11 SECTIONS (10 TO 20) WERE ADDED AUGUST 1990 CHARACTER*12 IM10CO CHARACTER*4 IM10AL C CHARACTER*12 IM11CO CHARACTER*4 IM11AL C CHARACTER*12 IM12CO CHARACTER*4 IM12AL C CHARACTER*12 IM13CO CHARACTER*4 IM13AL C CHARACTER*12 IM14CO CHARACTER*4 IM14AL C CHARACTER*12 IM15CO CHARACTER*4 IM15AL C CHARACTER*12 IM16CO CHARACTER*4 IM16AL C CHARACTER*12 IM17CO CHARACTER*4 IM17AL C CHARACTER*12 IM18CO CHARACTER*4 IM18AL C CHARACTER*12 IM19CO CHARACTER*4 IM19AL C CHARACTER*12 IM20CO CHARACTER*4 IM20AL C CHARACTER*1 IANSEX C CHARACTER*12 IVERSI C CHARACTER*4 IPROGR CHARACTER*4 ICONCL CHARACTER*4 IEOF C CHARACTER*4 ICOM3 CHARACTER*4 ICOM4 CHARACTER*40 ICOM5 CHARACTER*130 ICJUNK C CHARACTER*1 IREPCH C CHARACTER*4 IOSW C CHARACTER*80 IFILE CCCCC CHARACTER*12 ISTAT CCCCC CHARACTER*12 IFORM CCCCC CHARACTER*12 IACCES CCCCC CHARACTER*12 IPROT CHARACTER*12 ICURST CCCCC THE FOLLOWING LINE WAS COMMENTED OUT APRIL 1987 CCCCC CHARACTER*4 IREWIN CCCCC THE FOLLOWING 2 LINES WERE ADDED MARCH 1992 CHARACTER*4 IREWIN CHARACTER*4 IENDFI CHARACTER*4 ISUBN0 CHARACTER*4 IERRFI C CHARACTER*4 ISYSSW CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1992 CHARACTER*4 ISYSS2 CHARACTER*4 IEXIST C CHARACTER*4 IX1TSV CHARACTER*4 IX2TSV CHARACTER*4 IY1TSV CHARACTER*4 IY2TSV C CHARACTER*4 IX1ZSV CHARACTER*4 IX2ZSV CHARACTER*4 IY1ZSV CHARACTER*4 IY2ZSV C CHARACTER*40 ICPREH CHARACTER*40 ICPOSH C CHARACTER*4 IFTEXP CCCCC AUGUST 1995. ADD FOLLOWING LINE CHARACTER*4 IFTORD CCCCC MARCH 1996. ADD FOLLOWING LINE CCCCC NOVEMBER 1998. ADD TO DPCOST.INC CCCCC CHARACTER*4 IRHSTG C CHARACTER*4 IFORSW CHARACTER*80 ICREAF CHARACTER*80 ICWRIF C CHARACTER*4 IREARW CHARACTER*4 IWRIRW C CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1989 CHARACTER*4 ICAPSW C CCCCC THE FOLLOWING 8 LINES WERE ADDED FEBRUARY 1992 CHARACTER*80 ITEMNA CHARACTER*12 ITEMST CHARACTER*12 ITEMFO CHARACTER*12 ITEMAC CHARACTER*12 ITEMPR CHARACTER*12 ITEMCS CHARACTER*4 ITEMEF CCCCC AUGUST 1992. FOLLOWING LINE MODIFIED CCCCC CHARACTER*4 ITEMRW CHARACTER*12 ITEMRW C CCCCC THE FOLLOWING 2 LINES WERE ADDED FEBRUARY 1992 CHARACTER*80 CLARG1 CHARACTER*1 CLARG2 C CCCCC THE FOLLOWING 6 LINES WERE ADDED MARCH 1992 CCCCC FOR THE ASCII/POSTCRIPT PRINTING TO FILES, AND CCCCC FOR THE ASCII/POSTCRIPT PRINTING TO THE LASER PRINTER. CHARACTER*4 IOUTTY CHARACTER*4 IOUTSW CHARACTER*4 IPRITY CHARACTER*4 IPRISW CHARACTER*132 IANSST CHARACTER*80 IOUTN0 CHARACTER*4 IANS4 C CHARACTER*4 IHWUSE CHARACTER*4 MESSAG C C--------------------------------------------------------------------- C INCLUDE 'DPCOPA.INC' C DIMENSION IHPNV(10) DIMENSION IHPNV2(10) DIMENSION ILOCPN(10) DIMENSION ASTARV(10) DIMENSION AINCV(10) DIMENSION ASTOPV(10) DIMENSION NUMLOI(10) DIMENSION ILOOIT(10) DIMENSION ILOOSP(10) DIMENSION ILOOEP(10) DIMENSION IANSLO(MAXLIL,MAXCIL) DIMENSION IWIDLL(MAXLIL) C CCCCC THE FOLLOWING LINE WAS CHANGE APRIL 1993 CCCCC DIMENSION IANSSV(MAXLIS,80) DIMENSION IANSSV(MAXLIS,MAXCIS) CCCCC DECEMBER 1997. ADD FOLLOWING LINE DIMENSION IPLTSV(MAXLIP,MAXCIS) C DIMENSION IMAFIL(6) C DIMENSION TEMP(MAXOBV) DIMENSION TEMP2(MAXOBV) DIMENSION TEMP3(MAXOBV) DIMENSION XTEMP1(MAXOBV) DIMENSION XTEMP2(MAXOBV) CCCCC MAY 1995. EQUIVALENCE ABOVE ARRAYS TO A DUMMY COMMON BLOCK. CCCCC THIS IS DONE TO AVOID COMPILATION PROBLEMS ON SOME MACHINES CCCCC THAT HAVE LIMITS ON "LOCAL DATA". SPECIFICALLY, IT WAS DONE CCCCC TO MAKE IT COMPILE ON A POWER MACINTOSH. THIS STEP ISN'T CCCCC NECCESSARY FOR MOST COMPILERS. CCCCC COMMON/RGARB3/G3RBAG(5*MAXOBV) CCCCC EQUIVALENCE (G3RBAG(1),TEMP(1)) CCCCC EQUIVALENCE (G3RBAG(MAXOBV+1),TEMP2(1)) CCCCC EQUIVALENCE (G3RBAG(2*MAXOBV+1),TEMP3(1)) CCCCC EQUIVALENCE (G3RBAG(3*MAXOBV+1),XTEMP1(1)) CCCCC EQUIVALENCE (G3RBAG(4*MAXOBV+1),XTEMP2(1)) C CCCCC DIMENSION IANSRS(20) JANUARY 1989 CCCCC DIMENSION IANSLP(10) JANUARY 1989 CCCCC DIMENSION IANSHI(10) JANUARY 1989 CCCCC DIMENSION IANSNP(30) JANUARY 1989 C DIMENSION IANSEX(1000) C DIMENSION ICOM3(100) DIMENSION ICOM4(100) DIMENSION ICOM5(100) DIMENSION NCOM5(100) C CCCCC CHARACTER*80 CL C CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993 CHARACTER*80 ISTRIN C CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 1993 C CHARACTER*1 HORDAS CHARACTER*1 VERBAR CHARACTER*1 UPLECO CHARACTER*1 UPRICO CHARACTER*1 LOLECO CHARACTER*1 LORICO C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOMC.INC' INCLUDE 'DPCODB.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCOPC.INC' INCLUDE 'DPCOSU.INC' CCCCC THE FOLLOWING LINE (FOR WEIBULL MINMAX) WAS ADDED JANUARY 1994 INCLUDE 'DPCOS2.INC' INCLUDE 'DPCODA.INC' INCLUDE 'DPCOFO.INC' INCLUDE 'DPCOF2.INC' INCLUDE 'DPCOSO.INC' INCLUDE 'DPCOGR.INC' INCLUDE 'DPCONP.INC' INCLUDE 'DPCOHO.INC' INCLUDE 'DPCOTR.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCODG.INC' INCLUDE 'DPCOCO.INC' CCCCC THE FOLLOWING COMMON WAS ADDED JANUARY 1989 INCLUDE 'DPCO3D.INC' CCCCC THE FOLLOWING 2 COMMON STATEMENTS WERE ADDED (ALAN) FEBRUARY 1989 INCLUDE 'DPCODV.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCOCP.INC' CCCCC THE FOLLOWING DES. OF EXP. COMMON WAS ADDED MAY 1989 INCLUDE 'DPCODE.INC' CCCCC THE FOLLOWING MAXCOL COMMON WAS ADDED JULY 1989 INCLUDE 'DPCOM2.INC' CCCCC THE FOLLOWING 3 INCLUDE FILES ADDED JUNE 1990. INCLUDE 'DPCOZZ.INC' INCLUDE 'DPCOZI.INC' INCLUDE 'DPCOZD.INC' INCLUDE 'DPCOZ2.INC' CCCCC THE FOLLOWING WINDOW SYSTEM COMMON WAS ADDED AUGUST 1990 INCLUDE 'DPCOWI.INC' CCCCC THE FOLLOWING DDS COMMON WAS ADDED APRIL 1996 INCLUDE 'DPCODD.INC' CCCCC THE FOLLOWING DDS COMMON WAS ADDED APRIL 1997 INCLUDE 'DPCOPM.INC' C LOGICAL IOPPLO COMMON/OPNPLT/IOPPLO C C OCTOBER 1991. EXTERNAL STATEMENT FOR BLOCK DATA$ C NOVEMBER 1991. BREAK UP BLOCK DATA INTO 10 CHUNKS (PROBLEM ON SGI) C EXTERNAL INITD1 EXTERNAL INITD2 EXTERNAL INITD3 EXTERNAL INITD4 EXTERNAL INITD5 EXTERNAL INITD6 CCCCC THE FOLLOWING LINE WAS COMMENTED OUT SEPTEMBER 1992 CCCCC AND REPLACED WITH THE FOLLOWING 5 LINES SEPTEMBER 1992 CCCCC EXTERNAL INITD7 EXTERNAL INID7A EXTERNAL INID7B EXTERNAL INID7C EXTERNAL INID7D EXTERNAL INID7E EXTERNAL INITD8 EXTERNAL INITD9 EXTERNAL INITDZ C C APRIL 1992. FOLLOWING ADDED FOR NOS/VE. NOTE THAT LINE MUST START C WITH "C$". IT SHOULD BE A COMMENT ON NON-NOS/VE SYSTEMS. C USED TO EXTRACT COMMAND LINE ARGUMENT (CKCLAR). NOTE THAT THIS C STATEMENT MUST BE IN THE MAIN PROGRAM AND THAT THE ARGUMENTS MUST C BE NAMED. C$NVE PARAM('F:STRING;B:STRING') 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-----DATA STATEMENTS------------------------------------------------- C CCCCC DATA STATEMENTS FOR IANSRS, IANSLP, IANSHI, AND IANSNP (JANUARY 1989) CCCCC WERE REMOVED TO A SEPARATE SUBROUTINE (DP4PLO) (JANUARY 1989) C C-----START POINT----------------------------------------------------- C CCCCC THE FOLLOWING LINE IS AN (UNSUCCESSFUL) TEST LINE OF OTG INTERACTER CCCCC CALL MENU7 C ISUBN1='MAIN' ISUBN2=' ' CCCCC APRIL 1995. ADD FOLLOWING LINE, DO NOT RE-CHECK COMMAND CCCCC LINE IF RESET COMMAND ENTERED. ICKCL=0 CCCCC JULY 1996. ADD FOLLOWING LINE IWBFLG='OFF ' C C ************************************** C ** STEP 1-- ** C ** DEFINE NON-PRINTING CHARACTERS ** C ************************************** C C MAY, 1988: MOVE TO AFTER SET HOST, USE DPCONA ROUTINE C CCCCC INULC=CHAR(0) CCCCC ISOHC=CHAR(1) CCCCC ISTXC=CHAR(2) CCCCC IETXC=CHAR(3) CCCCC IEOTC=CHAR(4) CCCCC IENQC=CHAR(5) CCCCC IACKC=CHAR(6) CCCCC IBELC=CHAR(7) CCCCC IBSC=CHAR(8) CCCCC IHTC=CHAR(9) CCCCC ILFC=CHAR(10) CCCCC IVTC=CHAR(11) CCCCC IFFC=CHAR(12) CCCCC ICRC=CHAR(13) CCCCC ISOC=CHAR(14) CCCCC ISIC=CHAR(15) CCCCC IDLEC=CHAR(16) CCCCC IDC1C=CHAR(17) CCCCC IDC2C=CHAR(18) CCCCC IDC3C=CHAR(19) CCCCC IDC4C=CHAR(20) CCCCC INAKC=CHAR(21) CCCCC ISYNC=CHAR(22) CCCCC IETBC=CHAR(23) CCCCC ICANC=CHAR(24) CCCCC IEMC=CHAR(25) CCCCC ISUBC=CHAR(26) CCCCC IESCC=CHAR(27) CCCCC IFSC=CHAR(28) CCCCC IGSC=CHAR(29) CCCCC IRSC=CHAR(30) CCCCC IUSC=CHAR(31) C CCCCC THE FOLLOWING LINE WAS INSERTED (SOFT-CODE BACKSLASH) APRIL 1989 IBASLC=CHAR(92) C C ********************************************* C ** STEP 2-- ** C ** INITIALIZE VARIABLES AND PARAMETERS. ** C ** CALL MAININ WHICH IN TURN CALLS ** C ** OTHER INITIALIZATION SUBROUTINES ** C ********************************************* C IBUGIN='OFF' CCCCC IBUGIN='ON' 200 CONTINUE IBUGI2=IBUGIN C CCCCC FOLLOWING CODE MOVED FROM BELOW APRIL 1996 CALL DPCONA(92,IBASLC) IF(IHOST1.EQ.'IBM-')THEN PATH(1:12)='C: DATAPLOT ' PATH(3:3)=IBASLC PATH(12:12)=IBASLC NCPATH=12 ENDIF CCCCC THE FOLLOWING 4 LINES WERE ADDED FEBRUARY 1996 CCCCC BUT THE MENU PATH SETTING MAY BE OVERRIDDEN BY FEBRUARY 1996 CCCCC A SET MENU PATH COMMAND IN DPLOGF.TEX FEBRUARY 1996 CCCCC OR BY MANUAL ENTRY OF SET MENU PATH ... FEBRUARY 1996 CCCCC SOFT-CODE BACKSLASH TO AVOID COMPILATION ERRORS CCCCC ON UNIX PLATFORMS (WHERE \ IS AN ESCAPE CHARACTER) APRIL 1996 IF(IHOST1.EQ.'IBM-')THEN MPATH(1:19)='C: TURBOC FRONTEND ' PATH(3:3)=IBASLC PATH(10:10)=IBASLC PATH(19:19)=IBASLC NCMPAT=19 ENDIF C ICOMHO=ICOM ICOMH2=ICOM2 CCCCC WRITE(ICOUT,769)IBUGMA,IBUGIN,ICOM,ICOM2,ICOMHO,ICOMH2,NUMDEV CC769 FORMAT('IBUGMA,IBUGIN,ICOM,ICOM2,ICOMHO,ICOMH2,NUMDEV = ', CCCCC CALL DPWRST('XXX','BUG ') CCCCC1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4,I8) CALL MAININ(IBUGIN,ICOMHO,ICOMH2) C CCCCC WRITE(ICOUT,769)IBUGMA,IBUGIN,ICOM,ICOM2,ICOMHO,ICOMH2,NUMDEV CCCCC CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,770)IMANUF,NUMDEV,IDMANU(1) 770 FORMAT('AFTER 200 & CALL MAININ--IMANUF,NUMDEV,IDMANU(1) = ', 1A4,I8,2X,A4) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C CCCCC THE FOLLOWING 3 LINES WERE ADDED JUNE 1992 (JJF) CCCCC TO INITIALIZE (= EMPTY) THE COMMAND LOG FILE JUNE 1992 CCCCC FOR SCROLLING USE IN THE C-SIDE FRONT END. JUNE 1992 CCCCC THE FOLLOWING SECTION WAS MOVED DOWN AFTER FEBRUARY 1996 CCCCC THE DEFINITIONS OF THE MENU PATH (MPATH) FEBRUARY 1996 CCCCC THE FOLLOWING 3 LINES WERE ADDED JUNE 1992 (JJF) CCCCC TO INITIALIZE (= EMPTY) THE COMMAND LOG FILE JUNE 1992 CCCCC FOR SCROLLING USE IN THE C-SIDE FRONT END. JUNE 1992 CCCCC IF(IHOST1.EQ.'IBM-')THEN CCCCC CALL TCINCF(ISUBRO) CCCCC ENDIF C C ************************************* C ** STEP 3-- ** C ** INITIALIZE OTHER VARIABLES. ** C ************************************* C ISTEPN='3' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IVGMSW='OFF' IHGMSW='OFF' C IMALE8=(-999) IMACN8=(-999) C CCCCC THE FOLLOWING 2 LINES ARE NO LONGER NEEDED JULY 1990 CCCCC (SINCE IHOST1 DEFINITION IS NOW DONE IN INITMC) JULY 1990 CCCCC IHOST1='VAX ' CCCCC IHOST2=' ' IHOST(1)=IHOST1 IHOST(2)=IHOST2 CCCCC ISITE='NBS' C CCCCC THE FOLLOWING 4 LINES WERE ADDED DECEMBER 1993 CCCCC BUT THE PATH SETTING MAY BE OVERRIDDEN BY DECEMBER 1993 CCCCC A SET PATH COMMAND IN DPLOGF.TEX DECEMBER 1993 CCCCC OR BY MANUAL ENTRY OF SET PATH ... DECEMBER 1993 CCCCC SOFT-CODE BACKSLASH TO AVOID COMPILATION ERRORS CCCCC ON UNIX PLATFORMS (WHERE \ IS AN ESCAPE CHARACTER) APRIL 1996 CCCCC MOVE FOLLOWING BLOCK TO BEFORE CALL TO MAININ CCCCC (WHICH CALLS INITFO) WHICH CAN OVERRIDE DEFAULT APRIL 1996 CCCCC CALL DPCONA(92,IBASLC) CCCCC IF(IHOST1.EQ.'IBM-')THEN CIBM- PATH(1:12)='C:\DATAPLOT\' CCCCC PATH(1:12)='C: DATAPLOT ' CCCCC PATH(3:3)=IBASLC CCCCC PATH(12:12)=IBASLC CCCCC NCPATH=12 CCCCC ENDIF CCCCC THE FOLLOWING 4 LINES WERE ADDED FEBRUARY 1996 CCCCC BUT THE MENU PATH SETTING MAY BE OVERRIDDEN BY FEBRUARY 1996 CCCCC A SET MENU PATH COMMAND IN DPLOGF.TEX FEBRUARY 1996 CCCCC OR BY MANUAL ENTRY OF SET MENU PATH ... FEBRUARY 1996 CCCCC SOFT-CODE BACKSLASH TO AVOID COMPILATION ERRORS CCCCC ON UNIX PLATFORMS (WHERE \ IS AN ESCAPE CHARACTER) APRIL 1996 CCCCC IF(IHOST1.EQ.'IBM-')THEN CIBM- MPATH(1:19)='C:\TURBOC\FRONTEND\' CCCCC MPATH(1:19)='C: TURBOC FRONTEND ' CCCCC PATH(3:3)=IBASLC CCCCC PATH(10:10)=IBASLC CCCCC PATH(19:19)=IBASLC CCCCC NCMPAT=19 CCCCC ENDIF C CCCCC THE FOLLOWING SECTION WAS MOVED FROM ABOVE FEBRUARY 1996 CCCCC TO HERE AFTER THE DEFINITIONS OF THE MENU PATH (MPATH) FEBRUARY 1996 CCCCC THE FOLLOWING 3 LINES WERE ADDED JUNE 1992 (JJF) CCCCC TO INITIALIZE (= EMPTY) THE COMMAND LOG FILE JUNE 1992 CCCCC FOR SCROLLING USE IN THE C-SIDE FRONT END. JUNE 1992 IF(IHOST1.EQ.'IBM-')THEN CALL TCINCF(ISUBRO) ENDIF C CCCCC THE FOLLOWING CALL TO TCINCO WAS MOVED FEBRUARY 1996 CCCCC FROM INITOD FEBRUARY 1996 CCCCC SO THAT THE MENU PATH WILL ALREADY EXIST FEBRUARY 1996 IF(IHOST1.EQ.'IBM-')THEN CALL TCINCO(ISUBRO) ENDIF C CCCCC THE FOLLOWING 6 LINES WERE ADDED FEBRUARY 1992 ITEMNU=19 ITEMNA='DPARG.TEX' ITEMST='UNKNOWN' ITEMFO='FORMATTED' ITEMAC='SEQUENTIAL' ITEMRW='READONLY' C C MAY,1988. SET NON-PRINTING CHARACTERS AFTER HOST IS DEFINED. C USE "DPCONA" ROUTINE RATHER THAN EXPLICIT CHAR FUNCTION. C INTENDED FOR NON-ASCII MACHINES. C ************************************** C ** STEP 1-- ** C ** DEFINE NON-PRINTING CHARACTERS ** C ************************************** C MAY, 1988: MOVE TO AFTER SET HOST, USE DPCONA ROUTINE C CALL DPCONA(0,INULC) CALL DPCONA(1,ISOHC) CALL DPCONA(2,ISTXC) CALL DPCONA(3,IETXC) CALL DPCONA(4,IEOTC) CALL DPCONA(5,IENQC) CALL DPCONA(6,IACKC) CALL DPCONA(7,IBELC) CALL DPCONA(8,IBSC) CALL DPCONA(9,IHTC) CALL DPCONA(10,ILFC) CALL DPCONA(11,IVTC) CALL DPCONA(12,IFFC) CALL DPCONA(13,ICRC) CALL DPCONA(14,ISOC) CALL DPCONA(15,ISIC) CALL DPCONA(16,IDLEC) CALL DPCONA(17,IDC1C) CALL DPCONA(18,IDC2C) CALL DPCONA(19,IDC3C) CALL DPCONA(20,IDC4C) CALL DPCONA(21,INAKC) CALL DPCONA(22,ISYNC) CALL DPCONA(23,IETBC) CALL DPCONA(24,ICANC) CALL DPCONA(25,IEMC) CALL DPCONA(26,ISUBC) CALL DPCONA(27,IESCC) CALL DPCONA(28,IFSC) CALL DPCONA(29,IGSC) CALL DPCONA(30,IRSC) CALL DPCONA(31,IUSC) CCCCC THE FOLLOWING LINE WAS INSERTED (SOFT-CODE BACKSLASH) APRIL 1989 CALL DPCONA(92,IBASLC) C CCCCC MAXNPP=1000 AUGUST 15, 1986 CCCCC MAXNPP=5000 JUNE 1987 MAXNPP=MAXPOP C DEFANG=ADEFAN ANGLE=ATEXAN IDEANU=IDEFAU IANGLU=ITEXAU C CCCCC MAXNXT=MAXN C CHANGED OCTOBER, 1987 (IF SET ROWS GREATER THAN DEFAULT) MAXNXT=MAXOBV C IWIDEX=(-999) C CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1988 CCCCC AND THEN CHANGED (FROM .5 TO .1) NOVEMBER 1989 CCCCC ALOWFR=0.5 ALOWFR=0.1 CCCCC THE FOLLOWING LINE WAS ADDED MARCH 1994 ALOWDG=1.0 C CCCCC THE FOLLOWING 4 LINES WERE INSERTED NOVEMBER 1989 YATCCU=CPUMAX YATTCU=CPUMAX YATRCU=CPUMAX IYATOS='123' IYATRS='MEAN' C IFOUND='NO' IERROR='NO' C IMACRO='OFF' IMACNU=IRD IMACCS='JUNK ' CCCCC THE FOLLOWING 3 LINES WERE ADDED AUGUST 1994 CCCCC IMACL1 = FIRST LINE OF MACRO TO EXECUTE CCCCC IMACL2 = LAST LINE OF MACRO TO EXECUTE CCCCC IMACLR = NUMBER OF LINES OF MACRO ALREADY EXECUTED IMACL1=1 IMACL2=99999 IMACLR=0 IMACOL='OFF' IMALEV=0 C IOUNI0=IRD C IPROGR='OFF' ICONCL='OFF' IEOF='NO' C ITOPIC='JUNK' C ICASIF='TRUE' IIFSW='TRUE' CCCCC FOLLOWING 4 LINES ADDED NOVEMBER 1992 (NESTED IF'S) DO210I=1,MAXIF ICASI2(I)='TRUE' ICASI3(I)='FALS' 210 CONTINUE NUMIF=0 C CCCCC THE FOLLOWING SECTION WAS CHANGED AUGUST 1992 CCCCC IX3AUT='OFF' CCCCC ITIAUT='OFF' CCCCC IY1AUT='OFF' CCCCC IX1AUT='OFF' ITIAUT='OFF' IX1AUT='OFF' IX2AUT='OFF' IX3AUT='OFF' IY1AUT='OFF' IY2AUT='OFF' C I4PLOT='OFF' I4DONE=(-999) IERAS2='-999' ICOPS2='-999' ICHAP2='-999' ILINP2='-999' IFEED9='-999' C IEXPSW='TOP' IEXPCO='0 ' IEXPAL='OFF' IEX1CO='0 ' IEX1AL='OFF' IEX2CO='0 ' IEX2AL='OFF' IEX3CO='0 ' IEX3AL='OFF' IEX4CO='0 ' IEX4AL='OFF' IEX5CO='0 ' IEX5AL='OFF' C IHELSW='TOP' IHELCO='0 ' IHELAL='OFF' IHE1CO='0 ' IHE1AL='OFF' IHE2CO='0 ' IHE2AL='OFF' IHE3CO='0 ' IHE3AL='OFF' IHE4CO='0 ' IHE4AL='OFF' IHE5CO='0 ' IHE5AL='OFF' IHE6CO='0 ' IHE6AL='OFF' IHE7CO='0 ' IHE7AL='OFF' IHE8CO='0 ' IHE8AL='OFF' IHE9CO='0 ' IHE9AL='OFF' C CCCCC IF(IHOST1.EQ.'CDC')OPEN(IRD,FILE='INPUT') CCCCC IF(IHOST1.EQ.'CDC')OPEN(IPR,FILE='OUTUT') C IPASS=0 IWIDSV=0 IWIDTH=0 NUMCHA=0 C IMPSW='OFF' IMPNR=2 IMPNC=2 IMPCO=1 PMXMIN=15.0 PMXMAX=85.0 PMYMIN=20.0 PMYMAX=90.0 C IERASV=IERASW PWXMIS=PWXMIN PWXMAS=PWXMAX PWYMIS=PWYMIN PWYMAS=PWYMAX C CCCCC THE FOLLOWING 2 LINES WERE ADDED APRIL 1992 BARHEF=1.0 BARWEF=1.0 C C THE FOLLOWING IS FOR ALL 32-BIT AND HIGHER COMPUTERS C IDEFSE=305 C C THE FOLLOWING IS FOR THE UNIVAC-- CCCCC IDEFSE=20867350019 C C THE FOLLOWING IS FOR THE VAX-- CCCCC IDEFSE=867350019 C ISEED=IDEFSE CCCCC THE FOLLOWING 2 LINES WERE ADDED JANUARY 1989 IDEBOO=100 IBOOSS=IDEBOO ANOPL1=CPUMIN ANOPL2=CPUMAX ICASAN='NONE' ICASPL='NONE' ICONT='ON' IAND1='NO' IAND2='NO' INEGSW='OFF' C IREPST='OFF' IREPS1=1 IREPS2=1 IREPNU=1 IREPTO=1 IREPPO=1 IPOINT=1 CCCCC IREPMX=10 CCCCC IREPMX=20 CCCCC IREPMX=50 JUNE 1987 IREPMX=MAXLIS ILISMX=20 C DO310J=1,IREPMX DO320I=1,MAXWID IANSSV(J,I)=' ' 320 CONTINUE 310 CONTINUE CCCCC ADD FOLLOWING SECTION DECEMBER 1997 IPLTST='OFF' IPLTNU=0 IPLTPO=0 IPLTMX=MAXLIP C DO330J=1,IPLTMX DO340I=1,MAXWID IPLTSV(J,I)=' ' 340 CONTINUE 330 CONTINUE C ISACNC=ISACNA C IAUTSW='OFF' IAUTEX='OFF' C IFENSW='OFF' C ITRANS='OFF' C DEMATN=CPUMIN XMATN=DEMATN YMATN=DEMATN DEMITN=CPUMIN XMITN=DEMITN YMITN=DEMITN C ILOOST='OFF' ILOOLI=0 NUMLIL=0 NUMLOS=0 NUMENS=0 NUMLOE=0 NUMENE=0 C DO350I=1,10 IHPNV(I)=' ' IHPNV2(I)=' ' ILOCPN(I)=-99 ASTARV(I)=-99.0 AINCV(I)=-99.0 ASTOPV(I)=-99.0 NUMLOI(I)=0 ILOOIT(I)=0 ILOOSP(I)=-99 ILOOEP(I)=-99 350 CONTINUE C DO360I=1,MAXLIL IWIDLL(I)=0 DO370J=1,MAXCIL IANSLO(I,J)=' ' 370 CONTINUE 360 CONTINUE C MAXMAC=6 DO380I=1,MAXMAC IMAFIL(I)='NO' 380 CONTINUE C IBUGLO='OFF' C IBUGUG='OFF' IBUGU2='OFF' IBUGU3='OFF' IBUGU4='OFF' C ISUBRO='XXXX' C IBUGEX='OFF' IBUGE2='OFF' C IBUGHE='OFF' IBUGH2='OFF' C ISQUAR='OFF' IPROSW='ON' IOFILE='-999' IFILNU=(-999) C NUMCOM=0 NCTEMP=0 DO390I=1,100 NCOM5(I)=0 390 CONTINUE C CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989 CCCCC IREPCH=IBASLC CCCCC THE FOLLOWING 2 LINES WERE ADDED JUNE 1989 CCCCC IF(IHOST1.EQ.'IBM-')IREPCH='#' CCCCC IF(IHOST1.EQ.'COMP')IREPCH='#' CCCCC THE FOLLOWING LINES WAS ADDED JULY 1989 IREPCH='^' C IOSW='FLOA' C ISYSSW='-999' IEXIST='-999' C CCCCC THE FOLLOWING LINE WAS FIXED JUNE 1990 CCCCC IGUNIT=IPR IGUNIT=IPRGR C NUMTRA=0 C IPPDE1='-999' IPPDE2='-999' ICPREP=' ' ICPOST=' ' NCPREP=0 NCPOST=0 C ICPREH=' ' ICPOSH=' ' NCPREH=0 NCPOSH=0 C CCCCC IHELMX=100000 JULY 1988 IHELMX=20 C CCCCC AUGUST 1995. SET THIS TO DO THE "+" CASE BY DEFAULT. CCCCC IFTEXP='-' IFTEXP='+' CCCCC AUGUST 1995. ADD FOLLOWING LINE IFTORD='DATA' C IFORSW='E' C ICREAF(1:40)=' ' ICREAF(41:80)=' ' NCREAF=0 ICWRIF(1:40)=' ' ICWRIF(41:80)=' ' NCWRIF=0 C IREARW='ON' IWRIRW='ON' C CCCCC FOLLOWING 3 LINES ADDED APRIL 1995 IUNFOF=0 IUNFNR=0 IUNFMC=0 CCCCC FOLLOWING LINE ADDED MARCH 1996 IRHSTG='AREA' C IX1TSV=IX1TSC IX2TSV=IX2TSC IY1TSV=IY1TSC IY2TSV=IY2TSC C IX1ZSV=IX1ZFM IX2ZSV=IX2ZFM IY1ZSV=IY1ZFM IY2ZSV=IY2ZFM C CCCCC THE FOLLOWING 2 LINES WERE ADDED JUNE 1989 ICAPSW='OFF' IPRDEF=IPR C CCCCC THE FOLLOWING 5 LINES WERE ADDED MARCH 1992 CCCCC FOR THE ASCII/POSTCRIPT PRINTING TO FILES, AND CCCCC FOR THE ASCII/POSTCRIPT PRINTING TO THE LASER PRINTER. IOUTTY='ASCI' IOUTSW='OFF' CCCCC THE FOLLOWING LINE WAS CHANGED FEBRUARY 1993 CCCCC IPRITY='ASCI' IPRITY='POST' IPRISW='OFF' IOUTN0=IOUTNA C IOPPLO=.FALSE. C CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993 CCCCC TO PROVIDE AN INITIAL VALUE TO THE FEBRUARY 1993 CCCCC TURBO-C MENU GRAPHICS PLATFORM VARIABLE FEBRUARY 1993 IPLATF=' ' C ************************************* C ** STEP 4-- ** C ** PRINT OUT POST-INITIALIZATION ** C ** SETTINGS OF ** C ** IMPORTANT VARIABLES. ** C ************************************* C ISTEPN='4' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGI2.EQ.'OFF'.AND.ISUBRO.NE.'MAIN')GOTO490 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,451) 451 FORMAT('YOU HAVE JUST RETURNED TO MAIN AFTER ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,452) 452 FORMAT('EXECUTION OF ALL OF THE INITIALIZATION SUBROUTINES--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,453)IPR,IRD,CPUMIN,CPUMAX 453 FORMAT('IPR,4IRD,CPUMIN,CPUMAX = ',2I6,2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,454)NUMBPC,NUMCPW,NUMBPW 454 FORMAT('NUMBPC,NUMCPW,NUMBPW = ',3I6) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,461)IMESNU,IMESNA,IMESST 461 FORMAT('IMESNU,IMESNA,IMESST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,462)INEWNU,INEWNA,INEWST 462 FORMAT('INEWNU,INEWNA,INEWST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,463)IMAINU,IMAINA,IMAIST 463 FORMAT('IMAINU,IMAINA,IMAIST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,464)IHELNU,IHELNA,IHELST 464 FORMAT('IHELNU,IHELNA,IHELST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,465)IBUGNU,IBUGNA,IBUGST 465 FORMAT('IBUGNU,IBUGNA,IBUGST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,466)IQUENU,IQUENA,IQUEST 466 FORMAT('IQUENU,IQUENA,IQUEST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,467)ILOGNU,ILOGNA,ILOGST 467 FORMAT('ILOGNU,ILOGNA,ILOGST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,468)IREANU,IREANA,IREAST 468 FORMAT('IREANU,IREANA,IREAST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,469)IWRINU,IWRINA,IWRIST 469 FORMAT('IWRINU,IWRINA,IWRIST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,470)ISAVNU,ISAVNA,ISAVST 470 FORMAT('ISAVNU,ISAVNA,ISAVST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,471)ILISNU,ILISNA,ILISST 471 FORMAT('ILISNU,ILISNA,ILISST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,472)ICRENU,ICRENA,ICREST 472 FORMAT('ICRENU,ICRENA,ICREST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,473)ISCRNU,ISCRNA,ISCRST 473 FORMAT('ISCRNU,ISCRNA,ISCRST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,474)IDATNU,IDATNA,IDATST 474 FORMAT('IDATNU,IDATNA,IDATST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,475)IPL1NU,IPL1NA,IPL1ST 475 FORMAT('IPL1NU,IPL1NA,IPL1ST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,476)IPL2NU,IPL2NA,IPL2ST 476 FORMAT('IPL2NU,IPL2NA,IPL2ST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,477)IPRONU,IPRONA,IPROST 477 FORMAT('IPRONU,IPRONA,IPROST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,478)ICONNU,ICONNA,ICONST 478 FORMAT('ICONNU,ICONNA,ICONST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,479)IEX1NU,IEX1NA,IEX1ST 479 FORMAT('IEX1NU,IEX1NA,IEX1ST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,480)ISYSNU,ISYSNA,ISYSST 480 FORMAT('ISYSNU,ISYSNA,ISYSST = ',I8,2X,A80,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,483)ICRENU,ICREST 483 FORMAT('ICRENU,ICREST = ',I8,2X,A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,484)MAXN,MAXCOL,MAXNAM,NUMNAM 484 FORMAT('MAXN,MAXCOL,MAXNAM,NUMNAM = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,485)IBUGIN,IBUGMA 485 FORMAT('IBUGIN,IBUGMA = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,486)ICASAN,IMACRO 486 FORMAT('ICASAN,IMACRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,487)IAND1,IAND2 487 FORMAT('IAND1,IAND2 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,488)ICOLOR,IPLOTF CC488 FORMAT('ICOLOR,IPLOTF = ',A4,2X,A4) CCCCC CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') 490 CONTINUE CCCCC IF(ICOMHO.EQ.'RESE')GOTO1000 IF(ICOMHO.EQ.'RESE')GOTO920 C C ********************************** C ** STEP 5-- ** C ** ACCUMULATE LOG STATISTICS ** C ** (IF CALLED FOR) ** C ********************************** C CCCCC ISTEPN='5' CCCCC IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) CCCCC CCCCC CALL DPLOGS(ILOGNU,ILOGFS,ILOGST, CCCCC1IANS,IWIDTH,IBUGMA,IFOUND,IERROR) C CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1990 C ****************************************** C ** IF A WINDOW SYSTEM IS AVAILABLE, ** C ** OPEN THE SYSTEM, ** C ** DEFINE COLORS, SIZE, TYPE, ETC. ** C ** AND OPEN THE WINDOW. ** C ****************************************** C CCCCC IBUGWI='ON' CCCCC IF(IWINSY.EQ.'NONE')GOTO609 CCCCC ICURWI=1 CCCCC CALL WIINIT('OFF ') CCCCC CALL WISECO('BLUE','WHIT',ICURWI) CCCCC CALL WISETY('ON ','OFF ','OFF ',ICURWI) CCCCC CALL WISECC(1,1,80,24,ICURWI) CCCCC CALL WIOPEN(ICURWI) CCCCC THE FOLLOWING LINE WAS COMMENTED OUT FEBRUARY 1992 CC609 CONTINUE CCCCC THE FOLLOWING LINE IS AN (UNSUCCESSFUL) TEST LINE OF OTG INTERACTER CCCCC CALL MENU7 C CCCCC THE FOLLOWING SECTION (OPEN CONCLUSIONS FILE) FEBRUARY 1992 CCCCC WAS MOVED FROM BELOW SECTION 7 FEBRUARY 1992 CCCCC IT USED TO BE CALLED SECTION 8. FEBRUARY 1992 CCCCC IT IS NOW CALLED SECTION 5B. FEBRUARY 1992 C **************************************************** C ** STEP 5B-- ** C ** IF A CONCLUSIONS FILE ** C ** (USED BY THE AUTOCORRELATION PLOT AND ** C ** THE CROSS-CORRELATION PLOT COMMANDS) ** C ** MAY EXIST, OPEN IT NOW. ** C **************************************************** C ISTEPN='5B' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICONST.EQ.'NONE')GOTO890 IFILNU=ICONNU CALL DPOPF0(IFILNU,IBUGMA,ISUBRO,IERROR) 890 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 (JJF) C ************************************************** C ** STEP XX-- ** C ** DEFINE (AND OPEN) DEVICE 3 ** C ** POSTSCRIPT FILE ** C ** TO BE USED IN CONJUNCTION ** C ** WITH THE P COMMAND ** C ** FOR AFTER-THE-FACT POSTSCRIPT PRINTING ** C ************************************************** C IDTEMP=3 IF(IPL2CS.EQ.'CLOSED') 1CALL DPDEV(IDTEMP,'DEFI','POST',ICAPSW,IBUGMA,ISUBRO,IERROR) CCCCC JANUARY 1997. IF IERROR IS YES, THEN PRINT A MESSAGE AND CCCCC TERMINATE DATAPLOT. PROBABLE CAUSE IS THAT DATAPLOT IS RUN CCCCC IN A "READ-ONLY" DIRECTORY. STOP RATHER THAN HAVE AN ABORT. C CCCCC AUGUST 2005: DON'T ABORT. THIS CAUSES PROBLEMS IN THE WINDOWS CCCCC VERSION OF GUI. C IF(IERROR.EQ.'YES')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,891) 891 FORMAT('DATAPLOT WAS UNABLE TO OPEN THE PLOT OUTPUT FILE ', 1 'DPPL2F.DAT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,892) 892 FORMAT('POSSIBLE CAUSES INCLUDE:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,893) 893 FORMAT(' 1. RUNNING DATAPLOT FROM A READ-ONLY DIRECTORY.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,894) 894 FORMAT(' 2. DPPL2F.DAT MAY BE "LOCKED" BY ANOTHER ', 1 'APPLICATION.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,895) 895 FORMAT(' IN THIS CASE, TRY CLOSING THE OTHER APPLICATION.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,896) 896 FORMAT(' IN PARTICULAR, IF THE GUI VERSION IS NOT ', 1 'CLOSED CLEANLY,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,897) 897 FORMAT(' A "DPLAHEY.EXE" PROCESS MAY STILL BE RUNNING. ', 1 'IN THIS CASE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,898) 898 FORMAT(' A. ENTER CNTRL-ALT-DELETE TO INITIATE THE ', 1 'WINDOWS TASK MANAGER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,899) 899 FORMAT(' B. SELECT "PROCESSES".') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,88991) 88991 FORMAT(' C. IF MULTIPLE OCCURENCES OF "DPLAHEY.EXE" ARE', 1 'FOUND, THEN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,88993) 88993 FORMAT(' CLOSE THE CURRENT DATAPLOT SESSION AND DELETE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,88995) 88995 FORMAT(' ANY REMAINING OCCURENCES OF "DPLAHEY.EXE"') CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,893) CC893 FORMAT('DATAPLOT SESSION WILL BE TERMINATED.') CCCCC CALL DPWRST('XXX','BUG ') IPL2CS='CLOSED' IDMOD3(NUMDEV)='DEV3' CCCCC STOP ELSE IPL2CS='OPEN' IDMOD3(NUMDEV)='DEV3' ENDIF C C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1992 C ********************************************** C ** STEP 6A-- ** C ** TREAT COMMAND LINE ARGUMENTS. ** C ** HOW MANY ARGUMENTS EXIST ** C ** AFTER THE DP COMMAND? ** C ** NONE, 1, OR 2? ** C ** 0) IF NONE, ** C ** THEN HAVE THE USUAL ENTRY INTO DATAPLOT ** C ** (PRINT BANNER, PRINT MESSAGE ** C ** AND EXECUTE 2 LOGIN FILES) ** C ** 1) IF 1 ARGUMENT, ** C ** THEN HAVE THE USUAL ENTRY INTO DATAPLOT ** C ** (PRINT BANNER, PRINT MESSAGE ** C ** AND EXECUTE 2 LOGIN FILES) ** C ** + FORM AND EXECUTE A LINE ** C ** CALL ARGUMENT-1 ** C ** 2A) IF 2 ARGUMENTS AND ARG 2 = 1 ** C ** THEN HAVE THE USUAL ENTRY INTO DATAPLOT ** C ** (PRINT BANNER, PRINT MESSAGE ** C ** AND EXECUTE 2 LOGIN FILES) ** C ** + FORM AND EXECUTE A LINE ** C ** CALL ARGUMENT-1 ** C ** 2B) IF 2 ARGUMENTS AND ARG 2 = 0 ** C ** THEN SKIP THE USUAL ENTRY INTO DATAPLOT ** C ** (THEREFORE NOT PRINT BANNER, NOT PRINT MESSAGE ** C ** AND NOT EXECUTE 2 LOGIN FILES) ** C ** BUT DO FORM AND EXECUTE A LINE ** C ** CALL ARGUMENT-1 ** C ** (THEREFORE SHOULD BE FAST) ** C ********************************************** C ISTEPN='6A' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC ISUBN0='MAIN' CCCCC ISUBRO='CLAR' CCCCC ISUBRO='MACR' CCCCC APRIL 1995. ADD FOLLOWING LINE, DO NOT RE-CHECK COMMAND CCCCC LINE IF RESET COMMAND ENTERED. IF(ICKCL.GT.0)GOTO608 CALL CKCLAR(ITEMNU,ITEMNA,ITEMST,ITEMFO, 1ITEMAC,ITEMPR,ITEMCS,ITEMEF,ITEMRW, 1NUMCLA,CLARG1,CLARG2,ISUBN0,IBUGS2,ISUBRO,IERRFI) 608 CONTINUE C IF(NUMCLA.LE.1)GOTO609 IF(CLARG2(1:1).EQ.'0')GOTO970 IF(CLARG2(1:1).EQ.'1')GOTO920 IF(CLARG2(1:1).EQ.'2')GOTO960 609 CONTINUE C C ********************************************** C ** STEP 6B-- ** C ** WRITE OUT THE DATAPLOT BANNER. ** C ********************************************** C ISTEPN='6B' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC THE FOLLOWING 14 LINES WERE ADDED JULY 1993 IF(IHOST1.EQ.'IBM-')THEN HORDAS=CHAR(205) VERBAR=CHAR(186) UPLECO=CHAR(201) UPRICO=CHAR(187) LOLECO=CHAR(200) LORICO=CHAR(188) ELSE HORDAS='-' VERBAR='|' UPLECO='-' UPRICO='-' LOLECO='-' LORICO='-' ENDIF C CCCCC THE BANNER SECTION WAS CHANGED JULY 1993 CCCCC ALONG WITH A FEW FORMAT NUMBERS JULY 1993 CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1992 CCCCC IVERSI='92.8' IVERSI='2006.12' C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') C CCCCC WRITE(ICOUT,610) CC610 FORMAT(6X,'----------------------------------------------------') CCCCC CALL DPWRST('XXX','BUG ') WRITE(ICOUT,610)UPLECO,(HORDAS,I=1,50),UPRICO 610 FORMAT(6X,52A1) CALL DPWRST('XXX','BUG ') C WRITE(ICOUT,611)VERBAR,VERBAR 611 FORMAT(6X,A1, 1' Dataplot ',A1) CALL DPWRST('XXX','BUG ') C WRITE(ICOUT,612)VERBAR,VERBAR 612 FORMAT(6X,A1, 1' Interactive Graphics & Data Analysis Language ',A1) CALL DPWRST('XXX','BUG ') C WRITE(ICOUT,613)VERBAR,VERBAR 613 FORMAT(6X,A1, 1' James J. Filliben and Alan Heckert ',A1) CALL DPWRST('XXX','BUG ') C WRITE(ICOUT,614)VERBAR,VERBAR 614 FORMAT(6X,A1, 1' Information Technology Laboratory ',A1) CALL DPWRST('XXX','BUG ') C WRITE(ICOUT,615)VERBAR,VERBAR 615 FORMAT(6X,A1, 1' National Institute of Standards and Technology ',A1) CALL DPWRST('XXX','BUG ') C WRITE(ICOUT,616)VERBAR,VERBAR 616 FORMAT(6X,A1, 1' 301-975-2855 and 301-975-2899 ',A1) CALL DPWRST('XXX','BUG ') C CCCCC THE FOLLOWING 3 LINES WERE CHANGED JULY 1992 CCCCC WRITE(ICOUT,615)IVERSI CC615 FORMAT(6X,'----------------------------------------------------', CCCCC1' VERSION ',A12) CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,610) CCCCC CALL DPWRST('XXX','BUG ') WRITE(ICOUT,617)LOLECO,(HORDAS,I=1,50),LORICO 617 FORMAT(6X,52A1) CALL DPWRST('XXX','BUG ') C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,621)MAXN 621 FORMAT(' Number of Observations per Variable = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,622)MAXCOL 622 FORMAT(' Number of Variables = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,623)MAXNK 623 FORMAT(' Total Internal Data Space Size = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,624)IREPCH 624 FORMAT(' Substitution/Replacement Character = ',7X,A1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') C C **************************************************** C ** STEP 7-- ** C ** IF A SIGN-ON MESSAGE FILE ** C ** (CONSISTING OF CURRENT DATAPLOT INFORMATION) ** C ** EXISTS AT THIS COMPUTER INSTALLATION, ** C ** WRITE OUT SUCH MESSAGES FOR THE ANALYST'S ** C ** PERUSAL ** C **************************************************** C ISTEPN='7' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IMESST.EQ.'NONE')GOTO790 C CCCCC -----SET EARLY DEBUG INFO HERE INIT CCCCC IBUGS2='ON' CCCCC IBUGMA='ON' C CALL DPMESS(IBUGS2,ISUBRO,IFOUND,IERROR) 790 CONTINUE C CCCCC SECTION 8 (OPEN CONCLUSIONS FILE) FEBRUARY 1992 CCCCC WAS MOVED UP TO BEFORE SECTION 6A FEBRUARY 1992 CCCCC IN ITS NEW PLACE, SECTION 8 IS CALLED SECTION 5B FEBRUARY 1992 CCCCC (SECTION 8 USED TO BE RIGHT HERE) FEBRUARY 1992 C C ************************************************************* C ** STEP 9A-- ** C ** (FOR NBS UNIVAC COMPUTER ONLY) ** C ** HAVE A DUMMY READ OF 1 LINE AFTER THE DATAPLOT HEADER ** C ** TO ABSORB AN EXTRANEOUS LINE GENERATED ** C ** BY THE UNIVAC SYSTEM SOFTWARE WHEN FIRST ACCESSING DATAPLOT. C ************************************************************* C ISTEPN='9A' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IHOST1.EQ.'UNIV'.AND.ICOM.NE.'RESE')READ(IRD,911) 911 FORMAT(1X) C C ************************************************************* C ** STEP 9B-- ** C ** GENERATE A COMMAND STATEMENT (AND THEN EXECUTE IT) ** C ** WHICH STATES THAT WE SHOULD CALL DPSYSF.TEX ** C ** (THIS ALLOWS US TO EXECUTE A SYSTEM "LOGIN" FILE ** C ** WHEN SIGNING ONTO DATAPLOT WHICH IN TURN ALLOWS ** C ** AN IMPLEMENTOR TO EASILY TAILOR DATAPLOT ** C ** FOR AN INDIVIDUAL SITE/INSTITUTIONS/). ** C ************************************************************* C 920 CONTINUE C ISTEPN='9B' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IANSLC(1)='C ' IANSLC(2)='A ' IANSLC(3)='L ' IANSLC(4)='L ' IANSLC(5)=' ' J=0 DO950I=6,80 J=J+1 IANSLC(I)=ISYSNA(J:J) 950 CONTINUE IWIDTH=80 CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) CCCCC THE FOLLOWING LINE WAS CHANGED FEBRUARY 1992 CCCCC ISYSSW='EXEC' ISYSSW='EXSY' GOTO1400 CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1992 959 CONTINUE IF(NUMCLA.GE.2.AND.CLARG2(1:1).EQ.'1')GOTO970 C C ************************************************************* C ** STEP 9C-- ** C ** GENERATE A COMMAND STATEMENT (AND THEN EXECUTE IT) ** C ** WHICH STATES THAT WE SHOULD CALL DPLOGF.TEX ** C ** (THIS ALLOWS US TO EXECUTE A USER "LOGIN" FILE ** C ** WHEN SIGNING ONTO DATAPLOT WHICH IN TURN ALLOWS ** C ** AN INDIVIDUAL USER TO EASILY TAILOR DATAPLOT ** C ** FOR HIS/HER OWN TERMINAL/PLOTTER.). ** C ************************************************************* C 960 CONTINUE ISTEPN='9C' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC THE FOLLOWING 12 LINES WERE COMMENTED OUT JUNE 1995 CCCCC SO AS TO ALLOW THE DPLOGF.TEX FILE JULY 1995 CCCCC IN THE DEFAULT DIRECTORY (E.G., C:\DATAPLOT FOR PC'S) JULY 1995 CCCCC TO BE ALWAYS EXECUTED REGARDLESS OF WHAT DIRECTORY JULY 1995 CCCCC THE ANALYST HAPPENS TO BE IN. JULY 1995 C CCCCC ON UNIX, CHANGE WAS MADE SO THAT LOGIN FILE SEARCHED FOR CCCCC IN USER'S HOME DIRECTORY (IF HOME ENVIORNMENT VARIABLE EXISTS) CCCCC RATHER THAN THE CURRENT DIRECTORY. NOTE THAT THIS CAUSES A CCCCC AN ERROR MESSAGE SAYING THAT DPLOGF FILE NOT FOUND. THIS IS CCCCC BECAUSE A PATH NAME IS NOW GIVEN AS PART OF THE DPLOGF NAME CCCCC (AND IT THEREFORE DOES NOT SEARCH THE DATAPLOT AUXILLARY FILES CCCCC DIRECOTRIES CORRECTLY. TO FIX, CHECK FOR EXISTENCE OF DPLOGF CCCCC FILE, AND IF NOT FOUND, GIVE THE NAME AS DPLOGF.TEX WITH NO CCCCC PATH. THIS WILL LOOK FOR IT IN THE AUXILLARY DIRECTORY. JULY 1996 IANSLC(1)='C ' IANSLC(2)='A ' IANSLC(3)='L ' IANSLC(4)='L ' IANSLC(5)=' ' J=0 IF(IOPSY1.EQ.'UNIX')THEN CCCCC IOUNIT=ILOGNU CCCCC IFORM=ILOGFO IFILE=ILOGNA CCCCC ISTAT=ILOGST CCCCC IACCES=ILOGAC CCCCC IREWR=ILOGRW APRIL 10, 1987 (THIS LINE ONLY) ISUBN0='MAIN' IERRFI='NO' C CALL DPINFI(IFILE,IEXIST,ISUBN0,IBUGS2,ISUBRO,IERRFI) IF(IERRFI.EQ.'YES'.OR.IEXIST.EQ.'NO')THEN DO961I=6,80 IANSLC(I)=' ' 961 CONTINUE IANSLC(6)='D ' IANSLC(7)='P ' IANSLC(8)='L ' IANSLC(9)='O ' IANSLC(10)='G ' IANSLC(11)='F ' IANSLC(12)='. ' IANSLC(13)='T ' IANSLC(14)='E ' IANSLC(15)='X ' IWIDTH=15 CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1992 ISYSSW='EXLO' GOTO1400 ELSE DO964I=6,80 J=J+1 IANSLC(I)=ILOGNA(J:J) 964 CONTINUE IWIDTH=80 CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1992 ISYSSW='EXLO' GOTO1400 ENDIF ELSE CCCCC IF(IERRFI.EQ.'YES')GOTO969 CCCCC IF(IEXIST.EQ.'NO')GOTO969 C DO965I=6,80 J=J+1 IANSLC(I)=ILOGNA(J:J) 965 CONTINUE IWIDTH=80 CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1992 ISYSSW='EXLO' GOTO1400 ENDIF 969 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1992 C ************************************************************* C ** STEP 9D-- ** C ** IF THE COMMAND LINE HAS 1 OR MORE ARGUMENTS, ** C ** GENERATE A COMMAND STATEMENT ** C ** CONSISTING OF ** C ** CALL ARGUMENT -1 ** C ** AND THEN EXECUTE IT ** C ********************************************************* C 970 CONTINUE C ISTEPN='9D' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMCLA.LE.0)GOTO979 CCCCC APRIL 1995. ADD FOLLOWING LINE. DO NOT EXECUTE AFTER A RESET CCCCC COMMAND. IF(ICKCL.GT.0)GOTO979 ICKCL=ICKCL+1 IANSLC(1)='C ' IANSLC(2)='A ' IANSLC(3)='L ' IANSLC(4)='L ' IANSLC(5)=' ' J=0 DO975I=6,80 J=J+1 IANSLC(I)=CLARG1(J:J) 975 CONTINUE IWIDTH=80 CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) ISYSSW='EXUS' GOTO1400 979 CONTINUE CCCCC JANUARY 1998. ADD FOLLOWING LINE FOR TCL/TK FRONT-END CALL DPFLSH(IPR,IBUGS2,ISUBRO,IFOUND,IERROR) C C ********************************************************* C ** STEP 10-- ** C ** START THE CYCLE-- ** C ** READ IN A LINE FROM THE TERMINAL ** C ** (UNLESS WE ARE IN THE MIDDLE OF EXECUTING A LOOP). ** C ********************************************************* C 1000 CONTINUE C IF(IBUGMA.EQ.'OFF'.AND.ISUBRO.NE.'MAIN')GOTO1019 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1011) 1011 FORMAT('---------------------NEW CYCLE-------------------') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') ISTEPN='10' CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) WRITE(ICOUT,1004)ICAPSW,ICAPNU,ICAPCS,IPR,IPRDEF 1004 FORMAT('ICAPSW,ICAPNU,ICAPCS,IPR,IPRDEF = ',A4,I8,2X,A12,2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) 777 FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1012)IMACOL,IMACRO,ILOOST,IMALEV,ICRENU,IMACNU 1012 FORMAT('IMACOL,IMACRO,ILOOST,IMALEV,ICRENU,IMACNU = ', 1A4,2X,A4,2X,A4,I8,I8,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1013)ICRENU,ICRECS,IMACCS,IPROGR,ITOPIC,IAUTSW,IAUTEX 1013 FORMAT('ICRENU,ICRECS,IMACCS,IPROGR,ITOPIC,IAUTSW,IAUTEX = ', 1I8,2X,A12,2X,A12,2X,A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1014)IMACRO,IPROGR,ICONCL,IEOF 1014 FORMAT('IMACRO,IPROGR,ICONCL,IEOF = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1015)IWIDTH 1015 FORMAT('IWIDTH = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1016)(IANS(I),I=1,100) 1016 FORMAT('(IANS(I),I=1,100) = ',100A1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1017)NUMCHA 1017 FORMAT('NUMCHA = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1018)(IA(I),I=1,100) 1018 FORMAT('(IA(I),I=1,100) = ',100A1) CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') 1019 CONTINUE CCCCC FOLLOWING BLOCK OF CODE ADDED MAY, 1990. C C *************************************************************** C ** STEP 10.5-- ** C ** FOR X11, CALL UPDATE ROUTINE IF PIXMAP SWITCH IS SET. ** C ** NOTE THAT THIS IS A TEMPORARY PATCH. SHOULD PROBABLY ** C ** BE MADE MORE GENERAL, I.E., CALL A "REFRESH" ROUTINE ** C ** FOR ANY WINDOWING SYSTEM THAT DATAPLOT MIGHT BE RUNNING ** C ** UNDER. ** C *************************************************************** C ISTEPN='10.5' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) CCCCC JULY 1995. IF RUNNING FRONT-END MENU SYSTEM, AUTOMATICALLY CCCCC UPDATE THE GRAPICS SCREEN (XCHECK SEEMS NOT TO WORK WITH TCL/TK CCCCC AND EXPECT RUNNING THINGS). REWRITE FOLLOWING SECTION. CCCCC IF(IX11OF.EQ.'OFF'.OR.IX11PM.EQ.'OFF')GOTO1089 IF(IX11OF.EQ.'OFF')GOTO1089 DO1080LL=1,3 IF(IDMANU(LL).EQ.'X11 ')THEN IF(IDMODE(LL).EQ.' ')THEN IF(IX11PM.EQ.'ON')THEN CALL XCHECK(IEXPOS,IERRNO) IJUNK=0 IF(IEXPOS.EQ.1)CALL XUPDAT(IJUNK) ENDIF ELSE IJUNK=1 CALL XUPDAT(IJUNK) ENDIF ENDIF 1080 CONTINUE 1089 CONTINUE C C *************************************************************** C ** STEP 11-- ** C ** ARE WE EXECUTING FROM WITHIN A LOOP? ** C ** CHECK LOOP STATUS-- ** C ** IF LOOP STATUS = OFF, THEN READ A LINE FROM TERMINAL ** C ** IF LOOP STATUS = STORE, THEN READ A LINE FROM TERMINAL ** C ** IF LOOP STATUS = EXECUTE, THEN RETRIEVE A LINE ** C ** FROM AN INTERNAL TABLE OF ** C ** PREVIOUSLY-STORED COMMANDS. ** C ** THE MOST COMMON LOOP STATUS IS OFF. ** C *************************************************************** C ISTEPN='11' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(ILOOST.EQ.'EXEC')GOTO1110 GOTO1190 C 1110 CONTINUE CALL DPLOEX(ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE, 1IHPNV,IHPNV2,ILOCPN,ASTARV,AINCV,ASTOPV,NUMLOI,ILOOIT, 1ILOOSP,ILOOEP,IANSLO,IWIDLL,MAXLIL,MAXCIL, 1IANS,IANSLC,IWIDTH, 1ICOM,ICOM2,ICOMT,ICOMI,ACOM,ICOMLC,ICOML2, 1IHARG,IHARG2,IARGT,IARG,ARG,IHARLC,IHARL2,NUMARG, 1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM, CCCCC ADD FOLLOWING LINE TO FIX DELETE IN LOOP BUG. FEBRUARY 1994. 1IN,IIFSW,NUMIF, 1IHOST1,IHOST2, 1IBUGLO,IBUGTY,ISUBRO,IERROR) IF(ICOM.EQ.'BREA'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP') 1GOTO1000 IF(ILOOST.EQ.'EXEC')GOTO1490 1190 CONTINUE C C ******************************************************* C ** STEP 12-- ** C ** ARE WE EXECUTING A PRE-PROGRAM? ** C ** HAVE WE JUST FINISHED EXECUTING A NESTED MACRO? ** C ******************************************************* C ISTEPN='12' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) CCCCC IPASS=1 CCCCC IF(IMACRO.EQ.'OFF')GOTO1219 CCCCC IDEV='MACR' CCCCC IOP='INPU' CCCCC IOUNI0=ICRENU 1219 CONTINUE C IOUNI0=IMACNU IF(IPROGR.EQ.'EXEC')IOUNI0=IPRONU C IF(IMACRO.EQ.'EOF'.AND.IMALEV.GE.1)IMACRO='EXEC' IF(IMALEV.LE.0)GOTO1290 IOFILE=IMAFIL(IMALEV) C 1290 CONTINUE IF(IBUGMA.EQ.'OFF'.AND.ISUBRO.NE.'MAIN')GOTO1299 WRITE(ICOUT,1291)IMALEV,IOUNI0,IOFILE,IMACRO 1291 FORMAT('IMALEV,IOUNI0,IOFILE,IMACRO = ', 1I8,I8,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1292)ICRENU,ICRECS,IMACCS 1292 FORMAT('ICRENU,ICRECS,IMACCS = ',I8,2X,A12,2X,A12) CALL DPWRST('XXX','BUG ') 1299 CONTINUE C C ************************************* C ** STEP 13-- ** C ** GET A COMMAND STATEMENT ** C ************************************* C ISTEPN='13' IF(IBUGMA.EQ.'OFF'.AND.ISUBRO.NE.'MAIN')GOTO1309 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1301)IAUTSW,IAUTEX,IOUNI0 1301 FORMAT('IAUTSW,IAUTEX,IOUNI0 = ',A4,2X,A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1302) 1302 FORMAT('GOING INTO DPGETC TO GET ANOTHER COMMAND...') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1303) 1303 FORMAT('. . . . . . . . . .') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') 1309 CONTINUE C IF(IAUTSW.EQ.'ON'.AND.IAUTEX.EQ.'ON')GOTO1320 C CCCCC THE IIFSW ARGUEMNT WAS ADDED TO THE FOLLOWING CALLING SEQUENCE (DEC 1988) CCCCC TO CORRECT EXTRANEOUS ERROR MESSAGE WHEN HAVE (DECEMBER 1988) CCCCC BACKSLASH INSIDE NON-EXECUTING (= FALSE)-IF. (DECEMBER 1988) CCCCC THE ICAPSW & IPRDEF ARGUMENTS WERE ADDED JUNE 1989 CCCCC TO ALLOW SCREEN-WRITING OF THE PROMPT JUNE 1989 CCCCC EVEN AS TEXT OUTPUT IS BEING CAPTURED TO A FILE. JUNE 1989 C CALL DPGETC(IOUNI0,MAXWID,ITERCH,ICONCH,IANS,IANSLC,IWIDTH, 1IANSV,IWIDSV, 1IREPST,IREPPO,IANSSV,IREPMX,IPOINT, CCCCC ADD FOLLOWING LINE DECEMBER 1997. 1IPLTST,IPLTPO,IPLTSV, 1IPROSW, CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1994 CCCCC1IMACRO,IMACNU,IMACCS, 1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IMALEV, 1IPROGR, 1ICONCL, 1IEOF, 1IIFSW, 1ICAPSW,IPRDEF, 1IATXSW, 1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,IVARLB, 1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,ILOOST, 1IBUGGC,ISUBRO,IFOUND,IERROR) CCCCC IF(IAUTSW.EQ.'ON'.AND.IMACRO.EQ.'OFF')IAUTEX='ON' GOTO1390 C 1320 CONTINUE IWIDTH=1 CCCCC THE FOLLOWING LINE WAS FIXED JULY 1989 CCCCC IANSLC(1)='/ ' IANSLC(1)='/ ' CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) IAUTEX='OFF' GOTO1390 C 1390 CONTINUE IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')WRITE(ICOUT,1391) 1IAUTSW,IAUTEX 1391 FORMAT('IAUTSW,IAUTEX = ',A4,2X,A4) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL DPWRST('XXX','BUG ') C CCCCC THE FOLLOWING SECTION WAS REWRITTEN MARCH 1992 C *********************************************** C ** STEP 14.1-- ** C ** TREAT THE REEXECUTE SAVED COMMANDS CASE ** C *********************************************** C 1400 CONTINUE ISTEPN='14.1' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')THEN CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1401)(IANS(I),I=1,20) 1401 FORMAT('(IANS(.) = ',20A1) CALL DPWRST('XXX','BUG ') ENDIF C IF(IANS(1).EQ.'/')THEN IF(IWIDTH.GE.2)THEN IANSST=' ' DO1402I=1,IWIDTH IANS4=IANS(I) IANSST(I:I)=IANS4(1:1) 1402 CONTINUE IF(IANSST(3:4).EQ.'LP'.OR. 1 IANSST(3:6).EQ.'LASE'.OR. 1 IANSST(3:5).EQ.'PRN'.OR. 1 IANSST(3:9).EQ.'PRINTER'.OR. 1 IANSST(3:6).EQ.'LPT1')THEN IREWIN='ON' CALL DPOPFI(IOUTNU,IOUTNA,IOUTST,IOUTFO,IOUTAC,IOUTPR, 1 ICURST,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) IF(IERRFI.EQ.'YES')GOTO1409 IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,1403) 1403 FORMAT('THE PRINTER HAS JUST BEEN OPENED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1404)IOUTNA 1404 FORMAT('THE FILE ',A40,' HAS JUST BEEN OPENED.') CALL DPWRST('XXX','BUG ') ENDIF IOUTCS=ICURST IPR=IOUTNU IOUTSW='ON' IPRISW='ON' ELSE CALL STRLEZ(IANSST,NC) IOUTNA=IANSST(3:NC) IREWIN='ON' CALL DPOPFI(IOUTNU,IOUTNA,IOUTST,IOUTFO,IOUTAC,IOUTPR, 1 ICURST,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) IF(IERRFI.EQ.'YES')GOTO1409 IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,1413)IOUTNA 1413 FORMAT('THE FILE ',A40,' HAS JUST BEEN OPENED.') CALL DPWRST('XXX','BUG ') ENDIF IOUTCS=ICURST IPR=IOUTNU IOUTSW='ON' IPRISW='OFF' ENDIF ENDIF C IANSLC(1)='C ' IANSLC(2)='A ' IANSLC(3)='L ' IANSLC(4)='L ' IANSLC(5)=' ' I2=5 J=0 DO1407I=6,MAXWID I2=I J=J+1 IC1=ISACNC(J:J) IF(IC1.EQ.' ')I2=I2-1 IF(IC1.EQ.' ')GOTO1408 IC4=' ' IC4(1:1)=IC1 IANSLC(I)=IC4 1407 CONTINUE 1408 CONTINUE IWIDTH=I2 CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) CCCCC IAUTEX='OFF' ENDIF 1409 CONTINUE C C ************************************* C ** STEP 14.2-- ** C ** TREAT THE EXECUTE STRING CASE ** C ************************************* C 1410 CONTINUE ISTEPN='14.2' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C IF(IWIDTH.EQ.1.AND. 1IANS(1).EQ.'X')GOTO1411 IF(IWIDTH.GE.2.AND. 1IANS(1).EQ.'X'.AND.IANS(2).EQ.' ')GOTO1411 IF(IWIDTH.GE.14.AND. 1IANS(1).EQ.'E'.AND.IANS(9).EQ.'S')GOTO1411 GOTO1419 C 1411 CONTINUE CALL DPEXEC(IANSEX,IWIDEX,IBUGMA,IFOUND,IERROR) IF(IFOUND.EQ.'NO')GOTO1419 IF(IERROR.EQ.'YES')GOTO1418 C IWIDTH=IWIDEX IF(IWIDEX.LT.0)IWIDTH=0 IF(IWIDEX.GT.MAXWID)IWIDTH=MAXWID C IF(IWIDTH.LE.0)GOTO1416 DO1415I=1,IWIDTH IANSLC(I)=IANSEX(I) 1415 CONTINUE CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) 1416 CONTINUE GOTO1419 C 1418 CONTINUE IERROR='NO' C 1419 CONTINUE C IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,1421)IMACRO,IMACNU,IMACCS,IPROGR 1421 FORMAT('IMACRO,IMACNU,IMACCS,IPROGR = ',A4,I8,2X,A12,2X,A4) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,1422)IREPST,IREPNU,IREPTO,IREPPO,IREPMX 1422 FORMAT('IREPST,IREPNU,IREPTO,IREPPO,IREPMX = ',A4,5I8) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') C IF(IPROGR.EQ.'OFF')GOTO1439 IF(IPROGR.EQ.'EXEC')GOTO1439 IPROGR='OFF' GOTO1000 C 1439 CONTINUE C IF(IREPST.EQ.'ON')GOTO1460 CCCCC ADD FOLLOWING LINE DECEMBER 1997. IF(IPLTST.EQ.'ON')GOTO1465 C IF(IANS(1).EQ.'L'.AND.IANS(2).EQ.'I'.AND. 1IANS(3).EQ.'S'.AND.IANS(4).EQ.'T')GOTO1469 IF(IANS(1).EQ.'L'.AND.IANS(2).EQ.' ')GOTO1469 IF(IANS(1).EQ.'L'.AND.IWIDTH.LE.1)GOTO1469 IF(IANS(1).EQ.'R'.AND.IANS(2).EQ.'E'.AND. 1IANS(3).EQ.'C'.AND.IANS(4).EQ.'A')GOTO1469 C IF(IANS(1).EQ.'R'.AND.IANS(2).EQ.'E'.AND. 1IANS(3).EQ.'P'.AND.IANS(4).EQ.'E')GOTO1469 CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1990 CCCCC IF(IANS(1).EQ.'R'.AND.IANS(2).EQ.' ')GOTO1469 IF(IANS(1).EQ.'R'.AND.IANS(2).EQ.' '.AND. 1IANS(3).NE.'C')GOTO1469 IF(IANS(1).EQ.'R'.AND.IWIDTH.LE.1)GOTO1469 C IF(IANS(1).EQ.'S'.AND.IANS(2).EQ.'A'.AND. 1IANS(3).EQ.'V'.AND.IANS(4).EQ.'E')GOTO1469 CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1990 CCCCC IF(IANS(1).EQ.'S'.AND.IANS(2).EQ.' ')GOTO1469 IF(IANS(1).EQ.'S'.AND.IANS(2).EQ.' '.AND. 1IANS(3).NE.'C')GOTO1469 IF(IANS(1).EQ.'S'.AND.IWIDTH.LE.1)GOTO1469 C CCCCC IF(IANS(1).EQ.' '.AND.IWIDTH.LE.1)GOTO1469 IF(IANS(1).EQ.'/'.AND.IWIDTH.LE.1)GOTO1469 CCCCC NOVEMBER 1997. ADD FOLLOWING LINE. IF(IANS(1).EQ.'G'.AND.IANS(2).EQ.'U'.AND. 1IANS(3).EQ.'I'.AND.IANS(4).EQ.' ')GOTO1469 C IF(IWIDTH.LE.0)GOTO1469 C IPOINT=IPOINT+1 IF(IPOINT.GT.IREPMX)IPOINT=1 GOTO1469 C 1460 CONTINUE IREPNU=IREPNU+1 IF(IREPNU.GE.IREPTO+1)IREPST='OFF' CCCCC IF(IREPNU.GE.IREPTO+1)IPOINT=IPOINT-1 IF(IREPNU.EQ.IREPTO+1)GOTO1469 IF(IREPNU.GE.IREPTO+2)GOTO1000 IREPPO=IREPPO+1 IF(IREPPO.GT.IREPMX)IREPPO=1 GOTO1469 CCCCC ADD FOLLOWING LINES DECEMBER 1997. 1465 CONTINUE IPLTPO=IPLTPO+1 IF(IPLTPO.GT.IPLTMX)IPLTPO=1 IF(IPLTPO.EQ.IPLTNU+1)THEN GOTO1469 ELSEIF(IPLTPO.EQ.IPLTNU+2)THEN IPLTST='OFF' IPLTPO=0 GOTO1000 ENDIF 1469 CONTINUE C IF(IMACRO.EQ.'EOF')GOTO1470 GOTO1479 C 1470 CONTINUE DO1475I=1,NUMCHA IANSLC(I)=IA(I) 1475 CONTINUE IWIDTH=NUMCHA CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) 1479 CONTINUE GOTO1490 C 1490 CONTINUE C C ******************************************************* C ** STEP 15-- ** C ** SCAN THE ENTIRE STRING-- ** C ** SEARCH FOR THE SUBSTITUTION-VALUE CHARACTER. ** C ** IF FOUND (AND IF WE ARE NOT IN THE MIDDLE OF ** C ** STORING THE BODY OF A LOOP), C ** THEN FORM A NEW STRING BY SUBSTITUTING ** C ** THE VALUE OF THE IMMEDIATELY SUCCEEDING VARIABLE ** C ** IF NOT FOUND (OR IF WE ARE IN THE MIDDLE OF ** C ** STORING THE BODY OF A LOOP), ** C ** THEN DO NOTHING. ** C ** NOTE--AT THIS POINT, WE SHOULD BE WORKING ONLY ** C ** WITH IANS(.) (AS OPPOSED TO IANSLC() ** C ** AS IN SUBROUTINE DPGETC). ** C ******************************************************* C ISTEPN='15' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,1505)ILOOST,IIFSW,IANSLC(1) 1505 FORMAT('ILOOST,IIFSW,IANSLC(1) = ',A4,2X,A4,2X,A4) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(ILOOST.EQ.'STOR')GOTO1510 CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1988 CCCCC TO SUPPRESS EXTRANEOUS ERROR MESSAGE WHEN HAVE (DECEMBER 1988) CCCCC BACKSLASH INSIDE NON-EXECUTING (= FALSE)-IF. (DECEMBER 1988) CCCCC IF(IIFSW.EQ.'TRUE') CCCCC THE FOLLOWING IF STATEMENT WAS ADDED JUNE 1989 CCCCC TO CORRECT THE PROBLEM OF ATTEMPTING TO SUBSTITUTE JUNE 1989 CCCCC WITHIN A COMMENT LINE (UNNEEDED) JUNE 1989 IF(IIFSW.EQ.'TRUE'.AND.IANSLC(1).NE.'.') 1CALL DPREP2(IANSLC,IWIDTH, 1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM, 1IVARLB, 1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH, 1IMALEV, 1IBUGMA,IERROR) 1510 CONTINUE CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGMA,IERROR) C C ************************************************ C ** STEP 21-- ** C ** IF THE ECHO SWITCH HAS BEEN TURNED ON ** C ** THEN ECHO THE CURRENT COMMAND STATEMENT. ** C ************************************************ C ISTEPN='21' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')THEN CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) WRITE(ICOUT,2181)IMACRO,IECHO 2181 FORMAT('IMACRO,IECHO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') ENDIF C IF(IMACRO.EQ.'EOF')GOTO2190 IF(IECHO.EQ.'ON')CALL DPECHO(IANSLC,IWIDTH) 2190 CONTINUE C C ****************************************** C ** STEP 22-- ** C ** EXTRACT THE COMMAND NAME AND ** C ** SEPARATE OUT THE VARIOUS ARGUMENTS ** C ****************************************** C ISTEPN='22' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,2211) 2211 FORMAT('WE ARE IN MAIN ABOUT TO ENTER DPTYPE') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C CALL DPTYPE(IANSLC,IWIDTH,IBUGTY, 1ICOM,ICOM2,ICOMT,ICOMI,ACOM,ICOMLC,ICOML2, 1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM, 1IHARG,IHARG2,IARGT,IARG,ARG,IHARLC,IHARL2,NUMARG, 1IHOST1,IHOST2) C IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,2212) 2212 FORMAT('WE ARE IN MAIN AFTER RETURNING FROM DPTYPE') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C C ****************************** C ** STEP 31-- ** C ** CHECK FOR IF ** C ** CHECK FOR END OF IF ** C ****************************** C ISTEPN='31' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,3101)ICOM,ICASIF,IIFSW,ILOOST 3101 FORMAT('ICOM,ICASIF,IIFSW,ILOOST = ',A4,2X,A4,2X,A4,2X,A4) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') C C THE FOLLOWING LINE WAS ENTERED JULY 1987 C TO CORRECT AN IF INSIDE A LOOP PROBLEM IF(ILOOST.EQ.'STOR')GOTO3190 IF(ICOM.EQ.'IF')GOTO3110 IF(ICOM.EQ.'END')GOTO3120 IF(ICOM.EQ.'ELSE' .AND. IHARG(1).EQ.'IF')GOTO13110 IF(ICOM.EQ.'ELSE')GOTO3170 IF(IIFSW.EQ.'TRUE')GOTO3190 GOTO1000 C 3110 CONTINUE ILOCS=1 CALL DPIF(ILOCS,ICASIF,IBUGQ,IERROR) CCCCC FOLLOWING 12 LINES ADDED NOVEMBER 1992 (NESTED IF'S) NUMIF=NUMIF+1 IF(NUMIF.GT.MAXIF)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3112) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3113) CALL DPWRST('XXX','BUG ') IIFSW='FALSE' GOTO1000 ENDIF 3112 FORMAT('MAXIMUM NUMBER OF NESTED IF BLOCKS EXCEEDED.') 3113 FORMAT('IF STATUS SET TO FALSE.') ICASI2(NUMIF)=ICASIF C IF(ICASIF.EQ.'TRUE')ICASI3(NUMIF)='TRUE' IF(ICASIF.EQ.'TRUE')GOTO3150 GOTO3160 C CCCCC JULY 2002: ELSE IF CLAUSE SIMILAR TO IF, HOWEVER DON'T CCCCC MODIFY NUMIF (I.E., STAY WITH CURRENT NESTING LEVEL). 13110 CONTINUE IF(NUMIF.LT.1)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,13112) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,13113) CALL DPWRST('XXX','BUG ') IIFSW='FALSE' GOTO1000 ENDIF 13112 FORMAT('***** ERROR FROM ELSE IF: NO IF BLOCK CURRENTLY ', 1 'DEFINED.') 13113 FORMAT(' IF STATUS SET TO FALSE.') ISHIFT=1 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1 IBUGG2,IERROR) ICOM='IF ' ICOM2=' ' ILOCS=1 CALL DPIF(ILOCS,ICASIF,IBUGQ,IERROR) ICASI2(NUMIF)=ICASIF C IF(ICASIF.EQ.'TRUE')ICASI3(NUMIF)='TRUE' IF(ICASIF.EQ.'TRUE')GOTO3150 GOTO3160 C 3120 CONTINUE CCCCC FOLLOWING BLOCK MODIFIED NOVEMBER 1992 CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'IF')GOTO3150 CCCCC IF(NUMARG.GE.2.AND.IHARG(1).EQ.'OF'.AND. CCCCC1IHARG(2).EQ.'IF')GOTO3150 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'IF')THEN IF(NUMIF.GE.1)THEN ICASI2(NUMIF)='TRUE' ICASI3(NUMIF)='FALS' NUMIF=NUMIF-1 ENDIF GOTO3150 ENDIF IF(NUMARG.GE.2.AND.IHARG(1).EQ.'OF'.AND. 1IHARG(2).EQ.'IF')THEN IF(NUMIF.GE.1)THEN ICASI2(NUMIF)='TRUE' ICASI3(NUMIF)='FALS' NUMIF=NUMIF-1 ENDIF GOTO3150 ENDIF C IF(IIFSW.EQ.'TRUE')GOTO3190 GOTO1000 C CCCCC FOLLOWING BLOCK MODIFIED NOVEMBER 1992. FOR NESTED IF'S, MAKE CCCCC IIFSW FALSE IF ANY OF THE IF'S ARE FALSE 3150 CONTINUE CCCCC IIFSW='TRUE' IIFSW='TRUE' IF(NUMIF.EQ.0)GOTO1000 DO3155I=1,NUMIF IF(ICASI2(I).EQ.'FALS')THEN IIFSW='FALS' GOTO1000 ENDIF 3155 CONTINUE GOTO1000 C 3160 CONTINUE IIFSW='FALS' GOTO1000 C CCCCC JULY 2002. IMPLEMENT AN ELSE CLAUSE FOR THE IF. CCCCC ELSE WILL CHANGE THE CURRENT STATUS, BUT CCCCC NOT DECREMENT THE LOOP COUNTER. 3170 CONTINUE C IF(ICASI3(NUMIF).EQ.'TRUE')THEN ICASI2(NUMIF)='FALS' IIFSW='FALS' ELSE ICASI2(NUMIF)='TRUE' IIFSW='TRUE' ENDIF C CCCCC JANUARY 2005. ADD FOLLOWING LINE. BUG WITH NESTED IF CCCCC WHEN OUTER IF IS FALSE, INNER IF'S SHOULD CCCCC BE IGNORED REGARDLESS. IF(IIFSW.EQ.'TRUE')GOTO3150 GOTO1000 C 3190 CONTINUE IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,3191)ICOM,ICASIF,IIFSW 3191 FORMAT('ICOM,ICASIF,IIFSW = ',A4,2X,A4,2X,A4) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') C C ******************************************************** C ** STEP 32-- ** C ** IF REPEAT COMMAND WAS ENTERED, ** C ** THEN JUMP BACK TO DPGETC TO GET ANOTHER COMMAND. ** C ******************************************************** C ISTEPN='32' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC CHECK FOR NAME CONFLICT FOR REPEAT PLOT, REPEAT GRAPH APRIL 1997 IF(ICOM.EQ.'REPE'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO3290 IF(ICOM.EQ.'REPE'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'GRAP')GOTO3290 IF(ICOM.EQ.'REPE'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'STAN')GOTO3290 IF(ICOM.EQ.'REPE'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'SD ')GOTO3290 IF(ICOM.EQ.'REPE'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'STAT')GOTO3290 IF(ICOM.EQ.'REPE')GOTO3210 CCCCC THE FOLLOWING LINE WAS REPLACED BY SUBSEQUENT 3 LINES JULY 1990 CCCCC IF(ICOM.EQ.'R')GOTO3210 IF(ICOM.EQ.'R'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CONT')GOTO3290 IF(ICOM.EQ.'R'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CHAR')GOTO3290 IF(ICOM.EQ.'R')GOTO3210 GOTO3290 C 3210 CONTINUE IREPST='ON' C IHOLD1=1 IHOLD2=1 IF(NUMARG.EQ.1)IHOLD1=IABS(IARG(1)) IF(NUMARG.EQ.1)IHOLD2=IABS(IARG(1)) IF(NUMARG.GE.2)IHOLD1=IABS(IARG(1)) IF(NUMARG.GE.2)IHOLD2=IABS(IARG(2)) IHOLD3=IHOLD1 IHOLD4=IHOLD2 IF(IHOLD1.LT.IHOLD2)IHOLD3=IHOLD2 IF(IHOLD1.LT.IHOLD2)IHOLD4=IHOLD1 IF(IHOLD3.GT.IREPMX)IHOLD3=IREPMX IF(IHOLD4.GT.IREPMX)IHOLD4=IREPMX IREPS1=IPOINT-IHOLD3 IREPS2=IPOINT-IHOLD4 C IREPNU=1 IREPTO=IREPS2-IREPS1+1 IF(IREPTO.GT.IREPMX)IREPTO=IREPMX IREPPO=IREPS1 IF(IREPPO.LE.0)IREPPO=IREPMX+IREPPO C IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,3211)IREPST,IREPS1,IREPS2,IREPNU,NUMARG,IREPMX,IREPTO, 1IREPPO 3211 FORMAT('IREPST,IREPS1,IREPS2,IREPNU,NUMARG,IREPMX,IREPTO,', 1'IREPPO = ',A4,7I8) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') GOTO1000 C 3290 CONTINUE C C ******************************************************* C ** STEP 32B-- ** C ** IF REPLOT COMMAND WAS ENTERED, ** C ** THEN JUMP BACK TO DPGETC TO GET ANOTHER COMMAND. ** C ** FOR NOW, ONLY REPLOT MOST RECENT GRAPH. ** C ******************************************************* C ISTEPN='32B' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICOM.EQ.'REPL')GOTO13210 GOTO13290 13210 CONTINUE C IPLTST='ON' C IPLTPO=1 IF(IPLTNU.LT.1)IPLTST='OFF' C IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')THEN WRITE(ICOUT,13211)IPLTST,IPLTPO,IPLTNU 13211 FORMAT('IPLTST,IPLTPO,IPLTNU = ',A4,2I8) CALL DPWRST('XXX','BUG ') ENDIF GOTO1000 C 13290 CONTINUE C C ******************************************************* C ** STEP 33-- ** C ** TREAT THE 3 MACRO CASES-- C ** 1) A MACRO HAS JUST BEEN CALLED C ** 2) A MACRO HAS JUST FINISHED C ** 3) A MACRO IS BEING WRITTEN OUT TO C ******************************************************* C ISTEPN='33' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'OFF'.AND.ISUBRO.NE.'MAIN')GOTO3309 WRITE(ICOUT,3301) 3301 FORMAT('<<<<>>>>') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3302)ICOM,ICOM2 3302 FORMAT('ICOM,ICOM2 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3303)IMACRO,IMACNU,IMACCS,IMALEV 3303 FORMAT('IMACRO,IMACNU,IMACCS,IMALEV = ',A4,I8,2X,A12,I8) CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') 3309 CONTINUE C IF(ICOM.EQ.'CALL'.AND.ICOM2.EQ.' ')GOTO3310 IF(IMACRO.EQ.'EOF ')GOTO3320 GOTO3330 C C ******************************************************* C ** STEP 33.1-- ** C ** IF A MACRO HAS JUST BEEN CALLED, ** C ** INCREMENT THE FILE/SUBFILE UNIT NUMBER AND ** C ** OPEN THE FILE/SUBFILE. ** C ******************************************************* C 3310 CONTINUE ISTEPN='33.1' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') IMALE8=IMALEV IMACN8=IMACNU IMALEV=IMALEV+1 IF(IMALEV.LE.MAXMAC)GOTO3315 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3312) 3312 FORMAT('***** ERROR IN MAIN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3313) 3313 FORMAT(' AN ATTEMPT WAS MADE TO NEST SUBPROGRAMS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3314)MAXMAC 3314 FORMAT(' DEEPER THAN THE MAXIMUM ALLOWABLE (',I2,').') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO8100 3315 CONTINUE C IF(IMALEV.LE.0)IMACNU=IRD IF(IMALEV.EQ.1)IMACNU=ICRENU CCCCC APRIL 1997. THE "CALL" COMMAND SHOULD BE WRITTEN TO CCCCC THE "CREATE" FILE, BUT ONLY IF FIRST LEVEL MACRO. IF(IMACRO.EQ.'ON'.AND.IMALEV.EQ.1)THEN WRITE(ICREN2,3335)(IANS(I),I=1,MIN(IWIDTH,132)) ENDIF C IF(IMALEV.GE.2)IMACNU=IMACNU+1 CALL DPMACR(ICOM,ICOM2, CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1994 CCCCC1IMACRO,IMACNU,IMACCS, 1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IMALEV, 1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM,IANSLC,IWIDTH, 1IHARG,IHARG2,IARGT,IARG,ARG,NUMARG, 1IOFILE, 1IBUGS2,ISUBRO,IFOUND,IERROR) IF(IERROR.EQ.'NO')GOTO3319 IMALEV=IMALE8 IMACNU=IMACN8 C IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS CHANGED FEBRUARY 1992 CCCCC IF(ISYSSW.EQ.'EXEC')GOTO3317 ISYSS2=ISYSSW IF(ISYSS2.EQ.'EXSY')GOTO3317 IF(ISYSS2.EQ.'EXLO')GOTO3317 IF(ISYSS2.EQ.'EXUS')GOTO3317 GOTO3318 3317 CONTINUE ISYSSW='DONE' IF(IMALEV.GE.1)IMAFIL(IMALEV)=IOFILE IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS CHANGED FEBRUARY 1992 CCCCC GOTO960 IF(ISYSS2.EQ.'EXSY')GOTO959 IF(ISYSS2.EQ.'EXLO')GOTO969 IF(ISYSS2.EQ.'EXUS')GOTO979 3318 CONTINUE C 3319 CONTINUE IF(IMALEV.GE.1)IMAFIL(IMALEV)=IOFILE GOTO1000 C C ******************************************************* C ** STEP 33.2-- ** C ** IF A MACRO FILE/SUBFILE HAS JUST BEEN FINISHED, ** C ** DECREMENT THE FILE/SUBFILE UNIT NUMBER AND ** C ** CLOSE THE FILE/SUBFILE. ** C ******************************************************* C 3320 CONTINUE ISTEPN='33.2' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') IMACCS='CLO2 ' CALL DPMACR(ICOM,ICOM2, CCCCC1IMACRO,IMACNU,IMACCS, 1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IMALEV, 1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM,IANSLC,IWIDTH, 1IHARG,IHARG2,IARGT,IARG,ARG,NUMARG, 1IOFILE, 1IBUGS2,ISUBRO,IFOUND,IERROR) IMACCS='JUNK ' IF(IMALEV.GE.1)IMAFIL(IMALEV)='NO' IMALEV=IMALEV-1 IF(IMALEV.LE.0)IMACNU=IRD IF(IMALEV.EQ.1)IMACNU=ICRENU IF(IMALEV.GE.2)IMACNU=IMACNU-1 IF(IMALEV.LE.0)IMALEV=0 CCCCC IMACRO='OFF' IF(IMALEV.LE.0)IMACRO='OFF' C CCCCC THE FOLLOWING SECTION WAS ADDED MARCH 1992 IF(IMALEV.LE.0.AND.IOUTSW.EQ.'ON')THEN IOUTSW='OFF' IPR=IPRDEF IENDFI='ON' IREWIN='ON' CALL DPCLFI(IOUTNU,IOUTNA,IOUTST,IOUTFO,IOUTAC,IOUTPR, 1 ICURST,IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) IF(IERRFI.EQ.'YES')GOTO3321 IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,3311)IOUTNA 3311 FORMAT('THE FILE ',A40,' HAS JUST BEEN CLOSED.') CALL DPWRST('XXX','BUG ') ENDIF IOUTCS=ICURST IF(IPRITY.EQ.'POST')THEN CALL COPYFI(IOUTNA,ISCRNA,IBUGS2,ISUBRO,IERROR) CALL CONVFP(ISCRNA,IOUTNA,IBUGS2,ISUBRO,IERROR) ENDIF IF(IPRISW.EQ.'ON')THEN IF(IOUTTY.EQ.'ASCI'.AND.IPRITY.EQ.'ASCI')THEN CALL PRINFI(IOUTNA,IBUGS2,ISUBRO,IERROR) ELSE IF(IOUTTY.EQ.'POST'.AND.IPRITY.EQ.'POST')THEN CALL PRINFI(IOUTNA,IBUGS2,ISUBRO,IERROR) ELSE IF(IOUTTY.EQ.'ASCI'.AND.IPRITY.EQ.'POST')THEN CCCCC THE FOLLOWING 2 LINES WERE FIXED FEBRUARY 1993 CCCCC CALL CONVFP(IOUTNA,ISCRNA,IBUGS2,ISUBRO,IERROR) CCCCC CALL PRINFI(ISCRNA,IBUGS2,ISUBRO,IERROR) ISTRIN(1:6)='DOS PP' NSTRIN=6 CALL CONV14(ISTRIN,NSTRIN,IANS,IANSLC,IWIDTH, 1 IBUGMA,IERROR) CALL DPSYST(IANS,IANSLC,IWIDTH, 1 IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM, 1 IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH, 1 IBUGMA,ISUBRO,IFOUND,IERROR) ELSE IF(IOUTTY.EQ.'POST'.AND.IPRITY.EQ.'ASCI')THEN WRITE(ICOUT,3322) 3322 FORMAT('ERROR 3322 IN MAIN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3323) 3323 FORMAT('ATTEMPT TO DUMP A POSTSCRIPT FILE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3324) 3324 FORMAT('TO A NON-POSTSCRIPT PRINTER.') CALL DPWRST('XXX','BUG ') ENDIF IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,3327) 3327 FORMAT('THE PRINTER HAS JUST BEEN CLOSED.') CALL DPWRST('XXX','BUG ') ENDIF IPRISW='OFF' ENDIF IOUTNA=IOUTN0 ENDIF 3321 CONTINUE C IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS CHANGED FEBRUARY 1992 CCCCC IF(ISYSSW.EQ.'EXEC')GOTO3325 ISYSS2=ISYSSW IF(ISYSS2.EQ.'EXSY')GOTO3325 IF(ISYSS2.EQ.'EXLO')GOTO3325 IF(ISYSS2.EQ.'EXUS')GOTO3325 GOTO3329 3325 CONTINUE ISYSSW='DONE' IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS CHANGED FEBRUARY 1992 CCCCC GOTO960 IF(ISYSS2.EQ.'EXSY')GOTO959 IF(ISYSS2.EQ.'EXLO')GOTO969 IF(ISYSS2.EQ.'EXUS')GOTO979 3329 CONTINUE C GOTO1000 C C ****************************************** C ** STEP 33.3-- ** C ** IF THE MACRO SWITCH IS ON, ** C ** COPY THE CURRENT COMMAND STATEMENT ** C ** OUT TO THE MACRO FILE/SUBFILE. ** C ****************************************** C 3330 CONTINUE ISTEPN='33.3' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C IF(ICOM.EQ.'END ')GOTO3331 GOTO3332 C 3331 CONTINUE IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CREA')IMACRO='OFF' IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MACR')IMACRO='OFF' IF(NUMARG.GE.2.AND.IHARG(1).EQ.'OF '.AND. 1IHARG(2).EQ.'CREA')IMACRO='OFF' IF(NUMARG.GE.2.AND.IHARG(1).EQ.'OF '.AND. 1IHARG(2).EQ.'MACR')IMACRO='OFF' C 3332 CONTINUE IF(IMACRO.EQ.'OFF')GOTO3339 IF(ICOM.EQ.'MACR'.AND.ICOM2.EQ.'O ')THEN IF(IHARG(1).EQ.'SUBS' .AND. IHARG(2).EQ.'CHAR')THEN CONTINUE ELSE GOTO3339 ENDIF ENDIF CCCCC APRIL 1997. SEPARATE UNITS FOR "CALL" AND "CREATE" CCCCC IF(IMACRO.EQ.'ON')WRITE(ICRENU,3335)(IANS(I),I=1,IWIDTH) IF(IMACRO.EQ.'ON')WRITE(ICREN2,3335)(IANS(I),I=1,MIN(IWIDTH,132)) 3335 FORMAT(132A1) 3339 CONTINUE C CCCCC THE FOLLOWING SECTION WAS REWRITTEN GO-T0-LESS AUGUST 1992 C *********************************************************** C ** STEP 41-- ** C ** ARE THE AUTO-LABEL SWITCHES BEING TURNED ON OR OFF? ** C ** ARE THEY ALREADY ON? ** C ** 1) IF THE AUTO-X3LABEL SWITCH IS ALREADY ON, ** C ** COPY THE CURRENT COMMAND STATEMENT ** C ** SO THAT IT WILL APPEAR AUTOMATICALLY AS X3LABEL ** C ** UNDER PLOTS. ** C ** 2) IF THE AUTO-TITLE LABEL SWITCH IS ALREADY ON, ** C ** COPY THE CURRENT COMMAND STATEMENT ** C ** SO THAT IT WILL APPEAR AUTOMATICALLY AS TITLE ** C ** ABOVE PLOTS. ** C ** 3) IF THE AUTO-LABEL SWITCH IS ALREADY ON, ** C ** COPY WORDS 2 AND 3 OF CURRENT COMMAND STATEMENT ** C ** SO THAT IT WILL APPEAR AUTOMATICALLY AS Y1LABEL ** C ** AND X1LABEL ** C *********************************************************** C ISTEPN='41' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND. 1IHARG2(1).EQ.'MATI')THEN IF(ICOM.EQ.'X3LA')IX3AUT='ON' IF(ICOM.EQ.'TITL')ITIAUT='ON' IF(ICOM.EQ.'Y1LA')IY1AUT='ON' IF(ICOM.EQ.'X1LA')IX1AUT='ON' IF(ICOM.EQ.'XLAB')IX1AUT='ON' IF(ICOM.EQ.'LABE')THEN IY1AUT='ON' IX1AUT='ON' ENDIF ENDIF C IF(IX3AUT.EQ.'ON')THEN NCX3LA=IWIDTH IF(IWIDTH.GE.1)THEN DO4110I=1,IWIDTH IX3LTE(I)=IANSLC(I) 4110 CONTINUE ENDIF ENDIF C CCCCC THE FOLLOWING 3 LINES WERE ADDED SEPTEMBER 1993 CCCCC TO BLANK OUT X2LABEL IF AUTOMATIC SEPTEMBER 1993 IF(IX2AUT.EQ.'ON')THEN NCX2LA=0 ENDIF C CCCCC THE FOLLOWING 3 LINES WERE ADDED SEPTEMBER 1993 CCCCC TO BLANK OUT Y2LABEL IF AUTOMATIC SEPTEMBER 1993 IF(IY2AUT.EQ.'ON')THEN NCY2LA=0 ENDIF C IF(ITIAUT.EQ.'ON')THEN NCTITL=IWIDTH IF(IWIDTH.GE.1)THEN DO4120I=1,IWIDTH ITITTE(I)=IANSLC(I) 4120 CONTINUE ENDIF ENDIF C CCCCC JANUARY 2000. Y1LABEL AUTOMATIC WILL GET THE VARIABLE CCCCC NAME IN IHARG(1). IT WILL SUBSTITUTE A VARIABLE LABEL CCCCC IF FOUND. C IF(IY1AUT.EQ.'ON')THEN IF(ICOM.EQ.'PLOT')THEN C IHWUSE='V' MESSAG='NO' CALL CHECKN(IHARG(1),IHARG2(1),IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) IF(IERROR.EQ.'NO')THEN ICOL=IVALUE(ILOCV) ILAST=0 DO4161I=40,1,-1 IF(IVARLB(ICOL)(I:I).NE.' ')THEN ILAST=I GOTO4163 ENDIF 4161 CONTINUE 4163 CONTINUE IF(ILAST.GE.1)THEN DO4164I=1,ILAST IY1LTE(I)(1:1)=IVARLB(ICOL)(I:I) 4164 CONTINUE NCY1LA=ILAST ELSE DO4166I=1,4 IY1LTE(I)=IHARG(1)(I:I) IY1LTE(I+4)=IHARG2(1)(I:I) 4166 CONTINUE NCY1LA=8 DO4168I=8,1,-1 NCY1LA=I IF(IY1LTE(I).NE.' ')GOTO4169 4168 CONTINUE 4169 CONTINUE ENDIF ELSE J=0 ISTART=6 IF(ISTART.GT.IWIDTH)GOTO4172 DO4171I=ISTART,IWIDTH IF(IANSLC(I).EQ.' ')GOTO4172 J=J+1 IY1LTE(J)=IANSLC(I) 4171 CONTINUE 4172 CONTINUE NCY1LA=J C ENDIF ENDIF ENDIF C IF(IX1AUT.EQ.'ON')THEN IF(ICOM.EQ.'PLOT')THEN C IHWUSE='V' MESSAG='NO' IPOS=2 IF(IHARG(2).EQ.'VS ' .OR. IHARG(2).EQ.'VERS')IPOS=3 CALL CHECKN(IHARG(IPOS),IHARG2(IPOS),IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) IF(IERROR.EQ.'NO')THEN ICOL=IVALUE(ILOCV) ILAST=0 DO4181I=52,1,-1 IF(IVARLB(ICOL)(I:I).NE.' ')THEN ILAST=I GOTO4183 ENDIF 4181 CONTINUE 4183 CONTINUE IF(ILAST.GE.1)THEN DO4184I=1,ILAST IX1LTE(I)(1:1)=IVARLB(ICOL)(I:I) 4184 CONTINUE NCX1LA=ILAST ELSE DO4186I=1,4 IX1LTE(I)=IHARG(IPOS)(I:I) IX1LTE(I+4)=IHARG2(IPOS)(I:I) 4186 CONTINUE NCX1LA=8 DO4188I=8,1,-1 NCX1LA=I IF(IX1LTE(I).NE.' ')GOTO4189 4188 CONTINUE 4189 CONTINUE ENDIF ELSE C ISTART=6 I1=ISTART IF(ISTART.GT.IWIDTH)GOTO4192 DO4191I=ISTART,IWIDTH I1=I IF(IANSLC(I).EQ.' ')GOTO4192 4191 CONTINUE 4192 CONTINUE IBL1=I1 C J=0 ISTART=IBL1+1 I2=ISTART IF(ISTART.GT.IWIDTH)GOTO4194 DO4193I=ISTART,IWIDTH I2=I IF(IANSLC(I).EQ.' ')GOTO4194 J=J+1 IX1LTE(J)=IANSLC(I) 4193 CONTINUE 4194 CONTINUE NCX1LA=J IBL2=I2 C IF(NCX1LA.EQ.3.AND. CCCCC THE FOLLOWING LINE WAS FIXED SEPTEMBER 1993 CCCCC TO ALLOW FOR LOWER CASE for SEPTEMBER 1993 CCCCC1 IX1LTE(1).EQ.'F '.AND.IX1LTE(2).EQ.'O '.AND. CCCCC1 IX1LTE(3).EQ.'R ')THEN 1 (IX1LTE(1).EQ.'F '.AND.IX1LTE(2).EQ.'O '.AND. 1 IX1LTE(3).EQ.'R ').OR. 1 (IX1LTE(1).EQ.'f '.AND.IX1LTE(2).EQ.'o '.AND. 1 IX1LTE(3).EQ.'r '))THEN J=0 ISTART=IBL2+1 I3=ISTART IF(ISTART.GT.IWIDTH)GOTO4196 DO4195I=ISTART,IWIDTH I3=I IF(IANSLC(I).EQ.' ')GOTO4196 J=J+1 IX1LTE(J)=IANSLC(I) 4195 CONTINUE 4196 CONTINUE NCX1LA=J ENDIF C ENDIF ENDIF ENDIF C C *************************************** C ** STEP 42-- ** C ** DETERMINE IF A SETTING OR ** C ** IF A PROBE ** C ** OF VARIOUS INTERNAL DATAPLOT ** C ** PARAMETERS IS BEING CALLED FOR. ** C *************************************** C ISTEPN='42' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C IFOUND='NO' IERROR='NO' C CCCCC THE FOLLOWING LINE WAS ADDED (DECEMBER 1988) CCCCC TO FIX THE BUG WHEREBY SET COMMANDS (DECEMBER 1988) CCCCC WERE NOT BEING STORED IF IN A LOOP (DECEMBER 1988) IF(ICOM.EQ.'SET'.AND.ILOOST.EQ.'STOR')GOTO5100 IF(ICOM.EQ.'SET')CALL DPSET(ILISMX,IREPCH,IOSW, 1IPPDE1,IPPDE2, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IBUGEX,IBUGE2,IBUGHE,IBUGH2,IBUGLO, CCCCC AUGUST 1995. ADD IFTORD ARGUEMENT CCCCC1IHELMX,IFTEXP, 1IHELMX,IFTEXP,IFTORD, 1IFORSW,ICREAF,NCREAF,ICWRIF,NCWRIF, 1IREARW,IWRIRW, CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1992 1NPLOTP, CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993 1IPRITY, CCCCC FOLLOWING LINE ADD APRIL 1995 1IUNFOF,IUNFNR,IUNFMC, CCCCC FOLLOWING LINE ADD MARCH 1996 CCCCC1IRHSTG, 1IFOUND,IERROR) IF(ICOM.EQ.'SET ')IBUGLO=IBUGMA IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 C CCCCC THE FOLLOWING LINE WAS ADDED (DECEMBER 1988) CCCCC TO FIX THE BUG WHEREBY PROBE COMMANDS (DECEMBER 1988) CCCCC WERE NOT BEING STORED IF IN A LOOP (DECEMBER 1988) IF(ICOM.EQ.'PROB'.AND.ILOOST.EQ.'STOR')GOTO5100 IF(ICOM.EQ.'PROB')CALL DPPROB(ILISMX,IREPCH,IOSW, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IBUGEX,IBUGE2,IBUGHE,IBUGH2,IBUGLO, CCCCC AUGUST 1995. ADD IFTORD ARGUEMENT CCCCC1IHELMX,IFTEXP, 1IHELMX,IFTEXP,IFTORD, 1IFORSW,ICREAF,NCREAF,ICWRIF,NCWRIF, 1IREARW,IWRIRW, CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1992 1NPLOTP, CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993 1IPRITY, CCCCC FOLLOWING LINE ADD APRIL 1995 1IUNFOF,IUNFNR,IUNFMC, CCCCC FOLLOWING LINE ADD MARCH 1996 CCCCC1IRHSTG, 1IFOUND,IERROR) IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 C CCCCC IF(ICOM.EQ.'END')GOTO9000 CCCCC IF(ICOM.EQ.'STOP')GOTO9000 C CCCCC ABOUT 300 LINES OF CODE DEALING WITH 4-PLOT (JANUARY 1989) CCCCC WERE REMOVED TO A SEPARATE SUBROUTINE (DP4PLO) (JANUARY 1989) C C ******************************************************** C ** STEP 51-- C ** CHECK LOOP STATUS-- C ** SHOULD THE COMMAND LINE BE STORED? C ** IF LOOP STATUS = STORE, THEN STORE THE CURRENT C ** COMMAND LINE (DO NOT EXECUTE C ** OR IF CURRENT COMMAND = LOOP, THEN STORE THE CURRENT C ** COMMAND LINE (DO NOT E C ******************************************************** C CCCCC THE FOLLOWING LINE (5100 CONTINUE) WAS ADDED (DECEMBER 1988) CCCCC TO FIX THE BUG WHEREBY SET AND PROBE COMMANDS (DECEMBER 1988) CCCCC WERE NOT BEING STORED IF IN A LOOP (DECEMBER 1988) 5100 CONTINUE ISTEPN='51' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C IF(ILOOST.EQ.'EXEC')GOTO5190 IF(ILOOST.EQ.'STOR')GOTO5150 IF(ICOM.EQ.'LOOP')GOTO5150 GOTO5190 C 5150 CONTINUE CALL DPLOST(ILOOST,ILOOLI,NUMLIL,NUMLOS,NUMENS, 1IANSLC,IWIDTH,ICOM,IHARG,IHARG2,NUMARG,IANSLO,IWIDLL, 1MAXCIL,MAXLIL, 1IBUGLO,ISUBRO,IERROR) GOTO1000 C 5190 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED JUNE 1991 JJF C ************************************** C ** STEP 52.01-- ** C ** ENTER TURBO-C MENU SUBSYSTEM ** C ************************************** C ISTEPN='5201' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IHOST1.EQ.'IBM-')GOTO5180 GOTO5189 5180 CONTINUE IF(ICOM.EQ.'MENU')GOTO5181 IF(ICOM.EQ.'M')GOTO5181 CCCCC IF(ICOM.EQ.'GUI')GOTO5181 IF(ICOM.EQ.'GUI')GOTO5181 IF(ICOM.EQ.'G')GOTO5181 GOTO5189 5181 CONTINUE CCCCC NOVEMBER 1997. CHECK FOR: "GUI PRINT/WRITE" AND "GUI STATUS" CCCCC "GUI SAVE PLOT CONTROL" IF(NUMARG.GE.1.AND.IHARG(1).EQ.'WRIT')GOTO5189 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PRIN')GOTO5189 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'STAT')GOTO5189 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SAVE')GOTO5189 CALL TCLOTC(ISUBRO) CALL TCSHME(ISUBRO) C IFEESV=IFEEDB IFEEDB='OFF' ICOM='DEVI' ICOM2='CE ' IHARG(1)='1 ' IHARG2(1)=' ' IARGT(1)='NUMB' IARG(1)=1 C CCCCC 5-HOUR NOTE--I HAD THE FOLLOWING SET TO VGA FEBRUARY 1993 CCCCC SO AS TO SHIP OUT DATAPLOT WITHOUT THE TURBO-C FEBRUARY 1993 CCCCC MENU GRAPHICS WORKING FEBRUARY 1993 CCCCC BUT WITH A CLEAN CUSTOMER INSTALLATION. FEBRUARY 1993 CCCCC TO REACTIVATE AND TEST THE GRAPHICS WITHIN THE FEBRUARY 1993 CCCCC TURBO-C MENU, I SHOULD CHANGE THE FEBRUARY 1993 CCCCC FOLLOWING TO TURB FEBRUARY 1993 C CCCCC IHARG(2)='VGA ' FEBRUARY 1993 IHARG(2)='TURB' C IHARG2(2)=' ' IARGT(2)='WORD' NUMARG=2 CALL DPDEMN(IHARG,IHARG2,IARGT,IARG,NUMARG, 1IPL1NU,IPL1NA, 1IPL2NU,IPL2NA, 1IPL1CS,IPL2CS, 1IDEFMA,IDEFMO,IDEFM2,IDEFM3, 1IDEFPO,IDEFCN,IDEFDC,IDEFVP,IDEFHP,IDEFUN, 1NUMDEV,MAXDEV, 1IDMANU,IDMODE,IDMOD2,IDMOD3, 1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT, 1IDNVOF,IDNHOF, 1ICAPSW,ICAPNU, 1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR) IFEEDB=IFEESV IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 5189 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED JUNE 1990 C ************************************* C ** STEP 52.05-- ** C ** ENTER MENU SUBSYSTEM MODULE ** C ************************************* C ISTEPN='5205' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C CCCCC THE IM10XX TO IM20XX ARGS WERE ADDED BELOW AUGUST 1990 CCCCC THE IHELMX LINE WAS ADDED TO FOLLOWING ARGUMENT LIST AUGUST 1990 C CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1991 JJF IF(IHOST1.EQ.'IBM-')GOTO5195 C CALL DPMENU(ICOM,ICOM2,ICOMT,ICOMI, 1IHARG,IHARG2,IARGT,IARG,NUMARG, 1IMENSW, 1IME1CO,IME1AL,IME2CO,IME2AL, 1IME3CO,IME3AL,IME4CO,IME4AL, 1IME5CO,IME5AL,IME6CO,IME6AL, 1IME7CO,IME7AL,IME8CO,IME8AL, 1IME9CO,IME9AL,IM10CO,IM10AL, 1IM11CO,IM11AL,IM12CO,IM12AL, 1IM13CO,IM13AL,IM14CO,IM14AL, 1IM15CO,IM15AL,IM16CO,IM16AL, 1IM17CO,IM17AL,IM18CO,IM18AL, 1IM19CO,IM19AL,IM20CO,IM20AL, 1IMENCO,IMENAL, 1IHELMX,ICPREH,NCPREH,ICPOSH,NCPOSH, 1IANS,IWIDTH,IBUGEX,IBUGE2,ISUBRO,IFOUND,IERROR) IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 C CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1991 JJF 5195 CONTINUE C C ************************************* C ** STEP 52.1-- ** C ** ENTER EXPERT SUBSYSTEM MODULE ** C ************************************* C ISTEPN='52.1' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C CALL DPEXP1(ICOM,ICOM2,ICOMT,ICOMI, 1IHARG,IHARG2,IARGT,IARG,NUMARG, 1IEXPSW, 1IEX1CO,IEX1AL, 1IEX2CO,IEX2AL, 1IEX3CO,IEX3AL, 1IEX4CO,IEX4AL, 1IEX5CO,IEX5AL, 1IEXPCO,IEXPAL, 1IANS,IWIDTH,IBUGEX,IBUGE2,ISUBRO,IFOUND,IERROR) IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 C C ************************************* C ** STEP 52.2-- ** C ** ENTER HELP SUBSYSTEM MODULE ** C ************************************* C ISTEPN='52.2' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC THE FOLLOWING LINE WAS CHANGED JUNE 1991 JJF CCCCC IF(ICOM.EQ.'HELQ')GOTO5191 IF(ICOM.EQ.'HELQ')GOTO5196 GOTO5199 CCCCC THE FOLLOWING LINE WAS CHANGED JUNE 1991 JJF C5191 CONTINUE 5196 CONTINUE IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C CALL DPHEL1(ICOM,ICOM2,ICOMT,ICOMI, 1IHARG,IHARG2,IARGT,IARG,NUMARG, 1IHELSW, 1IHE1CO,IHE1AL, 1IHE2CO,IHE2AL, 1IHE3CO,IHE3AL, 1IHE4CO,IHE4AL, 1IHE5CO,IHE5AL, 1IHE6CO,IHE6AL, 1IHE7CO,IHE7AL, 1IHE8CO,IHE8AL, 1IHE9CO,IHE9AL, 1IHELCO,IHELAL, 1IHELMX, 1ICPREH,NCPREH,ICPOSH,NCPOSH, 1IANS,IWIDTH,IBUGHE,IBUGH2,ISUBRO,IFOUND,IERROR) IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 5199 CONTINUE C CCCCC THE FOLLOWING SECTION WERE ENTERED JULY 1990 TO GET 386 COLOR IF(IHOST1.EQ.'IBM-'.AND.IHOST2.EQ.'PC ')GOTO5210 GOTO5290 5210 CONTINUE CCCCC MAY 2002. CONFLICT WITH B BASIS TOLERANCE LIMIT COMMAND CCCCC IF(ICOM.EQ.'B')GOTO5211 IF(ICOM.EQ.'B' .AND. IHARG(1).NE.'BASI')GOTO5211 IF(ICOM.EQ.'BLUE')GOTO5211 GOTO5219 5211 CONTINUE CCCCC THE FOLLOWING 2 LINES DID NOT APPEAR TO WORK CCCCC IESC WAS CHANGED TO IESCC SEPTEMBER 1990 CCCCC WRITE(ICOUT,5212)IESCC,IFF C5212 FORMAT(A1,A1) CCCCC CALL DPWRST('XXX','BUG ') CCCCC CALL WNCLOS(1) CCCCC CALL WNOPEN(1,1,80,24) IFOUND='YES' IERROR='NO' GOTO8000 5219 CONTINUE 5290 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1992 (JJF) C ******************************************** C ** STEP 52.3-- ** C ** ENTER EDIT/FED SUBSYSTEM MODULE ** C ******************************************** C ISTEPN='52.3' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICOM.EQ.'EDIT'.OR.ICOM.EQ.'FED')THEN CCCCC AUGUST 1992. COMMENT OUT THIS COMMAND ON UNIX SYSTEMS. CCCCC PRIMARILY FOR SPACE REASONS. CAN GET SAME CAPABILITY CCCCC WITH "system vi " COMMAND. CCCCC TO ACTIVATE, UNCOMMENT THE CALL DPEDIT(.) LINE, AND CCCCC COMMENT OUT THE 2 WRITE STATEMENTS. CALL DPEDIT(ICOM,IANSLC,IWIDTH,IBUGMA,ISUBRO,IERROR) CCCCC WRITE(ICOUT,5293) C5293 FORMAT('THE EDIT COMMAND HAS BEEN DE-ACTIVATED. ') CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,5294) C5294 FORMAT('CONTACT YOUR SITE INSTALLER TO HAVE IT ACTIVATED.') CCCCC CALL DPWRST('XXX','BUG ') IFOUND='YES' IERROR='NO' GOTO8000 ENDIF C C ******************************************************** C ** STEP 53-- C ** DETERMINE IF AN EMPTY LINE HAD BEEN ENTERED C ** (THAT IS, NO COMMAND WAS ENTERED--JUST A CARRIAGE RE C ******************************************************** C ISTEPN='53' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICOM.EQ.' '.OR.ICOM.EQ.'. ')GOTO1000 C C ********************************************** C ** STEP 61-- ** C ** SEARCH FOR APPROPRIATE COMMAND-- ** C ** 1) SEARCH FOR USER-DEFINED COMMANDS ** C ** 1.6) SEARCH FOR 4-PLOT COMMAND ** CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1993 C ** 1.5) SEARCH FOR 6-PLOT COMMAND ** C ** 2) SEARCH FOR PLOT CONTROL COMMANDS ** C ** 3) SEARCH FOR DIAGRAMMATIC GRAPHICS COMMANDS ** C ** 4) SEARCH FOR OUTPUT DEVICE COMMANDS ** C ** 5) SEARCH FOR SUPPORT COMMANDS ** C ** 6) SEARCH FOR GRAPHICS COMMANDS ** C ** 7) SEARCH FOR ANALYSIS COMMANDS ** C ********************************************** C ISTEPN='61' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGMA.EQ.'OFF'.AND.ISUBRO.NE.'MAIN')GOTO6115 WRITE(ICOUT,6111) 6111 FORMAT('***** FROM MAIN--BEFORE CHECK FOR USER-DEF. COMMANDS') CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6112)ICOM,ICOM2,NUMCOM 6112 FORMAT('ICOM,ICOM2,NUMCOM = ',A4,2X,A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6113)ICOM3(1),ICOM4(1),NCOM5(1) 6113 FORMAT('ICOM3(1),ICOM4(1),NCOM5(1) = ',A4,2X,A4,I8) CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,6114)ICOM5(1) C6114 FORMAT('ICOM5(1) = ',A40) CCCCC CALL DPWRST('XXX','BUG ') 6115 CONTINUE C IF(ICOM.EQ.'ERAS'.AND.NUMARG.GE.1.AND. 1IHARG(1).EQ.'DELA')GOTO6119 IF(NUMCOM.LE.0)GOTO6119 DO6116I=1,NUMCOM I2=I IF(ICOM.EQ.ICOM3(I).AND.ICOM2.EQ.ICOM4(I))GOTO6117 6116 CONTINUE GOTO6119 6117 CONTINUE C NCTEMP=NCOM5(I2) IF(NCTEMP.LE.0)GOTO6118 ICJUNK(001:025)=' ' ICJUNK(026:050)=' ' ICJUNK(051:075)=' ' ICJUNK(076:100)=' ' ICJUNK(101:125)=' ' ICJUNK(126:130)=' ' ICJUNK(1:40)=ICOM5(I2) ISUBN0='MAIN' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,6110)I2,NCTEMP,ISUBN0 6110 FORMAT('I2,NCTEMP,ISUBN0 = ',2I8,2X,2X,A4) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') CCCCC JUNE, 1990. SET GRAPHICS UNIT CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1990 (FOR ROCKY PROBLEM CCCCC WHEREBY DEFINED STRINGS (E.G., ESC FF) WERE ENDING UP CCCCC IN DPPL1F.DAT AND CORRUPTING POSTSCRIPT FILES TO HP LASERJET) IGUNIT=IPRGR CALL GRWRST(ICJUNK,NCTEMP,ISUBN0) 6118 CONTINUE IFOUND='YES' IERROR='NO' GOTO8000 C 6119 CONTINUE C CCCCC THE FOLLOWING 20 LINES OF CODE DEALING WITH 4-PLOT (JANUARY 1989) CCCCC WAS INSERTED JANUARY 1989 C IF(ICOM.EQ.'4PLO')GOTO6180 IF(ICOM.EQ.'4'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO6180 CCCCC THE FOLLOWING LINE WAS CHANGED DECEMBER 1993 CCCCC GOTO6189 GOTO6181 6180 CONTINUE CALL DP4PLO(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1IANGLU,MAXNPP, 1CLLIMI,CLWIDT, 1ICONT,NUMHPP,IMANUF, 1XMATN,YMATN,XMITN,YMITN, 1ISQUAR, 1IVGMSW,IHGMSW, 1IMPSW,IMPNR,IMPNC,IMPCO, 1PMXMIN,PMXMAX,PMYMIN,PMYMAX, 1IX3AUT,ITIAUT, CCCCC MARCH 1996. ADD FOLLOWING LINE. 1IRHSTG,IHSTCW,IASHWT, CCCCC MARCH 2002. ADD FOLLOWING LINE. 1I4PLMC,I4PLDI, 1ICAPSW, 1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IFOUND,IERROR) CCCCC ADD FOLLOWING SECTION DECEMBER 1997. IF(IFOUND.EQ.'YES')THEN IF(IPLTST.EQ.'ON')GOTO8000 IPLTNU=1 IPLTPO=0 DO16181I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 16181 CONTINUE DO16183I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 16183 CONTINUE GOTO8000 ENDIF IF(IERROR.EQ.'YES')GOTO8100 CCCCC THE FOLLOWING LINE WAS CHANGED DECEMBER 1993 C6189 CONTINUE 6181 CONTINUE C CCCCC THE FOLLOWING 20 LINES OF CODE DEALING WITH 6-PLOT (DECEMBER 1993) CCCCC WAS INSERTED DECEMBER 1993 C IF(ICOM.EQ.'6PLO')GOTO6182 IF(ICOM.EQ.'6'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO6182 GOTO6183 6182 CONTINUE CALL DP6PLO(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1IANGLU,MAXNPP, 1CLLIMI,CLWIDT, 1ICONT,NUMHPP,IMANUF, 1XMATN,YMATN,XMITN,YMITN, 1ISQUAR, 1IVGMSW,IHGMSW, 1IMPSW,IMPNR,IMPNC,IMPCO, 1PMXMIN,PMXMAX,PMYMIN,PMYMAX, 1IX3AUT,ITIAUT, CCCCC MARCH 1996. ADD FOLLOWING LINE 1IRHSTG,IHSTCW,IASHWT, CCCCC MARCH 2002. ADD FOLLOWING LINE. 1I6PLMC, 1ICAPSW, 1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IFOUND,IERROR) CCCCC ADD FOLLOWING SECTION DECEMBER 1997. IF(IFOUND.EQ.'YES')THEN IF(IPLTST.EQ.'ON')GOTO8000 IPLTNU=1 IPLTPO=0 DO16182I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 16182 CONTINUE DO16184I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 16184 CONTINUE GOTO8000 ENDIF IF(IERROR.EQ.'YES')GOTO8100 6183 CONTINUE C CCCCC THE FOLLOWING 20 LINES OF CODE DEALING WITH RF SPREAD PLOT CCCCC WAS INSERTED SEPTEMBER 1999 C IF(ICOM.EQ.'R '.AND.NUMARG.GE.3.AND.IHARG(1).EQ.'F '.AND. 1IHARG(2).EQ.'SPRE'.AND.IHARG(3).EQ.'PLOT')GOTO16185 IF(ICOM.EQ.'RF '.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'SPRE'.AND. 1IHARG(2).EQ.'PLOT')GOTO16185 IF(ICOM.EQ.'R '.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'F '.AND. 1IHARG(2).EQ.'PLOT')GOTO16185 IF(ICOM.EQ.'RF'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO16185 C GOTO16186 16185 CONTINUE CALL DPRF(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1IANGLU,MAXNPP, 1CLLIMI,CLWIDT, 1ICONT,NUMHPP,IMANUF, 1XMATN,YMATN,XMITN,YMITN, 1ISQUAR, 1IVGMSW,IHGMSW, 1IMPSW,IMPNR,IMPNC,IMPCO, 1PMXMIN,PMXMAX,PMYMIN,PMYMAX, 1IX3AUT,ITIAUT, 1ICAPSW, 1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IFOUND,IERROR) IF(IFOUND.EQ.'YES')THEN IF(IPLTST.EQ.'ON')GOTO8000 IPLTNU=1 IPLTPO=0 DO16187I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 16187 CONTINUE DO16188I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 16188 CONTINUE GOTO8000 ENDIF IF(IERROR.EQ.'YES')GOTO8100 16186 CONTINUE C CCCCC THE FOLLOWING BLOCK OF CODE DEALING WITH SCATTER PLOT MATRIX CCCCC WAS INSERTED SEPTEMBER 1999 C IF(ICOM.EQ.'SCAT'.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'PLOT'.AND. 1IHARG(2).EQ.'MATR')GOTO17185 IF(ICOM.EQ.'YOUD'.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'MATR'.AND. 1IHARG(2).EQ.'PLOT')GOTO17185 IF(ICOM.EQ.'DEX '.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'INTE'.AND. 1IHARG2(1).EQ.'RACT'.AND.IHARG(2).EQ.'PLOT')GOTO17185 IF(ICOM.EQ.'DEX '.AND.NUMARG.GE.3.AND.IHARG(1).EQ.'INTE'.AND. 1IHARG2(1).EQ.'RACT'.AND.IHARG(2).EQ.'EFFE'.AND. 1IHARG(3).EQ.'PLOT')GOTO17185 IF(ICOM.EQ.'DEX '.AND.NUMARG.GE.4.AND.IHARG(2).EQ.'INTE'.AND. 1IHARG2(2).EQ.'RACT'.AND.IHARG(3).EQ.'EFFE'.AND. 1IHARG(4).EQ.'PLOT')GOTO17185 IF(ICOM.EQ.'DEX '.AND.NUMARG.GE.3.AND.IHARG(2).EQ.'INTE'.AND. 1IHARG2(2).EQ.'RACT'.AND.IHARG(3).EQ.'PLOT')GOTO17185 IF(ICOM.EQ.'DEX '.AND.NUMARG.GE.5.AND.IHARG(3).EQ.'INTE'.AND. 1IHARG2(3).EQ.'RACT'.AND.IHARG(4).EQ.'EFFE'.AND. 1IHARG(5).EQ.'PLOT')GOTO17185 IF(ICOM.EQ.'DEX '.AND.NUMARG.GE.4.AND.IHARG(3).EQ.'INTE'.AND. 1IHARG2(3).EQ.'RACT'.AND.IHARG(4).EQ.'PLOT')GOTO17185 IF(ICOM.EQ.'MATR'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT') 1GOTO17185 GOTO17186 C 17185 CONTINUE CALL DPSPMA(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1IANGLU,MAXNPP, 1CLLIMI,CLWIDT, 1ICONT,NUMHPP,NUMVPP,IMANUF, 1XMATN,YMATN,XMITN,YMITN, 1ISQUAR, 1IVGMSW,IHGMSW, 1IMPSW,IMPNR,IMPNC,IMPCO, 1PMXMIN,PMXMAX,PMYMIN,PMYMAX, 1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT, 1ALOWFR,ALOWDG, 1IFORSW, 1ANOPL1,ANOPL2,ISEED,IBOOSS,BARHEF,BARWEF, 1ICAPSW, 1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IFOUND,IERROR) IF(IFOUND.EQ.'YES')THEN IF(IPLTST.EQ.'ON')GOTO8000 IPLTNU=1 IPLTPO=0 DO17187I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 17187 CONTINUE DO17188I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 17188 CONTINUE GOTO8000 ENDIF IF(IERROR.EQ.'YES')GOTO8100 17186 CONTINUE C CCCCC THE FOLLOWING BLOCK OF CODE DEALING WITH CONDITIONING PLOT CCCCC WAS INSERTED SEPTEMBER 1999 C IF(ICOM.EQ.'COND'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT') 1GOTO18185 IF(ICOM.EQ.'SUBS'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT') 1GOTO18185 GOTO18186 C 18185 CONTINUE CALL DPCOND(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1IANGLU,MAXNPP, 1CLLIMI,CLWIDT, 1ICONT,NUMHPP,NUMVPP,IMANUF, 1XMATN,YMATN,XMITN,YMITN, 1ISQUAR, 1IVGMSW,IHGMSW, 1IMPSW,IMPNR,IMPNC,IMPCO, 1PMXMIN,PMXMAX,PMYMIN,PMYMAX, 1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT, 1ALOWFR,ALOWDG, 1IFORSW, 1ANOPL1,ANOPL2,ISEED,IBOOSS,BARHEF,BARWEF, 1ICAPSW, 1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IFOUND,IERROR) IF(IFOUND.EQ.'YES')THEN IF(IPLTST.EQ.'ON')GOTO8000 IPLTNU=1 IPLTPO=0 DO18187I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 18187 CONTINUE DO18188I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 18188 CONTINUE GOTO8000 ENDIF IF(IERROR.EQ.'YES')GOTO8100 18186 CONTINUE C CCCCC THE FOLLOWING BLOCK OF CODE DEALING WITH FACTOR PLOT CCCCC WAS INSERTED SEPTEMBER 1999 C IF(ICOM.EQ.'FACT'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT') 1GOTO18195 IF(ICOM.EQ.'SCAT'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT'.AND. 1 IHARG(2).NE.'MATR') 1GOTO18195 GOTO18196 C 18195 CONTINUE CALL DPFACT(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1IANGLU,MAXNPP, 1CLLIMI,CLWIDT, 1ICONT,NUMHPP,NUMVPP,IMANUF, 1XMATN,YMATN,XMITN,YMITN, 1ISQUAR, 1IVGMSW,IHGMSW, 1IMPSW,IMPNR,IMPNC,IMPCO, 1PMXMIN,PMXMAX,PMYMIN,PMYMAX, 1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT, 1ALOWFR,ALOWDG, 1IFORSW, 1ANOPL1,ANOPL2,ISEED,IBOOSS,BARHEF,BARWEF, 1ICAPSW, 1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IFOUND,IERROR) IF(IFOUND.EQ.'YES')THEN IF(IPLTST.EQ.'ON')GOTO8000 IPLTNU=1 IPLTPO=0 DO18197I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 18197 CONTINUE DO18198I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 18198 CONTINUE GOTO8000 ENDIF IF(IERROR.EQ.'YES')GOTO8100 18196 CONTINUE C CCCCC THE FOLLOWING BLOCK OF CODE DEALING WITH: CCCCC 1) PARTIAL REGRESSION PLOT CCCCC 2) PARTIAL LEVERAGE PLOT CCCCC 3) PARTIAL RESIDUAL PLOT CCCCC WAS INSERTED JUNE 2002 CCCCC NOTE: THIS IS THE MATRIX FORM OF THE COMMAND. FOR A SINGLE CCCCC PLOT, PROCESS IN MAINGR. C IF(ICOM.EQ.'MATR'.AND.NUMARG.GE.3.AND.IHARG(1).EQ.'PART'.AND. 1 IHARG(2).EQ.'REGR'.AND.IHARG(3).EQ.'PLOT')GOTO18205 IF(ICOM.EQ.'MATR'.AND.NUMARG.GE.3.AND.IHARG(1).EQ.'PART'.AND. 1 IHARG(2).EQ.'LEVE'.AND.IHARG(3).EQ.'PLOT')GOTO18205 IF(ICOM.EQ.'MATR'.AND.NUMARG.GE.3.AND.iHARG(1).EQ.'PART'.AND. 1 IHARG(2).EQ.'RESI'.AND.IHARG(3).EQ.'PLOT')GOTO18205 IF(ICOM.EQ.'MATR'.AND.NUMARG.GE.3.AND.IHARG(1).EQ.'ADDE'.AND. 1 IHARG(2).EQ.'VARI'.AND.IHARG(3).EQ.'PLOT')GOTO18205 IF(ICOM.EQ.'MATR'.AND.NUMARG.GE.4.AND.IHARG(1).EQ.'COMP'.AND. 1 IHARG(2).EQ.'PLUS'.AND.IHARG(3).EQ.'RESI'.AND. 1 IHARG(4).EQ.'PLOT')GOTO18205 IF(ICOM.EQ.'MATR'.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'CCPR'.AND. 1 IHARG(2).EQ.'PLOT')THEN ICASPL='CCPR' GOTO18205 ENDIF C GOTO18206 C 18205 CONTINUE ICOM='PART' ICOM2='IAL ' ISHIFT=1 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1 IBUGG2,IERROR) C CALL DPPRPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1IANGLU,MAXNPP, 1CLLIMI,CLWIDT, 1ICONT,NUMHPP,NUMVPP,IMANUF, 1XMATN,YMATN,XMITN,YMITN, 1ISQUAR, 1IVGMSW,IHGMSW, 1IMPSW,IMPNR,IMPNC,IMPCO, 1PMXMIN,PMXMAX,PMYMIN,PMYMAX, 1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT, 1ALOWFR,ALOWDG, 1IFORSW, 1ANOPL1,ANOPL2,ISEED,IBOOSS,BARHEF,BARWEF, 1ICAPSW, 1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IFOUND,IERROR) IF(IFOUND.EQ.'YES')THEN IF(IPLTST.EQ.'ON')GOTO8000 IPLTNU=1 IPLTPO=0 DO18207I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 18207 CONTINUE DO18208I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 18208 CONTINUE GOTO8000 ENDIF IF(IERROR.EQ.'YES')GOTO8100 18206 CONTINUE C CCCCC THE FOLLOWING 10 LINES DEALING WITH VERSION (MAY 1989) CCCCC WERE INSERTED MAY 1989 C IF(ICOM.EQ.'VERS')GOTO6190 GOTO6199 6190 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6191)IVERSI 6191 FORMAT('THIS IS DATAPLOT VERSION ',A12) CALL DPWRST('XXX','BUG ') IFOUND='YES' IERROR='NO' GOTO8000 6199 CONTINUE C 6120 CONTINUE IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,6121) 6121 FORMAT('***** FROM MAIN--BEFORE CALL TO MAINPC') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') CALL MAINPC(IBUGPC,IBUGP2,IBUGQ, 1IVGMSW,IHGMSW, 1IMPSW,IMPNR,IMPNC,IMPCO, CCCCC ADD FOLLOWING LINE AUGUST 1999. 1IMPARG, 1PMXMIN,PMXMAX,PMYMIN,PMYMAX, 1IERASV, 1PWXMIS,PWXMAS,PWYMIS,PWYMAS, CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1992 1BARHEF,BARWEF, CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992 1ITIAUT,IX1AUT,IX2AUT,IX3AUT,IY1AUT,IY2AUT, 1IFOUND,IERROR) IF(IFOUND.EQ.'YES'.AND.IERROR.EQ.'NO')IAUTEX='ON' IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 C 6130 CONTINUE IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,6131) 6131 FORMAT('***** FROM MAIN--BEFORE CALL TO MAINDG') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') CALL MAINDG(IBUGDG,IBUGD2,IBUGU2,ISUBRO, 1DEFANG,ANGLE,IDEANU,IANGLU,IREPCH, CCCCC ADD FOLLOWING LINE SEPTEMBER 1998 1IMPSW, 1ICAPSW, 1IFOUND,IERROR) IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 C 6140 CONTINUE IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,6141) 6141 FORMAT('***** FROM MAIN--BEFORE CALL TO MAINOD') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') CALL MAINOD(IBUGOD,IBUGO2,ISUBRO, 1ICAPSW, 1IFOUND,IERROR) IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 C 6150 CONTINUE IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,6151) 6151 FORMAT('***** FROM MAIN--BEFORE CALL TO MAINSU--') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,6152)IMACRO,IMACNU,IMACCS,IPROGR,ICONCL,ITOPIC 6152 FORMAT(' IMACRO,IMACNU,IMACCS,IPROGR,ICONCL,ITOPIC = ', 1A4,I8,2X,A12,2X,A12,2X,A4,2X,A4) IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') CCCCC AN ADDITIONAL ARGUMENT (ALOWFR) WAS ADDED DECEMBER 1988 CCCCC AN ADDITIONAL ARGUMENT (IBASLC) WAS ADDED JUNE 1989 CCCCC 2 ADDITIONAL ARGUMENTS (ICAPSW & IPRDEF) WERE ADDED JUNE 1989 CCCCC AN ADDITIONAL ARGUMENT (ALOWDG) WAS ADDED MARCH 1994. CALL MAINSU(IDEFSE,ISEED,ANOPL1,ANOPL2, 1ISQUAR,IBOOSS,IDEBOO, 1IANSSV,IREPMX,ILISMX,IPOINT, 1ISACNC, 1IAUTSW,IAUTEX, 1ITOPIC, 1MAXNXT, 1IPROSW, CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1994 CCCCC1IMACRO,IMACNU,IMACCS,IOFILE, CCCCC1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IOFILE, CCCCC THE FOLLOWING LINE WAS AUGMENTED MARCH 1996 1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IOFILE,IMALEV, 1IPROGR,ICONCL, 1ICOM3,ICOM4,ICOM5,NUMCOM,NCOM5, 1ICTRA1,NCTRA1,ICTRA2,NCTRA2,NUMTRA, 1IBASLC,IREPCH,IOSW,ICAPSW,IPRDEF, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IBUGEX,IBUGE2,IBUGHE,IBUGH2,IBUGLO, CCCCC THE FOLLOWING LINE WAS AUGMENTED MARCH 1992 CCCCC1ICPREH,NCPREH,ICPOSH,NCPOSH, 1ICPREH,NCPREH,ICPOSH,NCPOSH,IPRITY,IOUTTY, CCCCC1IHELMX,IFTEXP,ALOWFR, CCCCC1IHELMX,IFTEXP,ALOWFR,ALOWDG, 1IHELMX,IFTEXP,IFTORD,ALOWFR,ALOWDG, 1IFORSW,ICREAF,NCREAF,ICWRIF,NCWRIF,IREARW,IWRIRW, CCCCC FOLLOWING LINE ADD APRIL 1995 1IUNFOF,IUNFNR,IUNFMC, CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1992 CCCCC1IFOUND,IERROR) 1IRHSTG,IMPSW, CCCCC FOLLOWING LINE ADDED SEPTEMBER 2003 1ITABTI,NCTABT,ITABBR,ITABSP,ITABWD,ITABHT, CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1992 1NPLOTP,IFOUND,IERROR) IF(IFOUND.EQ.'YES')GOTO8000 IF(IERROR.EQ.'YES')GOTO8100 C 6160 CONTINUE IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,6161) 6161 FORMAT('***** FROM MAIN--BEFORE CALL TO MAINGR') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL, 1MAXNPP,ISEED,IBOOSS, 1IX1TSV,IX2TSV,IY1TSV,IY2TSV, 1IX1ZSV,IX2TSV,IY1TSV,IY2TSV, CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1992 1BARHEF,BARWEF, CCCCC THE FOLLOWING LINE WAS ADDED MARCH 1996 1IRHSTG,IHSTCW, 1ICAPSW,IFORSW, 1IAND1,IAND2,ICONT,NUMHPP,NUMVPP, 1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT, 1ISUBRO,IFOUND,IERROR) IF(IERROR.EQ.'YES')GOTO8100 CCCCC ADD FOLLOWING SECTION DECEMBER 1997. CCCCC STORE GRAPHICS COMMAND FOR REPLOT COMMAND. CCCCC CHECK FOR "PLOT AND" SYNTAX CREATES SOME COMPLICATIONS. CCCCC DON'T STORE IF ALREADY EXECUTING. IF(IFOUND.EQ.'YES')THEN IF(IPLTST.EQ.'ON')GOTO16999 IF(IPLTNU.GT.1 .AND. IPLTPO.GE.IPLTNU)GOTO16999 IF(IAND1.EQ.'NO'.AND.IAND2.EQ.'NO')THEN IPLTNU=1 IPLTPO=0 DO17163I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 17163 CONTINUE DO16163I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 16163 CONTINUE ELSEIF(IAND1.EQ.'NO'.AND.IAND2.EQ.'YES')THEN IPLTNU=1 IPLTPO=0 DO17164I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 17164 CONTINUE DO16164I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 16164 CONTINUE ELSEIF(IAND1.EQ.'YES'.AND.IAND2.EQ.'NO')THEN IPLTNU=IPLTNU+1 IPLTPO=0 DO17165I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 17165 CONTINUE DO16165I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 16165 CONTINUE ELSEIF(IAND1.EQ.'YES'.AND.IAND2.EQ.'YES')THEN IPLTNU=IPLTNU+1 IPLTPO=0 DO17166I=1,MAXCIS IPLTSV(IPLTNU,I)=' ' 17166 CONTINUE DO16166I=1,IWIDTH IPLTSV(IPLTNU,I)=IANSLC(I)(1:1) 16166 CONTINUE ENDIF 16999 CONTINUE ENDIF 6165 CONTINUE ICONT=IDCONT(1) NUMHPP=IDNHPP(1) IF(IFOUND.EQ.'YES'.AND.IAND2.EQ.'NO'.AND.ICOM.NE.'STEM') 1CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP, 1XMATN,YMATN,XMITN,YMITN, 1ISQUAR, 1IVGMSW,IHGMSW, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM, 1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH, 1YPLOT,XPLOT,X2PLOT,TAGPLO, 1IMPSW,IMPNR,IMPNC,IMPCO, CCCCC ADD FOLLOWING LINE AUGUST 1999. 1IMPARG, 1PMXMIN,PMXMAX,PMYMIN,PMYMAX, 1MAXCOL, CCCCC AUGUST 1992. ADD FOLLOWING LINE 1DSIZE,DSYMB,DCOLOR,DFILL, 1ICAPSW, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IERROR) CCCCC IF(IFOUND.EQ.'YES'.AND.IAND2.EQ.'NO'.AND.ICOM.NE.'STEM') CCCCC1IAUTEX='OFF' IF(ICASPL.EQ.'WEIB')GOTO6166 CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1990 IF(ICASPL.EQ.'NORM')GOTO6166 CCCCC THE FOLLOWING 4 LINES ADDED MAY 1998 IF(ICASPL.EQ.'NHAZ')GOTO6166 IF(ICASPL.EQ.'LHAZ')GOTO6166 IF(ICASPL.EQ.'EHAZ')GOTO6166 IF(ICASPL.EQ.'WHAZ')GOTO6166 GOTO6167 6166 CONTINUE IX1TSC=IX1TSV IX2TSC=IX2TSV IY1TSC=IY1TSV IY2TSC=IY2TSV IF(ICASPL.EQ.'WEIB')GOTO6167 IF(ICASPL.EQ.'NORM')GOTO6167 IX1ZFM=IX1ZSV IX2ZFM=IX2ZSV IY1ZFM=IY1ZSV IY2ZFM=IY2ZSV 6167 CONTINUE IF(IERROR.EQ.'NO')IAND1=IAND2 IF(IERROR.EQ.'YES')GOTO8100 IF(IFOUND.EQ.'YES')GOTO8000 C 6170 CONTINUE IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,6171) 6171 FORMAT('***** FROM MAIN--BEFORE CALL TO MAINAN') IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL DPWRST('XXX','BUG ') IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') CCCCC AN ADDITIONAL ARGUMENT (ALOWFR) WAS ADDED DECEMBER 1988 CCCCC AN ADDITIONAL ARGUMENT (ALOWDG) WAS ADDED MARCH 1994 CALL MAINAN(ICASAN,ISEED,ANOPL1,ANOPL2, 1TEMP,TEMP2,XTEMP1,XTEMP2,MAXNXT, CCCCC1IFTEXP, 1IFTEXP,IFTORD, CCCCC1ALOWFR, 1ALOWFR,ALOWDG, CCCCC JULY 2002: FOLLOWING LINE FOR BOOTSTRAP FIT 1IBOOSS, CCCCC AUGUST 2002: FOLLOWING LINE FOR CROSS TABULATE, TABULATE 1ICAPSW, 1IFORSW, 1IBUGAN,IBUGA2,IBUGA3, 1IBUGCO,IBUGEV,IBUGQ,ISUBRO,IFOUND,IERROR) C C ******************************************************** C ** STEP 62-- ** C ** NO MATCH FOUND FOR COMMAND; C ** THEREFORE, CHECK TO SEE IF A DEFAULT COMMAND EXISTS, C ** IF SO, INSERT THE DEFAULT COMMAND AND SEARCH AGAIN; C ** IF NOT, GENERATE A MESSAGE STATING THAT C ** THERE WAS NO MATCH. C ******************************************************** C ISTEPN='62' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(IBUGMA.EQ.'ON')WRITE(ICOUT,777)IMANUF,NUMDEV,IDMANU(1) IF(IBUGMA.EQ.'ON')CALL DPWRST('XXX','BUG ') C IF(IDEFCM.EQ.'OFF')GOTO8000 IF(IWIDDC.LE.0)GOTO8000 IF(IPASS.GE.2)GOTO8000 IPASS=2 C DO6210I=1,IWIDTH IREV=IWIDTH-I+1 JREV=IREV+IWIDDC+1 IANSLC(JREV)=IANSLC(IREV) IANS(JREV)=IANS(IREV) 6210 CONTINUE C DO6220I=1,IWIDDC IANSLC(I)=IDEFC(I) IANS(I)=IDEFC(I) 6220 CONTINUE C I=IWIDDC+1 CCCCC THE FOLLOWING LINE WAS FIXED JULY 1989 CCCCC IANSLC(I)=' ' IANSLC(I)=' ' IANS(I)=' ' C GOTO1490 C CCCCC ITEXCO='ANYT' CCCCC CCCCC NUMHPP=IDEVPP(1,1) CCCCC NUMVPP=IDEVPP(1,2) CCCCC ANUMHP=NUMHPP CCCCC ANUMVP=NUMVPP CCCCC CCCCC ICOLOR=IDEVCL(1) CCCCC CCCCC XSTART=XEND CCCCC YSTART=YEND CCCCC CCCCC CALL DPTEXT(ITEXCO,IANS,IWIDTH,XSTART,YSTART, CCCCC1IFONT,ICASE,IJUST,ANGLE,IANGLU,WIDTH,HEIGHT, CCCCC1XFACT,YFACT,ANUMHP,ANUMVP,ICOLOR, CCCCC1XEND,YEND,IFOUND,IBUGTE,IERROR) CCCCC IF(IFOUND.EQ.'YES')GOTO8000 CCCCC IF(IERROR.EQ.'YES')GOTO8100 C C *********************************************** C ** STEP 80-- ** C ** DETERMINE IF COMMAND FOUND OR NOT. ** C ** IF FOUND, LOOP BACK TO READ ANOTHER ** C ** LINE FROM THE TERMINAL. ** C ** IF NOT FOUND, GENERATE AN ERROR MESSAGE ** C ** AND THEN LOOP BACK TO READ ANOTHER ** C ** LINE FROM THE TERMINAL. ** C *********************************************** C 8000 CONTINUE ISTEPN='80' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C C THE FOLLOWING 3 LINES WERE COMMENTED OUT DEC. 1988 C AND REPLACED WITH THE SUCCEEDING 8 LINES C CCCCC IF(IFOUND.EQ.'YES'.AND.ICOM.NE.'RESE')GOTO1000 CCCCC IF(IFOUND.EQ.'YES'.AND.ICOM.EQ.'RESE')GOTO200 CCCCC GOTO8100 C IF(IFOUND.EQ.'YES')GOTO8010 GOTO8100 8010 CONTINUE IF(ICOM.NE.'RESE')GOTO1000 IF(ICOM.EQ.'RESE'.AND.NUMARG.LE.0)GOTO200 IF(ICOM.EQ.'RESE'.AND.NUMARG.GE.1.AND. 1 IHARG(1).EQ.'ALL')GOTO200 GOTO1000 C 8100 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IF(IFOUND.EQ.'NO'.AND.IERROR.EQ.'NO')WRITE(ICOUT,8111) 8111 FORMAT('***** NO MATCH FOUND FOR COMMAND.') IF(IFOUND.EQ.'NO'.AND.IERROR.EQ.'NO')CALL DPWRST('XXX','BUG ') IF(IERROR.EQ.'YES')WRITE(ICOUT,8112) IF(IERROR.EQ.'YES')CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS CHANGED FEBRUARY 1993 C8112 FORMAT('***** ERROR CONDITION ENCOUNTERED.') 8112 FORMAT('***** ERROR CONDITION ENCOUNTERED AT MAIN 8112.') WRITE(ICOUT,8113) 8113 FORMAT(' THE FIRST 8 CHARACTERS OF THE FIRST WORD ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8114)ICOM,ICOM2 8114 FORMAT(' OF THE COMMAND ARE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8115) 8115 FORMAT(' PLEASE REENTER COMMAND LINE.') CALL DPWRST('XXX','BUG ') 8190 CONTINUE GOTO1000 C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE CCCCC STOP END