SUBROUTINE INITHK(IBUGIN) C C PURPOSE--THIS IS SUBROUTING INITHK. C (THE HK AT THE END OF INITHK STANDS FOR HOUSEKE C THIS SUBROUTINE INITIALIZES HOUSEKEEPING VARIABLES AND PARAMETERS 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--82/7 C ORIGINAL VERSION--NOVEMBER 1980. C UPDATED --JUNE 1981. C UPDATED --AUGUST 1981. C UPDATED --NOVEMBER 1981. C UPDATED --MARCH 1982. C UPDATED --MAY 1982. C UPDATED --FEBRUARY 1989. SOFT-CODE SETTINGS (ALAN) C UPDATED --NOVEMBER 1999. VARIABLE AND ROW LABELS C UPDATED --JANUARY 2004. INITIALIZE GROUP LABELS C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGIN C CHARACTER*4 IBLANK C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOMC.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCOHO.INC' INCLUDE 'DPCOCO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IBLANK=' ' IZERO=0 ZERO=0.0 C IF(IBUGIN.EQ.'OFF')GOTO99 WRITE(ICOUT,90) 90 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,95) 95 FORMAT('***** AT THE BEGINNING OF INITHK--') CALL DPWRST('XXX','BUG ') 99 CONTINUE C C *********************************************** C ** INITIALIZE THE ANSWER VECTOR ** C ** (THE VECTOR WHERE THE ANALYST'S ENTERED ** C ** COMMAND LINE IS PLACED) ** C *********************************************** C CCCCC CAUTION--DATAPLOT COMMAND LINES ARE LIMITED TO 80 CHARACTERS CCCCC EVEN WHEN READING FROM A FILE. CCCCC SETTING MAXWID GREATER THAN 80 CCCCC CAN CAUSE STRING OVERWRITES (IN DPRELI, DPFILE, DPTYPE). C CCCCC MAXWID=200 CCCCC MAXWID=MAXSTR MAXWID=80 C IWIDTH=0 C DO100I=1,MAXWID IANS(I)=IBLANK IANSLC(I)=IBLANK 100 CONTINUE C C *********************************************** C ** INITIALIZE THE SAVED ANSWER VECTOR ** C ** (THE VECTOR WHERE THE ANALYST'S ** C ** BUFFERED REMAINING ANSWERS ARE PLACED ** C ** WHEN MULTIPLE COMMANDS PER LINE ARE ** C ** GIVEN. THIS MAKES USE OF THE ** C ** SEPARATOR CHARACTOR FEATURE. ** C *********************************************** C MAXWSV=MAXWID IWIDSV=IWIDTH C DO200I=1,MAXWID IANSV(I)=IBLANK 200 CONTINUE C C ********************************************************** C ** INITIALIZE THE ARGUMENT VECTORS ** C ** (THE VECTORS WHERE THE ARGUMENTS OF THE DECOMPOSED ** C ** COMMAND LINE ARE PLACED) ** C ********************************************************** C ICOM=IBLANK ICOM2=IBLANK ICOMLC=IBLANK ICOML2=IBLANK C MAXARG=200 NUMARG=0 C DO300I=1,MAXARG IHARG(I)=IBLANK IHARG2(I)=IBLANK IARGT(I)=IBLANK IARG(I)=IZERO ARG(I)=ZERO IHARLC(I)=IBLANK IHARL2(I)=IBLANK 300 CONTINUE C C *********************************************** C ** INITIALIZE THE NAME VECTORS ** C ** (THE VECTORS WHERE THE ANALYST'S ** C ** PARAMETER, VARIABLE, AND FUNCTION NAMES ** C ** ARE PLACED). ** C *********************************************** C CCCCC OCTOBER 1993. DEFINE MAXNAM AS A PARAMETER FROM DPCOPA.INC CCCCC MAXNAM=200 MAXNAM=MAXNME NUMNAM=0 C DO400I=1,MAXNAM IHNAME(I)=IBLANK IHNAM2(I)=IBLANK IUSE(I)=IBLANK IVSTAR(I)=IZERO IVSTOP(I)=IZERO IN(I)=IZERO IVALUE(I)=IZERO IVALU2(I)=IZERO VALUE(I)=ZERO CCCCC ADD FOLLOWING LINE. NOVEMBER 1999 IVARLB(I)=' ' 400 CONTINUE C CCCCC ADD FOLLOWING SECTION. NOVEMBER 1999. DO410I=1,MAXOBV IROWLB(I)=' ' 410 CONTINUE C CCCCC ADD FOLLOWING SECTION. JANUARY 2004. DO420J=1,MAXGRP IGRPVN(J)=' ' DO425I=1,MAXGLA IGRPLA(I,J)=' ' 425 CONTINUE 420 CONTINUE C C ******************************************************* C ** DEFINE THE MACRO SWITCH ** C ** (WHICH WILL BE ON WHEN A MACRO IS BEING FORMED, ** C ** AND OFF OTHERWISE). ** C ******************************************************* C C THIS INITIALIZATION IS NOW DONE IN MAIN. CCCCC IMACRO='OFF' C C ******************************************** C ** TREAT THE ALTERNATE PLOT FILE STATUS ** C ** (FOR CALCOMP, VERSATEC, ZETA, ETC.) ** C ******************************************** C IPLOTF='-999' CCCCC IF(IPL1ST.EQ.'OPFI')IPLOTF='ON' CCCCC IF(IPL1ST.EQ.'OPSF')IPLOTF='ON' C C C ************************************** C ** TREAT THE DEFAULT COMMAND CASE ** C ************************************** C IDEFCM='NO' IWIDDC=0 C C ******************************* C ** EXIT AND RETURN TO MAIN ** C ******************************* C 9000 CONTINUE IF(IBUGIN.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF INITHK--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9041)MAXNAM,NUMNAM 9041 FORMAT('MAXNAM,NUMNAM = ',2I8) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPINFI(IFILE,IEXIST,ISUBN0,IBUGS2,ISUBRO,IERRFI) C C PURPOSE--INQUIRE ABOUT THE EXISTENCE OF A FILE C (BUT THERE MAY BE SOME SMALL DIFFERENCES C IN HOW THAT IS DONE FOR DIFFERENT COMPUTERS). C C WRITTEN BY--JAMES J. FILLIBEN C LANGUAGE--ANSI FORTRAN (1977) C ORIGINAL VERSION--NOVEMBER 1986. C UPDATED --NOVEMBER 1987. (FORM LOWER AND UPPER CASE NAMES) C UPDATED --FEBRUARY 1989. CYBER/CDC CASE (ALAN) C UPDATED --NOVEMBER 1989. IERROR TO IERRFI (NELSON) C UPDATED --APRIL 1997. DUMMY DIMENSION FOR IFILE C C------------------------------------------------------------------------------ C CCCCC FIX FOLLOWING LINE APRIL 1997 CCCCC CHARACTER*80 IFILE CHARACTER*(*) IFILE CHARACTER*4 IEXIST CHARACTER*4 ISUBN0 C CHARACTER*4 IBUGS2 CHARACTER*4 ISUBRO CHARACTER*4 IERRFI C CHARACTER*80 IFILE2 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C LOGICAL LEXIST C C-----COMMON------------------------------------------------ C INCLUDE 'DPCOHO.INC' INCLUDE 'DPCOF2.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPIN' ISUBN2='FI ' C IERRFI='NO' C IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'INFI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('*****AT THE BEGINNING OF DPINFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IFILE 52 FORMAT('IFILE = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IEXIST 54 FORMAT('IEXIST = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)ISUBN0 55 FORMAT('ISUBN0 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)IERRFI 56 FORMAT('IERRFI = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IHOST1 61 FORMAT('IHOST1 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************************************************** C ** STEP 1-- ** C ** INQUIRE ABOUT THE EXISTENCE OF A FILE. ** C ******************************************************** C ISTEPN='1' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'INFI') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IHOST1.EQ.'VAX')GOTO1100 C IF(IHOST1.EQ.'CDC')GOTO2100 IF(IHOST1.EQ.'CYBE')GOTO2100 IF(IHOST1.EQ.'205')GOTO2100 IF(IHOST1.EQ.'NVE')GOTO2100 C GOTO1200 C C ********************************** C ** STEP 11-- ** C ** TREAT THE VAX CASE ** C ********************************** C 1100 CONTINUE INQUIRE(FILE=IFILE,EXIST=LEXIST) IEXIST='NO' IF(LEXIST)IEXIST='YES' GOTO9000 C C ********************************** C ** STEP 12-- ** C ** TREAT THE GENERAL CASE ** C ** (MODIFY AS APPROPRIATE ** C ** FOR YOUR COMPUTER) ** C ********************************** C 1200 CONTINUE IEXIST='NO' C C 1. INQUIRE WITH THE FILE NAME LITERALLY AS GIVEN C INQUIRE(FILE=IFILE,EXIST=LEXIST) IF(LEXIST)IEXIST='YES' IF(IEXIST.EQ.'YES')GOTO9000 C C 2. IF NOT FOUND WITH THE FILE NAME LITERALLY AS GIVEN, C THEN CONVERT THE FILE NAME TO LOWER CASE (E.G., UNIX) AND INQUIRE C IFILE2=IFILE CCCCC THE FOLLOWING LINE WAS CORRECTED NOVEMBER 1989 CCCCC (BUG UNCOVERED BY NELSON HSU) CCCCC CALL DPLO80(IFILE2,IFILE2,IBUGS2,IERROR) CALL DPLO80(IFILE2,IFILE2,IBUGS2,IERRFI) INQUIRE(FILE=IFILE2,EXIST=LEXIST) IF(LEXIST)IEXIST='YES' IF(IEXIST.EQ.'YES')GOTO9000 C C 3. IF NOT FOUND WITH THE FILE NAME LITERALLY AS GIVEN, C AND IF NOT FOUND WITH THE FILE NAME AS LOWER CASE, C THEN CONVERT THE FILE NAME TO UPPER CASE AND INQUIRE C IFILE2=IFILE CCCCC THE FOLLOWING LINE WAS CORRECTED NOVEMBER 1989 CCCCC (BUG UNCOVERED BY NELSON HSU) CCCCC CALL DPUP80(IFILE2,IFILE2,IBUGS2,IERROR) CALL DPUP80(IFILE2,IFILE2,IBUGS2,IERRFI) INQUIRE(FILE=IFILE2,EXIST=LEXIST) IF(LEXIST)IEXIST='YES' IF(IEXIST.EQ.'YES')GOTO9000 C GOTO9000 C C ************************************* C ** STEP 21-- ** C ** TREAT THE CYBER/CDC CASE-- ** C ** STRIP OFF THE TRAILING PERIOD ** C ** (ELSE THE INQUIRE WILL FAIL) ** C ************************************* C 2100 CONTINUE C IFILE2=IFILE DO 2150 I=80,1,-1 IF(IFILE2(I:I).EQ.' ')GOTO 2150 IF(IFILE2(I:I).EQ.IFCHAR) IFILE2(I:I)=' ' GOTO 2160 2150 CONTINUE 2160 CONTINUE INQUIRE(FILE=IFILE2,EXIST=LEXIST) IEXIST='NO' IF(LEXIST)IEXIST='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'INFI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('*****AT THE END OF DPINFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IFILE 9012 FORMAT('IFILE = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IEXIST 9014 FORMAT('IEXIST = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)ISUBN0 9015 FORMAT('ISUBN0 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)IERRFI 9016 FORMAT('IERRFI = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)IHOST1 9021 FORMAT('IHOST1 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)IFILE2 9022 FORMAT('IFILE2 = ',A80) CALL DPWRST('XXX','BUG ') 9090 CONTINUE RETURN END SUBROUTINE DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) C C PURPOSE--CLOSE A FILE C (BUT THERE MAY BE SOME SMALL DIFFERENCES C IN HOW THAT IS DONE FOR DIFFERENT COMPUTERS). C C WRITTEN BY--JAMES J. FILLIBEN C LANGUAGE--ANSI FORTRAN (1977) C ORIGINAL VERSION--NOVEMBER 1985. C C------------------------------------------------------------------------------ C CHARACTER*80 IFILE CHARACTER*12 ISTAT CHARACTER*12 IFORM CHARACTER*12 IACCES CHARACTER*12 IPROT CHARACTER*12 ICURST CHARACTER*4 IENDFI CHARACTER*4 IREWIN CHARACTER*4 ISUBN0 CHARACTER*4 IERRFI C CHARACTER*4 IBUGS2 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C-----COMMON------------------------------------------------ C INCLUDE 'DPCOHO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPCL' ISUBN2='FI ' C IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'CLFI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCLFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGS2,ISUBRO,IERROR 52 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IOUNIT 61 FORMAT('IOUNIT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)IFILE 62 FORMAT('IFILE = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)ISTAT 63 FORMAT('ISTAT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)IFORM 64 FORMAT('IFORM = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,65)IACCES 65 FORMAT('IACCES = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,66)IPROT 66 FORMAT('IPROT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,67)ICURST 67 FORMAT('ICURST = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,68)IENDFI 68 FORMAT('IENDFI = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)IREWIN 69 FORMAT('IREWIN = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71)ISUBN0 71 FORMAT('ISUBN0 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,72)IERRFI 72 FORMAT('IERRFI = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,81)IHOST1 81 FORMAT('IHOST1 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************* C ** STEP 1-- ** C ** CLOSE A FILE ** C ******************* C ISTEPN='1' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CLFI') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IHOST1.EQ.'UNIV')GOTO2100 GOTO1100 C C-----TREAT THE GENERAL CASE------------------------------------------ C 1100 CONTINUE IF(ICURST.EQ.'CLOSED')GOTO1119 IF(IREWIN.EQ.'ON')REWIND IOUNIT CLOSE(IOUNIT) 1119 CONTINUE C ICURST='CLOSED' IERRFI='NO' IERROR='NO' GOTO9000 C C-----TREAT THE UNIVAC CASE----------------------------------- C 2100 CONTINUE IF(ICURST.EQ.'CLOSED')GOTO2119 IF(IENDFI.EQ.'ON')ENDFILE IOUNIT IF(IREWIN.EQ.'ON')REWIND IOUNIT CLOSE(IOUNIT) 2119 CONTINUE C ICURST='CLOSED' IERRFI='NO' IERROR='NO' GOTO9000 C C ************************************ C ** STEP 80-- ** C ** GENERATE AN ERROR MESSAGE ** C ** IF THE FILE CANNOT BE OPENED ** C ************************************ C 8000 CONTINUE IERRFI='YES' IERROR='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8011) 8011 FORMAT('***** ERROR IN DPCLFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8012) 8012 FORMAT(' ERROR IN ATTEMPTING TO CLOSE A FILE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8021)IOUNIT 8021 FORMAT('I/O UNIT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8022)IFILE 8022 FORMAT('FILE NAME = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8023)ISTAT 8023 FORMAT('FILE STATUS = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8024)IFORM 8024 FORMAT('FILE FORMAT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8025)IACCES 8025 FORMAT('FILE ACCESS = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8026)IPROT 8026 FORMAT('FILE PROTECTION = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8027)ICURST 8027 FORMAT('FILE CURRENT STATUS = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8028)ISUBN0 8028 FORMAT('PREVIOUS (= CALLING) SUBROUTINE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8029)IERRFI 8029 FORMAT('FILE-FINDING ERROR FLAG = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8031)IHOST1 8031 FORMAT('HOST COMPUTER = ',A4) CALL DPWRST('XXX','BUG ') GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'CLFI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('*****AT THE END OF DPCLFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)IOUNIT 9021 FORMAT('IOUNIT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)IFILE 9022 FORMAT('IFILE = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)ISTAT 9023 FORMAT('ISTAT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)IFORM 9024 FORMAT('IFORM = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9025)IACCES 9025 FORMAT('IACCES = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9026)IPROT 9026 FORMAT('IPROT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9027)ICURST 9027 FORMAT('ICURST = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9028)IENDFI 9028 FORMAT('IENDFI = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9029)IREWIN 9029 FORMAT('IREWIN = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9031)ISUBN0 9031 FORMAT('ISUBN0 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9032)IERRFI 9032 FORMAT('IERRFI = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9041)IHOST1 9041 FORMAT('IHOST1 = ',A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST, 1IA,NUMCHA, 1ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR) C C PURPOSE--READ FROM A FILE C (BUT THERE MAY BE SOME SMALL DIFFERENCES C IN HOW THAT IS DONE FOR DIFFERENT COMPUTERS). C C WRITTEN BY--JAMES J. FILLIBEN C LANGUAGE--ANSI FORTRAN (1977) C ORIGINAL VERSION--NOVEMBER 1985. C UPDATED --FEBRUARY 2003. IF NUMCHA > 0, THEN ADD CAPABILITY C TO READ LINES LONGER THAN 132 C COLUMNS. C C------------------------------------------------------------------------------ C CHARACTER*80 IFILE CHARACTER*12 ISTAT CHARACTER*12 IFORM CHARACTER*12 IACCES CHARACTER*12 IPROT CHARACTER*12 ICURST CHARACTER*4 IA C CHARACTER*4 ISUBN0 CHARACTER*4 IERRFI CHARACTER*4 IBUGS2 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*9 IFORMT C DIMENSION IA(*) C C-----COMMON------------------------------------------------ C INCLUDE 'DPCOHO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPRE' ISUBN2='FI ' C IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'REFI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPREFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGS2,ISUBRO,IERROR 52 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IOUNIT 61 FORMAT('IOUNIT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)IFILE 62 FORMAT('IFILE = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)ISTAT 63 FORMAT('ISTAT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)IFORM 64 FORMAT('IFORM = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,65)IACCES 65 FORMAT('IACCES = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,66)IPROT 66 FORMAT('IPROT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,67)ICURST 67 FORMAT('ICURST = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71)NUMCHA 71 FORMAT('NUMCHA = ',I8) CALL DPWRST('XXX','BUG ') IF(NUMCHA.GE.1)THEN WRITE(ICOUT,72)(IA(I)(1:1),I=1,MIN(100,ABS(NUMCHA))) 72 FORMAT('(IA(I),I=1,NUMCHA) = ',100A1) CALL DPWRST('XXX','BUG ') ENDIF WRITE(ICOUT,81)ISUBN0 81 FORMAT('ISUBN0 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,82)IERRFI 82 FORMAT('IERRFI = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,83)IHOST1 83 FORMAT('IHOST1 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************ C ** STEP 1-- ** C ** READ FROM A FILE ** C ************************ C ISTEPN='1' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REFI') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IHOST1.EQ.'XXX')GOTO2100 GOTO1100 C C-----TREAT THE GENERAL CASE------------------------------------------ C 1100 CONTINUE C ISTEPN='11' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REFI') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IERRFI='NO' IERROR='NO' C CCCCC FEBRUARY 2003: ADD CAPABILITY TO READ LINES LONGER THAN 132 CCCCC CHARACTERS. C IF(NUMCHA.LT.0 .OR. IOUNIT.EQ.IRD)THEN NUMCHA=132 IF(IOUNIT.EQ.IRD)NUMCHA=80 READ(IOUNIT,1111,END=1118,IOSTAT=IOS,ERR=8000)(IA(I),I=1,NUMCHA) 1111 FORMAT(132A1) ELSE IFORMT=' ' IFORMT(1:9)='( A1)' IF(NUMCHA.LE.9)THEN WRITE(IFORMT(6:6),'(I1)')NUMCHA ELSEIF(NUMCHA.LE.99)THEN WRITE(IFORMT(5:6),'(I2)')NUMCHA ELSEIF(NUMCHA.LE.999)THEN WRITE(IFORMT(4:6),'(I3)')NUMCHA ELSEIF(NUMCHA.LE.9999)THEN WRITE(IFORMT(3:6),'(I4)')NUMCHA ELSE WRITE(IFORMT(2:6),'(I5)')NUMCHA ENDIF READ(IOUNIT,IFORMT,END=1118,IOSTAT=IOS,ERR=8000) 1 (IA(I),I=1,NUMCHA) ENDIF C GOTO1119 C 1118 CONTINUE NUMCHA=3 IA(1)='E' IA(2)='O' IA(3)='F' 1119 CONTINUE GOTO9000 C C-----TREAT THE XXX CASE----------------------------------- C 2100 CONTINUE GOTO9000 C C ************************************ C ** STEP 80-- ** C ** GENERATE AN ERROR MESSAGE ** C ** IF THE FILE CANNOT BE READ ** C ************************************ C 8000 CONTINUE IERRFI='YES' IERROR='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8011) 8011 FORMAT('***** ERROR IN DPREFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8012) 8012 FORMAT(' ERROR IN ATTEMPTING TO READ FROM ', 1'A FILE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8021)IOUNIT 8021 FORMAT('I/O UNIT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8022)IFILE 8022 FORMAT('FILE NAME = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8023)ISTAT 8023 FORMAT('FILE STATUS = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8024)IFORM 8024 FORMAT('FILE FORMAT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8025)IACCES 8025 FORMAT('FILE ACCESS = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8026)IPROT 8026 FORMAT('FILE PROTECTION = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8027)ICURST 8027 FORMAT('FILE CURRENT STATUS = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8028)ISUBN0 8028 FORMAT('PREVIOUS (= CALLING) SUBROUTINE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8029)IERRFI 8029 FORMAT('FILE-FINDING ERROR FLAG = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8030)IOS 8030 FORMAT('IO STATUS NUMBER = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8031)IHOST1 8031 FORMAT('HOST COMPUTER = ',A4) CALL DPWRST('XXX','BUG ') GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'REFI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPREFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)IOUNIT 9021 FORMAT('IOUNIT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)IFILE 9022 FORMAT('IFILE = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)ISTAT 9023 FORMAT('ISTAT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)IFORM 9024 FORMAT('IFORM = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9025)IACCES 9025 FORMAT('IACCES = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9026)IPROT 9026 FORMAT('IPROT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9027)ICURST 9027 FORMAT('ICURST = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9031)NUMCHA 9031 FORMAT('NUMCHA = ',I8) CALL DPWRST('XXX','BUG ') IF(NUMCHA.GE.1)THEN WRITE(ICOUT,9032)(IA(I)(1:1),I=1,MIN(100,NUMCHA)) 9032 FORMAT('(IA(I),I=1,NUMCHA) = ',100A1) CALL DPWRST('XXX','BUG ') ENDIF WRITE(ICOUT,9041)ISUBN0 9041 FORMAT('ISUBN0 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9042)IERRFI 9042 FORMAT('IERRFI = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9043)IHOST1 9043 FORMAT('IHOST1 = ',A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCOAN(IC,IX) C C PURPOSE--CONVERT IC = ONE OF THE 128 ASCII CHARACTERS C INTO ITS CORRESPONDING NUMERIC C EQUIVALENT (0 TO 127). C FOR EXAMPLE, NULL MAPS INTO 0 C ESCAPE MAPS INTO 27 C 1 MAPS INTO 49 C UPPER CASE A MAPS INTO 65 C LOWER CASE A MAPS INTO 97 C DT MAPS INTO 127 C C NOTE--THIS SUBROUTINE MIMICS THE USUAL ICHAR(.) C FUNCTION ON MOST COMPUTERS. C NOTE--SOME COMPUTERS (E.G., IBM EBCDIC, CDC NOS-2, AND C PRIME) YIELD DIFFERENT VALUES FROM THE USUAL C PRIME) HAVE ICHAR(.) FUNCTIONS WHICH C YIELD DIFFERENCT VALUES FROM THE USUAL 0 TO 127. C IN SUCH CASE (AND IN ALL CASES), C THIS SUBROUTINE WILL NEVERTHELESS YIELD VALUES C YIELD VALUES WHICH ARE IN THE 0 TO 127 RANGE. C THUS EVEN FOR IBM EBCDIC COMPUTERS (FOR EXAMPLE), C IF THIS SUBROUTINE RECEIVES AN UPPER CASE A AS INPUT, C IT WILL RETURN A 65 AS OUTPUT. C C WRITTEN BY--JAMES J. FILLIBEN C LANGUAGE--ANSI FORTRAN (1977) C ORIGINAL VERSION--NOVEMBER 1986. C UPDATED --JANUARY 1989. DATA STMT. BEFORE COMMON STMT. (ALAN) C UPDATED --JULY 1993. AVOID CALL DO DPWRST() & C AND CHANGE ICOUT BACK TO IPR C TO AVOID INFINITE LOOP RECURSION C BETWEEN DPWRST AND DPCOAN C C------------------------------------------------------------------------------ C CHARACTER*1 IC C CHARACTER*4 IBUGCO CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 C C C-----COMMON------------------------------------------------ C INCLUDE 'DPCOHO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DIMENSION IBMTAB(256) DIMENSION ICYTAB(64) C C-----DATA STATEMENTS------------------------------------------------- C C DATA STATEMENTS FOR IBM EBCDIC COMPUTERS C DATA IBMTAB( 1) / 1/ DATA IBMTAB( 2) / 2/ DATA IBMTAB( 3) / 3/ DATA IBMTAB( 4) /-99/ DATA IBMTAB( 5) / 9/ DATA IBMTAB( 6) /-99/ DATA IBMTAB( 7) /-99/ DATA IBMTAB( 8) /-99/ DATA IBMTAB( 9) /-99/ DATA IBMTAB( 10) /-99/ DATA IBMTAB( 11) / 11/ DATA IBMTAB( 12) / 12/ DATA IBMTAB( 13) / 13/ DATA IBMTAB( 14) / 14/ DATA IBMTAB( 15) / 15/ DATA IBMTAB( 16) / 16/ DATA IBMTAB( 17) / 17/ DATA IBMTAB( 18) / 18/ DATA IBMTAB( 19) / 19/ DATA IBMTAB( 20) /-99/ DATA IBMTAB( 21) /-99/ DATA IBMTAB( 22) / 8/ DATA IBMTAB( 23) /-99/ DATA IBMTAB( 24) / 24/ DATA IBMTAB( 25) / 25/ DATA IBMTAB( 26) /-99/ DATA IBMTAB( 27) /-99/ DATA IBMTAB( 28) / 28/ DATA IBMTAB( 29) / 29/ DATA IBMTAB( 30) / 30/ DATA IBMTAB( 31) / 31/ DATA IBMTAB( 32) /-99/ DATA IBMTAB( 33) /-99/ DATA IBMTAB( 34) /-99/ DATA IBMTAB( 35) /-99/ DATA IBMTAB( 36) /-99/ DATA IBMTAB( 37) / 10/ DATA IBMTAB( 38) / 23/ DATA IBMTAB( 39) / 27/ DATA IBMTAB( 40) /-99/ DATA IBMTAB( 41) /-99/ DATA IBMTAB( 42) /-99/ DATA IBMTAB( 43) /-99/ DATA IBMTAB( 44) /-99/ DATA IBMTAB( 45) / 5/ DATA IBMTAB( 46) / 6/ DATA IBMTAB( 47) / 7/ DATA IBMTAB( 48) /-99/ DATA IBMTAB( 49) /-99/ DATA IBMTAB( 50) / 22/ DATA IBMTAB( 51) /-99/ DATA IBMTAB( 52) /-99/ DATA IBMTAB( 53) /-99/ DATA IBMTAB( 54) /-99/ DATA IBMTAB( 55) / 4/ DATA IBMTAB( 56) /-99/ DATA IBMTAB( 57) /-99/ DATA IBMTAB( 58) /-99/ DATA IBMTAB( 59) /-99/ DATA IBMTAB( 60) / 20/ DATA IBMTAB( 61) / 21/ DATA IBMTAB( 62) /-99/ DATA IBMTAB( 63) / 26/ DATA IBMTAB( 64) / 32/ DATA IBMTAB( 65) /-99/ DATA IBMTAB( 66) /-99/ DATA IBMTAB( 67) /-99/ DATA IBMTAB( 68) /-99/ DATA IBMTAB( 69) /-99/ DATA IBMTAB( 70) /-99/ DATA IBMTAB( 71) /-99/ DATA IBMTAB( 72) /-99/ DATA IBMTAB( 73) /-99/ DATA IBMTAB( 74) /-99/ DATA IBMTAB( 75) / 46/ DATA IBMTAB( 76) / 60/ DATA IBMTAB( 77) / 40/ DATA IBMTAB( 78) / 43/ DATA IBMTAB( 79) /124/ DATA IBMTAB( 80) / 38/ DATA IBMTAB( 81) /-99/ DATA IBMTAB( 82) /-99/ DATA IBMTAB( 83) /-99/ DATA IBMTAB( 84) /-99/ DATA IBMTAB( 85) /-99/ DATA IBMTAB( 86) /-99/ DATA IBMTAB( 87) /-99/ DATA IBMTAB( 88) /-99/ DATA IBMTAB( 89) /-99/ DATA IBMTAB( 90) / 33/ DATA IBMTAB( 91) / 36/ DATA IBMTAB( 92) / 42/ DATA IBMTAB( 93) / 41/ DATA IBMTAB( 94) / 59/ DATA IBMTAB( 95) / 94/ DATA IBMTAB( 96) / 45/ DATA IBMTAB( 97) / 47/ DATA IBMTAB( 98) /-99/ DATA IBMTAB( 99) /-99/ DATA IBMTAB(100) /-99/ DATA IBMTAB(101) /-99/ DATA IBMTAB(102) /-99/ DATA IBMTAB(103) /-99/ DATA IBMTAB(104) /-99/ DATA IBMTAB(105) /-99/ DATA IBMTAB(106) /-99/ DATA IBMTAB(107) / 44/ DATA IBMTAB(108) / 37/ DATA IBMTAB(109) / 95/ DATA IBMTAB(110) / 62/ DATA IBMTAB(111) / 63/ DATA IBMTAB(112) /-99/ DATA IBMTAB(113) /-99/ DATA IBMTAB(114) /-99/ DATA IBMTAB(115) /-99/ DATA IBMTAB(116) /-99/ DATA IBMTAB(117) /-99/ DATA IBMTAB(118) /-99/ DATA IBMTAB(119) /-99/ DATA IBMTAB(120) /-99/ DATA IBMTAB(121) / 96/ DATA IBMTAB(122) / 58/ DATA IBMTAB(123) / 35/ DATA IBMTAB(124) / 64/ DATA IBMTAB(125) / 39/ DATA IBMTAB(126) / 61/ DATA IBMTAB(127) / 34/ DATA IBMTAB(128) /-99/ DATA IBMTAB(129) / 97/ DATA IBMTAB(130) / 98/ DATA IBMTAB(131) / 99/ DATA IBMTAB(132) /100/ DATA IBMTAB(133) /101/ DATA IBMTAB(134) /102/ DATA IBMTAB(135) /103/ DATA IBMTAB(136) /104/ DATA IBMTAB(137) /105/ DATA IBMTAB(138) /-99/ DATA IBMTAB(139) /-99/ DATA IBMTAB(140) /-99/ DATA IBMTAB(141) /-99/ DATA IBMTAB(142) /-99/ DATA IBMTAB(143) /-99/ DATA IBMTAB(144) /-99/ DATA IBMTAB(145) /106/ DATA IBMTAB(146) /107/ DATA IBMTAB(147) /108/ DATA IBMTAB(148) /109/ DATA IBMTAB(149) /110/ DATA IBMTAB(150) /111/ DATA IBMTAB(151) /112/ DATA IBMTAB(152) /113/ DATA IBMTAB(153) /114/ DATA IBMTAB(154) /-99/ DATA IBMTAB(155) /-99/ DATA IBMTAB(156) /-99/ DATA IBMTAB(157) /-99/ DATA IBMTAB(158) /-99/ DATA IBMTAB(159) /-99/ DATA IBMTAB(160) /-99/ DATA IBMTAB(161) /-99/ DATA IBMTAB(162) /115/ DATA IBMTAB(163) /116/ DATA IBMTAB(164) /117/ DATA IBMTAB(165) /118/ DATA IBMTAB(166) /119/ DATA IBMTAB(167) /120/ DATA IBMTAB(168) /121/ DATA IBMTAB(169) /122/ DATA IBMTAB(170) /-99/ DATA IBMTAB(171) /-99/ DATA IBMTAB(172) /-99/ DATA IBMTAB(173) /-99/ DATA IBMTAB(174) /-99/ DATA IBMTAB(175) /-99/ DATA IBMTAB(176) /-99/ DATA IBMTAB(177) /-99/ DATA IBMTAB(178) /-99/ DATA IBMTAB(179) /-99/ DATA IBMTAB(180) /-99/ DATA IBMTAB(181) /-99/ DATA IBMTAB(182) /-99/ DATA IBMTAB(183) /-99/ DATA IBMTAB(184) /-99/ DATA IBMTAB(185) /-99/ DATA IBMTAB(186) /-99/ DATA IBMTAB(187) /-99/ DATA IBMTAB(188) /-99/ DATA IBMTAB(189) /-99/ DATA IBMTAB(190) /-99/ DATA IBMTAB(191) /-99/ DATA IBMTAB(192) /-99/ DATA IBMTAB(193) / 65/ DATA IBMTAB(194) / 66/ DATA IBMTAB(195) / 67/ DATA IBMTAB(196) / 68/ DATA IBMTAB(197) / 69/ DATA IBMTAB(198) / 70/ DATA IBMTAB(199) / 71/ DATA IBMTAB(200) / 72/ DATA IBMTAB(201) / 73/ DATA IBMTAB(202) /-99/ DATA IBMTAB(203) /-99/ DATA IBMTAB(204) /-99/ DATA IBMTAB(205) /-99/ DATA IBMTAB(206) /-99/ DATA IBMTAB(207) /-99/ DATA IBMTAB(208) /-99/ DATA IBMTAB(209) / 74/ DATA IBMTAB(210) / 75/ DATA IBMTAB(211) / 76/ DATA IBMTAB(212) / 77/ DATA IBMTAB(213) / 78/ DATA IBMTAB(214) / 79/ DATA IBMTAB(215) / 80/ DATA IBMTAB(216) / 81/ DATA IBMTAB(217) / 82/ DATA IBMTAB(218) /-99/ DATA IBMTAB(219) /-99/ DATA IBMTAB(220) /-99/ DATA IBMTAB(221) /-99/ DATA IBMTAB(222) /-99/ DATA IBMTAB(223) /-99/ DATA IBMTAB(224) / 92/ DATA IBMTAB(225) /-99/ DATA IBMTAB(226) / 83/ DATA IBMTAB(227) / 84/ DATA IBMTAB(228) / 85/ DATA IBMTAB(229) / 86/ DATA IBMTAB(230) / 87/ DATA IBMTAB(231) / 88/ DATA IBMTAB(232) / 89/ DATA IBMTAB(233) / 90/ DATA IBMTAB(234) /-99/ DATA IBMTAB(235) /-99/ DATA IBMTAB(236) /-99/ DATA IBMTAB(237) /-99/ DATA IBMTAB(238) /-99/ DATA IBMTAB(239) /-99/ DATA IBMTAB(240) / 48/ DATA IBMTAB(241) / 49/ DATA IBMTAB(242) / 50/ DATA IBMTAB(243) / 51/ DATA IBMTAB(244) / 52/ DATA IBMTAB(245) / 53/ DATA IBMTAB(246) / 54/ DATA IBMTAB(247) / 55/ DATA IBMTAB(248) / 56/ DATA IBMTAB(249) / 57/ DATA IBMTAB(250) /-99/ DATA IBMTAB(251) /-99/ DATA IBMTAB(252) /-99/ DATA IBMTAB(253) /-99/ DATA IBMTAB(254) /-99/ DATA IBMTAB(255) /-99/ DATA IBMTAB(256) / 0/ C C DATA STATEMENTS FOR CDC NOS-2 COMPUTERS C REFERENCE--FORTRAN 5 REFERENCE MANUAL, PAGE 7-31 C DATA ICYTAB( 1) / 33/ DATA ICYTAB( 2) / 34/ DATA ICYTAB( 3) / 35/ DATA ICYTAB( 4) / 36/ DATA ICYTAB( 5) / 37/ DATA ICYTAB( 6) / 38/ DATA ICYTAB( 7) / 39/ DATA ICYTAB( 8) / 40/ DATA ICYTAB( 9) / 41/ DATA ICYTAB( 10) / 42/ DATA ICYTAB( 11) / 43/ DATA ICYTAB( 12) / 44/ DATA ICYTAB( 13) / 45/ DATA ICYTAB( 14) / 46/ DATA ICYTAB( 15) / 47/ DATA ICYTAB( 16) / 48/ DATA ICYTAB( 17) / 49/ DATA ICYTAB( 18) / 50/ DATA ICYTAB( 19) / 51/ DATA ICYTAB( 20) / 52/ DATA ICYTAB( 21) / 53/ DATA ICYTAB( 22) / 54/ DATA ICYTAB( 23) / 55/ DATA ICYTAB( 24) / 56/ DATA ICYTAB( 25) / 57/ DATA ICYTAB( 26) / 58/ DATA ICYTAB( 27) / 59/ DATA ICYTAB( 28) / 60/ DATA ICYTAB( 29) / 61/ DATA ICYTAB( 30) / 62/ DATA ICYTAB( 31) / 63/ DATA ICYTAB( 32) / 64/ DATA ICYTAB( 33) / 65/ DATA ICYTAB( 34) / 66/ DATA ICYTAB( 35) / 67/ DATA ICYTAB( 36) / 68/ DATA ICYTAB( 37) / 69/ DATA ICYTAB( 38) / 70/ DATA ICYTAB( 39) / 71/ DATA ICYTAB( 40) / 72/ DATA ICYTAB( 41) / 73/ DATA ICYTAB( 42) / 74/ DATA ICYTAB( 43) / 75/ DATA ICYTAB( 44) / 76/ DATA ICYTAB( 45) / 77/ DATA ICYTAB( 46) / 78/ DATA ICYTAB( 47) / 79/ DATA ICYTAB( 48) / 80/ DATA ICYTAB( 49) / 81/ DATA ICYTAB( 50) / 82/ DATA ICYTAB( 51) / 83/ DATA ICYTAB( 52) / 84/ DATA ICYTAB( 53) / 85/ DATA ICYTAB( 54) / 86/ DATA ICYTAB( 55) / 87/ DATA ICYTAB( 56) / 88/ DATA ICYTAB( 57) / 89/ DATA ICYTAB( 58) / 90/ DATA ICYTAB( 59) / 91/ DATA ICYTAB( 60) / 92/ DATA ICYTAB( 61) / 93/ DATA ICYTAB( 62) / 94/ DATA ICYTAB( 63) / 95/ DATA ICYTAB( 64) / 32/ C C-----START POINT----------------------------------------------------- C IBUGCO='OFF' ISUBRO='JUNK' IERROR='NO' C ISUBN1='DPCO' ISUBN2='AN ' C IXTEMP=(-999) IX=(-999) C IF(IBUGCO.EQ.'OFF'.AND.ISUBRO.NE.'COAN')GOTO90 WRITE(IPR,999) 999 FORMAT(1X) CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,51) 51 FORMAT('***** AT THE BEGINNING OF DPCOAN--') CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,52)IBUGCO,ISUBRO,IERROR 52 FORMAT('IBUGCO,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,53)IHOST1 53 FORMAT('IHOST1 = ',A4) CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,54)IC,IXTEMP,IX 54 FORMAT('IC,IXTEMP,IX = ',A1,I8,I8) CCCCC CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************** C ** STEP 10-- ** C ** BRANCH TO THE ** C ** APPROPRIATE CASE ** C ************************** C C NOTE--IF YOU ARE RUNNING ON A NON-PRIME, NON-IBM-EBCDIC, C AND A NON-CDC-NOS-2, THEN THE FOLLOWING 4 BRANCH C LINES MAY BE COMMENTED OUT C SO AS TO SPEED UP EXECUTION. C IF(IHOST1.EQ.'PRIM')GOTO1200 IF(IHOST1.EQ.'IBM')GOTO1300 IF(IHOST1.EQ.'CDC')GOTO1400 GOTO1100 C C-----TREAT THE GENERAL CASE------------------------------------------ C 1100 CONTINUE IXTEMP=ICHAR(IC) IX=IXTEMP GOTO9000 C C-----TREAT THE PRIME CASE------------------------------------------ C 1200 CONTINUE IXTEMP=ICHAR(IC) IX=IXTEMP-128 GOTO9000 C C-----TREAT THE IBM EBCDIC CASE------------------------------------------ C 1300 CONTINUE IXTEMP=ICHAR(IC) IF(IXTEMP.EQ.0)IXTEMP=256 IF(IXTEMP.LT.1)GOTO8000 IF(IXTEMP.GT.256)GOTO8000 IX=IBMTAB(IXTEMP) GOTO9000 C C-----TREAT THE CDC NOS-2 CASE------------------------------------------ C 1400 CONTINUE IXTEMP=ICHAR(IC) IF(IXTEMP.EQ.0)IXTEMP=64 IF(IXTEMP.LT.1)GOTO8000 IF(IXTEMP.GT.64)GOTO8000 IX=ICYTAB(IXTEMP) GOTO9000 C C ***************************** C ** STEP 80-- ** C ** IF AN ERROR EXISTS, ** C ** WRITE AN ERROR MESSAGE ** C ***************************** C 8000 CONTINUE C WRITE(IPR,999) CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,8011) 8011 FORMAT('***** ERROR IN DPCOAN--') CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,8012) 8012 FORMAT(' ILLEGAL NUMERIC OUTPUT ARGUMENT') CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,8013) 8013 FORMAT(' FROM ICHAR(.) FUNCTION') CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,8014)IXTEMP 8014 FORMAT(' THE ARGUMENT IXTEMP = ',I8) CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,8015)IC 8015 FORMAT('IC = ',A1) CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,8016)IHOST1 8016 FORMAT('IHOST1 = ',A4) CCCCC CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGCO.EQ.'OFF'.AND.ISUBRO.NE.'COAN')GOTO9090 WRITE(IPR,999) CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,9011) 9011 FORMAT('***** AT THE END OF DPCOAN--') CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,9012)IBUGCO,ISUBRO,IERROR 9012 FORMAT('IBUGCO,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,9013)IHOST1 9013 FORMAT('IHOST1 = ',A4) CCCCC CALL DPWRST('XXX','BUG ') WRITE(IPR,9014)IC,IXTEMP,IX 9014 FORMAT('IC,IXTEMP,IX = ',A1,I8,I8) CCCCC CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCONA(IX,IC) C C PURPOSE--CONVERT IX = 0 TO 127 INTO C THE CORRESPONDING ASCII CHARACTER. C FOR EXAMPLE, 0 MAPS INTO NULL C 27 MAPS INTO ESCAPE C 49 MAPS INTO 1 C 65 MAPS INTO UPPER CASE A C 97 MAPS INTO LOWER CASE A C 127 MAPS INTO DT C C NOTE--THIS SUBROUTINE MIMICS THE USUAL CHAR(.) C FUNCTION ON MOST COMPUTERS. C NOTE--SOME COMPUTERS (E.G., IBM EBCDIC, CDC NOS-2, AND C PRIME) HAVE CHAR(.) FUNCTIONS WHICH C HAVE DIFFERENT INPUT VALUES FROM THE USUAL 0 TO 127. C IN SUCH CASE (AND IN ALL CASES), C THIS SUBROUTINE WILL NEVERTHELESS YIELD CHARACTERS C CORRESPONDING TO THE 0 TO 127 RANGE. C THUS EVEN FOR IBM EBCDIC COMPUTERS (FOR EXAMPLE), C IF THIS SUBROUTINE RECEIVES A 65 AS INPUT, C IT WILL RETURN AN UPPER CASE A AS OUTPUT. C C WRITTEN BY--JAMES J. FILLIBEN C LANGUAGE--ANSI FORTRAN (1977) C ORIGINAL VERSION--NOVEMBER 1986. C UPDATED --JANUARY 1989. DATA STMT. BEFORE COMMON STMT. (ALAN) C C------------------------------------------------------------------------------ C CHARACTER*1 IC C CHARACTER*4 IBUGCO CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 C C-----COMMON------------------------------------------------ C INCLUDE 'DPCOHO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DIMENSION IBMTAB(128) DIMENSION ICYTAB(128) C C-----DATA STATEMENTS------------------------------------------------- C C DATA STATEMENTS FOR IBM EBCDIC COMPUTERS C DATA IBMTAB( 1) / 1/ DATA IBMTAB( 2) / 2/ DATA IBMTAB( 3) / 3/ DATA IBMTAB( 4) / 55/ DATA IBMTAB( 5) / 45/ DATA IBMTAB( 6) / 46/ DATA IBMTAB( 7) / 47/ DATA IBMTAB( 8) / 22/ DATA IBMTAB( 9) / 5/ DATA IBMTAB( 10) / 37/ DATA IBMTAB( 11) / 11/ DATA IBMTAB( 12) / 12/ DATA IBMTAB( 13) / 13/ DATA IBMTAB( 14) / 14/ DATA IBMTAB( 15) / 15/ DATA IBMTAB( 16) / 16/ DATA IBMTAB( 17) / 17/ DATA IBMTAB( 18) / 18/ DATA IBMTAB( 19) / 19/ DATA IBMTAB( 20) / 60/ DATA IBMTAB( 21) / 61/ DATA IBMTAB( 22) / 50/ DATA IBMTAB( 23) / 38/ DATA IBMTAB( 24) / 24/ DATA IBMTAB( 25) / 25/ DATA IBMTAB( 26) / 63/ DATA IBMTAB( 27) / 39/ DATA IBMTAB( 28) / 28/ DATA IBMTAB( 29) / 29/ DATA IBMTAB( 30) / 30/ DATA IBMTAB( 31) / 31/ DATA IBMTAB( 32) / 64/ DATA IBMTAB( 33) / 90/ DATA IBMTAB( 34) /127/ DATA IBMTAB( 35) /123/ DATA IBMTAB( 36) / 91/ DATA IBMTAB( 37) /108/ DATA IBMTAB( 38) / 80/ DATA IBMTAB( 39) /125/ DATA IBMTAB( 40) / 77/ DATA IBMTAB( 41) / 93/ DATA IBMTAB( 42) / 92/ DATA IBMTAB( 43) / 78/ DATA IBMTAB( 44) /107/ DATA IBMTAB( 45) / 96/ DATA IBMTAB( 46) / 75/ DATA IBMTAB( 47) / 97/ DATA IBMTAB( 48) /240/ DATA IBMTAB( 49) /241/ DATA IBMTAB( 50) /242/ DATA IBMTAB( 51) /243/ DATA IBMTAB( 52) /244/ DATA IBMTAB( 53) /245/ DATA IBMTAB( 54) /246/ DATA IBMTAB( 55) /247/ DATA IBMTAB( 56) /248/ DATA IBMTAB( 57) /249/ DATA IBMTAB( 58) /122/ DATA IBMTAB( 59) / 94/ DATA IBMTAB( 60) / 76/ DATA IBMTAB( 61) /126/ DATA IBMTAB( 62) /110/ DATA IBMTAB( 63) /111/ DATA IBMTAB( 64) /124/ DATA IBMTAB( 65) /193/ DATA IBMTAB( 66) /194/ DATA IBMTAB( 67) /195/ DATA IBMTAB( 68) /196/ DATA IBMTAB( 69) /197/ DATA IBMTAB( 70) /198/ DATA IBMTAB( 71) /199/ DATA IBMTAB( 72) /200/ DATA IBMTAB( 73) /201/ DATA IBMTAB( 74) /209/ DATA IBMTAB( 75) /210/ DATA IBMTAB( 76) /211/ DATA IBMTAB( 77) /212/ DATA IBMTAB( 78) /213/ DATA IBMTAB( 79) /214/ DATA IBMTAB( 80) /215/ DATA IBMTAB( 81) /216/ DATA IBMTAB( 82) /217/ DATA IBMTAB( 83) /226/ DATA IBMTAB( 84) /227/ DATA IBMTAB( 85) /228/ DATA IBMTAB( 86) /229/ DATA IBMTAB( 87) /230/ DATA IBMTAB( 88) /231/ DATA IBMTAB( 89) /232/ DATA IBMTAB( 90) /233/ DATA IBMTAB( 91) /-99/ DATA IBMTAB( 92) /224/ DATA IBMTAB( 93) /-99/ DATA IBMTAB( 94) / 95/ DATA IBMTAB( 95) /109/ DATA IBMTAB( 96) /121/ DATA IBMTAB( 97) /129/ DATA IBMTAB( 98) /130/ DATA IBMTAB( 99) /131/ DATA IBMTAB(100) /132/ DATA IBMTAB(101) /133/ DATA IBMTAB(102) /134/ DATA IBMTAB(103) /135/ DATA IBMTAB(104) /136/ DATA IBMTAB(105) /137/ DATA IBMTAB(106) /145/ DATA IBMTAB(107) /146/ DATA IBMTAB(108) /147/ DATA IBMTAB(109) /148/ DATA IBMTAB(110) /149/ DATA IBMTAB(111) /150/ DATA IBMTAB(112) /151/ DATA IBMTAB(113) /152/ DATA IBMTAB(114) /153/ DATA IBMTAB(115) /162/ DATA IBMTAB(116) /163/ DATA IBMTAB(117) /164/ DATA IBMTAB(118) /165/ DATA IBMTAB(119) /166/ DATA IBMTAB(120) /167/ DATA IBMTAB(121) /168/ DATA IBMTAB(122) /169/ DATA IBMTAB(123) /-99/ DATA IBMTAB(124) / 79/ DATA IBMTAB(125) /-99/ DATA IBMTAB(126) /-99/ DATA IBMTAB(127) /-99/ DATA IBMTAB(128) / 0/ C C DATA STATEMENTS FOR CDC NOS-2 COMPUTERS C REFERENCE--FORTRAN 5 REFERENCE MANUAL, PAGE 7-31 C DATA ICYTAB( 1) /-99/ DATA ICYTAB( 2) /-99/ DATA ICYTAB( 3) /-99/ DATA ICYTAB( 4) /-99/ DATA ICYTAB( 5) /-99/ DATA ICYTAB( 6) /-99/ DATA ICYTAB( 7) /-99/ DATA ICYTAB( 8) /-99/ DATA ICYTAB( 9) /-99/ DATA ICYTAB( 10) /-99/ DATA ICYTAB( 11) /-99/ DATA ICYTAB( 12) /-99/ DATA ICYTAB( 13) /-99/ DATA ICYTAB( 14) /-99/ DATA ICYTAB( 15) /-99/ DATA ICYTAB( 16) /-99/ DATA ICYTAB( 17) /-99/ DATA ICYTAB( 18) /-99/ DATA ICYTAB( 19) /-99/ DATA ICYTAB( 20) /-99/ DATA ICYTAB( 21) /-99/ DATA ICYTAB( 22) /-99/ DATA ICYTAB( 23) /-99/ DATA ICYTAB( 24) /-99/ DATA ICYTAB( 25) /-99/ DATA ICYTAB( 26) /-99/ DATA ICYTAB( 27) /-99/ DATA ICYTAB( 28) /-99/ DATA ICYTAB( 29) /-99/ DATA ICYTAB( 30) /-99/ DATA ICYTAB( 31) /-99/ DATA ICYTAB( 32) / 0/ DATA ICYTAB( 33) / 1/ DATA ICYTAB( 34) / 2/ DATA ICYTAB( 35) / 3/ DATA ICYTAB( 36) / 4/ DATA ICYTAB( 37) / 5/ DATA ICYTAB( 38) / 6/ DATA ICYTAB( 39) / 7/ DATA ICYTAB( 40) / 8/ DATA ICYTAB( 41) / 9/ DATA ICYTAB( 42) / 10/ DATA ICYTAB( 43) / 11/ DATA ICYTAB( 44) / 12/ DATA ICYTAB( 45) / 13/ DATA ICYTAB( 46) / 14/ DATA ICYTAB( 47) / 15/ DATA ICYTAB( 48) / 16/ DATA ICYTAB( 49) / 17/ DATA ICYTAB( 50) / 18/ DATA ICYTAB( 51) / 19/ DATA ICYTAB( 52) / 20/ DATA ICYTAB( 53) / 21/ DATA ICYTAB( 54) / 22/ DATA ICYTAB( 55) / 23/ DATA ICYTAB( 56) / 24/ DATA ICYTAB( 57) / 25/ DATA ICYTAB( 58) / 26/ DATA ICYTAB( 59) / 27/ DATA ICYTAB( 60) / 28/ DATA ICYTAB( 61) / 29/ DATA ICYTAB( 62) / 30/ DATA ICYTAB( 63) / 31/ DATA ICYTAB( 64) / 32/ DATA ICYTAB( 65) / 33/ DATA ICYTAB( 66) / 34/ DATA ICYTAB( 67) / 35/ DATA ICYTAB( 68) / 36/ DATA ICYTAB( 69) / 37/ DATA ICYTAB( 70) / 38/ DATA ICYTAB( 71) / 39/ DATA ICYTAB( 72) / 40/ DATA ICYTAB( 73) / 41/ DATA ICYTAB( 74) / 42/ DATA ICYTAB( 75) / 43/ DATA ICYTAB( 76) / 44/ DATA ICYTAB( 77) / 45/ DATA ICYTAB( 78) / 46/ DATA ICYTAB( 79) / 47/ DATA ICYTAB( 80) / 48/ DATA ICYTAB( 81) / 49/ DATA ICYTAB( 82) / 50/ DATA ICYTAB( 83) / 51/ DATA ICYTAB( 84) / 52/ DATA ICYTAB( 85) / 53/ DATA ICYTAB( 86) / 54/ DATA ICYTAB( 87) / 55/ DATA ICYTAB( 88) / 56/ DATA ICYTAB( 89) / 57/ DATA ICYTAB( 90) / 58/ DATA ICYTAB( 91) / 59/ DATA ICYTAB( 92) / 60/ DATA ICYTAB( 93) / 61/ DATA ICYTAB( 94) / 62/ DATA ICYTAB( 95) / 63/ DATA ICYTAB( 96) /-99/ DATA ICYTAB( 97) /-99/ DATA ICYTAB( 98) /-99/ DATA ICYTAB( 99) /-99/ DATA ICYTAB(100) /-99/ DATA ICYTAB(101) /-99/ DATA ICYTAB(102) /-99/ DATA ICYTAB(103) /-99/ DATA ICYTAB(104) /-99/ DATA ICYTAB(105) /-99/ DATA ICYTAB(106) /-99/ DATA ICYTAB(107) /-99/ DATA ICYTAB(108) /-99/ DATA ICYTAB(109) /-99/ DATA ICYTAB(110) /-99/ DATA ICYTAB(111) /-99/ DATA ICYTAB(112) /-99/ DATA ICYTAB(113) /-99/ DATA ICYTAB(114) /-99/ DATA ICYTAB(115) /-99/ DATA ICYTAB(116) /-99/ DATA ICYTAB(117) /-99/ DATA ICYTAB(118) /-99/ DATA ICYTAB(119) /-99/ DATA ICYTAB(120) /-99/ DATA ICYTAB(121) /-99/ DATA ICYTAB(122) /-99/ DATA ICYTAB(123) /-99/ DATA ICYTAB(124) /-99/ DATA ICYTAB(125) /-99/ DATA ICYTAB(126) /-99/ DATA ICYTAB(127) /-99/ DATA ICYTAB(128) /-99/ C C-----START POINT----------------------------------------------------- C IBUGCO='OFF' ISUBRO='JUNK' IERROR='NO' C ISUBN1='DPCO' ISUBN2='NA ' C IXTEMP=(-999) IXTEM2=(-999) IC='Z' C IF(IBUGCO.EQ.'OFF'.AND.ISUBRO.NE.'CONA')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCONA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGCO,ISUBRO,IERROR 52 FORMAT('IBUGCO,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IHOST1 53 FORMAT('IHOST1 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IX,IXTEMP,IXTEM2,IC 54 FORMAT('IX,IXTEMP,IXTEM2,IC = ',3I8,2X,A1) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************** C ** STEP 10-- ** C ** BRANCH TO THE ** C ** APPROPRIATE CASE ** C ************************** C C NOTE--IF YOU ARE RUNNING ON A NON-PRIME, NON-IBM-EBCDIC, C AND A NON-CDC-NOS-2, THEN THE FOLLOWING 4 BRANCH C LINES MAY BE COMMENTED OUT C SO AS TO SPEED UP EXECUTION. C IF(IHOST1.EQ.'PRIM')GOTO1200 IF(IHOST1.EQ.'IBM')GOTO1300 IF(IHOST1.EQ.'CDC')GOTO1400 GOTO1100 C C-----TREAT THE GENERAL CASE------------------------------------------ C 1100 CONTINUE IXTEM2=IX IF(IXTEM2.LT.0)GOTO8000 IF(IXTEM2.GT.127)GOTO8000 IC=CHAR(IXTEM2) GOTO9000 C C-----TREAT THE PRIME CASE------------------------------------------ C 1200 CONTINUE IXTEM2=IX+128 IF(IXTEM2.LT.0)GOTO8000 IF(IXTEM2.GT.255)GOTO8000 IC=CHAR(IXTEM2) GOTO9000 C C-----TREAT THE IBM EBCDIC CASE------------------------------------------ C 1300 CONTINUE IXTEMP=IX IF(IXTEMP.EQ.0)IXTEMP=128 IXTEM2=IBMTAB(IXTEMP) IF(IXTEM2.LT.0)GOTO8000 IF(IXTEM2.GT.255)GOTO8000 IC=CHAR(IXTEM2) GOTO9000 C C-----TREAT THE CDC NOS-2 CASE------------------------------------------ C (NOTE THAT THE INCOMING IX SHOULD BE BETWEEN 32 AND 90) C 1400 CONTINUE IXTEMP=IX IF(IXTEMP.EQ.0)IXTEMP=128 IXTEM2=ICYTAB(IXTEMP) IF(IXTEM2.LT.0)GOTO8000 IF(IXTEM2.GT.63)GOTO8000 IC=CHAR(IXTEM2) GOTO9000 C C ***************************** C ** STEP 80-- ** C ** IF AN ERROR EXISTS, ** C ** WRITE AN ERROR MESSAGE ** C ***************************** C 8000 CONTINUE C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8011) 8011 FORMAT('***** ERROR IN DPCONA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8012) 8012 FORMAT(' ILLEGAL NUMERIC INPUT ARGUMENT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8013) 8013 FORMAT(' FOR CHAR(.) FUNCTION') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8014)IXTEM2 8014 FORMAT(' THE ARGUMENT IXTEM2 = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8015)IX,IXTEMP 8015 FORMAT('IX,IXTEMP = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8016)IHOST1 8016 FORMAT('IHOST1 = ',A4) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGCO.EQ.'OFF'.AND.ISUBRO.NE.'CONA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCONA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGCO,ISUBRO,IERROR 9012 FORMAT('IBUGCO,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IHOST1 9013 FORMAT('IHOST1 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IX,IXTEMP,IXTEM2,IC 9014 FORMAT('IX,IXTEMP,IXTEM2,IC = ',3I8,2X,A1) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCOPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2, 1IANGLU,MAXNPP, 1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR) C C PURPOSE--FORM A CONTOUR PLOT. C C EXAMPLE--CONTOUR PLOT Z X Y Z0 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--87/5 C ORIGINAL VERSION--MAY 1987. C UPDATED --JANUARY 1989. MORE CHANGES TO STANDARD FORTRAN 77-- C BYTE TO CHARACTER*1, C UPDATED --JULY 1989. CORRECT BACKWARDS PLOT C UPDATED --JUNE 1990. TEMPORARY ARRAYS TO GARBAGE COMMON C UPDATED --JULY 1990. COLR ARRAY MADE INTEGER C UPDATED --APRIL 1992. DEFINE MINN2 C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASPL CHARACTER*4 IAND1 CHARACTER*4 IAND2 CHARACTER*4 IANGLU CHARACTER*4 IBUGG2 CHARACTER*4 IBUGG3 CHARACTER*4 IBUGQ CHARACTER*4 ISUBRO CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 IHRI11 CHARACTER*4 IHRI12 CHARACTER*4 IHRI21 CHARACTER*4 IHRI22 CHARACTER*4 IHRI31 CHARACTER*4 IHRI32 CHARACTER*4 IHRI41 CHARACTER*4 IHRI42 C CHARACTER*4 ICASEQ CHARACTER*4 ICTAR1 CHARACTER*4 ICTAR2 C CHARACTER*4 IWRITE C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOCP.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' C C--------------------------------------------------------------------- C CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990 INTEGER COLR C C JANUARY, 1989: MAKE BOX A CHARACTER VARIABLE CCCCC BYTE BOX JANUARY 1989 CHARACTER*1 BOX C DIMENSION ZMAT(MAXIMX,MAXJMX) CCCCC DIMENSION X(MAXIMX) CCCCC DIMENSION Y(MAXJMX) CCCCC DIMENSION CNV(MAXNCN) DIMENSION BOX(4,MAXIMX,MAXJMX) DIMENSION WLN(MAXNCN) DIMENSION IDSH(MAXNCN) DIMENSION COLR(MAXNCN+1) DIMENSION LBL(MAXNCN) C DIMENSION Y1(MAXOBV) DIMENSION Y2(MAXOBV) DIMENSION Y3(MAXOBV) DIMENSION Y4(MAXOBV) DIMENSION XD(MAXOBV) DIMENSION YD(MAXOBV) CCCCC FOLLOWING LINES ADDED JUNE, 1990 INCLUDE 'DPCOZZ.INC' EQUIVALENCE (GARBAG(IGARB1),Y1(1)) EQUIVALENCE (GARBAG(IGARB2),Y2(1)) EQUIVALENCE (GARBAG(IGARB3),Y3(1)) EQUIVALENCE (GARBAG(IGARB4),Y4(1)) EQUIVALENCE (GARBAG(IGARB5),XD(1)) EQUIVALENCE (GARBAG(IGARB6),YD(1)) CCCCC END CHANGE C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPCO' ISUBN2='PL ' C IFOUND='NO' IERROR='NO' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'COPL')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCOPL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)NPLOTV,NPLOTP,NS 52 FORMAT('NPLOTV,NPLOTP,NS = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)ICASPL,IAND1,IAND2 53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IANGLU,IBUGG2,IBUGG3,IBUGQ 54 FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGQ = ', 1A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)ICASPL,MAXN 56 FORMAT('ICASPL,MAXN = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,57)IFOUND,IERROR 57 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,58)MAXNPP 58 FORMAT('MAXNPP = ',I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C *********************************** C ** TREAT THE CONTOUR PLOT CASE ** C *********************************** C IFOUND='YES' ICASPL='CONT' C C ******************************************************* C ** STEP 12-- ** C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. ** C ******************************************************* C ISTEPN='12' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C MINNA=4 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C C ******************************************** C ** STEP 14-- ** C ** DEFINE THE NUMBER OF VARIABLES ** C ** ON THE RIGHT--IT SHOULD BE 4 ** C ******************************************** C ISTEPN='14' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMVAR=4 C C **************************************************************** C ** STEP 15-- * C ** EXAMINE THE RIGHT-HAND SIDE-- * C ** HAS EACH VARIABLE ON THE RIGHT * C ** ALREADY BEEN DEFINED? * C ** NOTE THAT ILISR1, ILISR2, ILISR3, ILISR4 * C ** IS THE LINE IN THE TABLE * C ** OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, * C ** RESPECTIVELY. * C ** NOTE THAT ICOLR1, ICOLR2, ICOLR3, ICOLR4 * C ** IS THE DATA COLUMN (1 TO 10+6) * C ** OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, * C ** RESPECTIVELY. * C **************************************************************** C ISTEPN='15' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICTAR1='FIRS' ICTAR2='T ' ILOCR1=2 IHRI11=IHARG(ILOCR1) IHRI12=IHARG2(ILOCR1) DO1510I=1,NUMNAM I2=I IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO1519 IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO1560 1510 CONTINUE GOTO1570 1519 CONTINUE ILISR1=I2 ICOLR1=IVALUE(ILISR1) NIRIG1=IN(ILISR1) C ICTAR1='SECO' ICTAR2='ND ' ILOCR2=3 IHRI21=IHARG(ILOCR2) IHRI22=IHARG2(ILOCR2) DO1520I=1,NUMNAM I2=I IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO1529 IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO1560 1520 CONTINUE GOTO1570 1529 CONTINUE ILISR2=I2 ICOLR2=IVALUE(ILISR2) NIRIG2=IN(ILISR2) C ICTAR1='THIR' ICTAR2='D ' ILOCR3=4 IHRI31=IHARG(ILOCR3) IHRI32=IHARG2(ILOCR3) DO1530I=1,NUMNAM I2=I IF(IHRI31.EQ.IHNAME(I).AND.IHRI32.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO1539 IF(IHRI31.EQ.IHNAME(I).AND.IHRI32.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO1560 1530 CONTINUE GOTO1570 1539 CONTINUE ILISR3=I2 ICOLR3=IVALUE(ILISR3) NIRIG3=IN(ILISR3) C ICTAR1='FOUR' ICTAR2='TH ' ILOCR4=5 IHRI41=IHARG(ILOCR4) IHRI42=IHARG2(ILOCR4) DO1540I=1,NUMNAM I2=I IF(IHRI41.EQ.IHNAME(I).AND.IHRI42.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO1549 IF(IHRI41.EQ.IHNAME(I).AND.IHRI42.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO1560 1540 CONTINUE GOTO1570 1549 CONTINUE ILISR4=I2 ICOLR4=IVALUE(ILISR4) NIRIG4=IN(ILISR4) GOTO1590 C 1560 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1561) 1561 FORMAT('***** ERROR IN DPCOPL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1562)ICTAR1,ICTAR2 1562 FORMAT(' THE SPECIFIED ',A4,A4,' ARGUMENT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1565) 1565 FORMAT(' WAS FOUND IN THE INTERNAL NAME LIST,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1566) 1566 FORMAT(' BUT AS A PARAMETER,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1567) 1567 FORMAT(' AND NOT AS A VARIABLE AS IT SHOULD BE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1568) 1568 FORMAT(' THE COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1569)(IANS(I),I=1,IWIDTH) 1569 FORMAT(80A1) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1570 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1571) 1571 FORMAT('***** ERROR IN DPCOPL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1572)ICTAR1,ICTAR2 1572 FORMAT(' THE SPECIFIED ',A4,A4,' ARGUMENT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1575) 1575 FORMAT(' WAS NOT FOUND IN THE INTERNAL NAME LIST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1576) 1576 FORMAT(' OF AVAILABLE VARIABLE NAMES.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IF(ICTAR1.EQ.'FIRS')WRITE(ICOUT,1577)IHRI11,IHRI12 IF(ICTAR1.EQ.'FIRS')CALL DPWRST('XXX','BUG ') IF(ICTAR1.EQ.'SECO')WRITE(ICOUT,1577)IHRI21,IHRI22 IF(ICTAR1.EQ.'SECO')CALL DPWRST('XXX','BUG ') IF(ICTAR1.EQ.'THIR')WRITE(ICOUT,1577)IHRI31,IHRI32 IF(ICTAR1.EQ.'THIR')CALL DPWRST('XXX','BUG ') IF(ICTAR1.EQ.'FOUR')WRITE(ICOUT,1577)IHRI41,IHRI42 1577 FORMAT(' THE VARIABLE IN QUESTION WAS ',A4,A4) IF(ICTAR1.EQ.'FOUR')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1578) 1578 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,IWIDTH) 1579 FORMAT(80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1590 CONTINUE C C ****************************************************** C ** STEP 22-- ** C ** CHECK THAT VARIABLES 1 AND 2 AND 3 HAVE ** C ** THE SAME NUMBER OF ELEMENTS. ** C ****************************************************** C 2100 CONTINUE ISTEPN='21' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NIRIG1.EQ.NIRIG2.AND.NIRIG2.EQ.NIRIG3)GOTO2190 C 2110 CONTINUE WRITE(ICOUT,2111) 2111 FORMAT('***** ERROR IN DPCOPL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2113) 2113 FORMAT(' THE NUMBER OF OBSERVATIONS IN VARIABLES ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2114) 2114 FORMAT(' 1, 2, AND 3 MUST BE THE SAME;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2115) 2115 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1 2116 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2 2117 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2118)IHRI31,IHRI32,NIRIG3 2118 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2120) 2120 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,2121)(IANS(I),I=1,IWIDTH) 2121 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 2190 CONTINUE C C ****************************************************** C ** STEP 22-- ** C ** CHECK THAT VARIABLE 4 HAS ** C ** AT LEAST ONE ELEMENT. ** C ****************************************************** C 2200 CONTINUE ISTEPN='22' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NIRIG4.GE.1)GOTO2290 C 2210 CONTINUE WRITE(ICOUT,2211) 2211 FORMAT('***** ERROR IN DPCOPL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2213) 2213 FORMAT(' THE NUMBER OF OBSERVATIONS IN VARIABLE 4 ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2214) 2214 FORMAT(' MUST BE AT LEAST 1;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2215) 2215 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2216)IHRI41,IHRI42,NIRIG4 2216 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2220) 2220 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,2221)(IANS(I),I=1,IWIDTH) 2221 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 2290 CONTINUE C C ***************************************** C ** STEP 31-- ** C ** CHECK TO SEE THE TYPE CASE-- ** C ** 1) UNQUALIFIED (THAT IS, FULL); ** C ** 2) SUBSET/EXCEPT; OR ** C ** 3) FOR. ** C ***************************************** C ISTEPN='31' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASEQ='FULL' ILOCQ=NUMARG+1 IF(NUMARG.LT.1)GOTO3190 DO3100J=1,NUMARG J1=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ') GOTO3110 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ') GOTO3110 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ') GOTO3120 3100 CONTINUE GOTO3190 3110 CONTINUE ICASEQ='SUBS' ILOCQ=J1 GOTO3190 3120 CONTINUE ICASEQ='FOR' ILOCQ=J1 GOTO3190 3190 CONTINUE IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'COPL')GOTO3195 WRITE(ICOUT,3191)NUMARG,ILOCQ 3191 FORMAT('NUMARG,ILOCQ = ',2I8) CALL DPWRST('XXX','BUG ') 3195 CONTINUE C C ********************************************* C ** STEP 32-- ** C ** FORM THE VECTOR ISUB(.) ** C ** DEPENDING ON THE TYPE OF CASE ** C ** FOR THE QUALIFIER. ** C ** BRANCH TO THE PROPER CASE. ** C ********************************************* C ISTEPN='32' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NLOCAL=NIRIG1 C IF(ICASEQ.EQ.'FULL')GOTO3210 IF(ICASEQ.EQ.'SUBS')GOTO3220 IF(ICASEQ.EQ.'FOR')GOTO3230 C 3210 CONTINUE DO3215I=1,NLOCAL ISUB(I)=1 3215 CONTINUE NQ=NLOCAL GOTO3250 C 3220 CONTINUE NIOLD=NLOCAL CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR) NQ=NIOLD GOTO3250 C 3230 CONTINUE NIOLD=NLOCAL CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERROR) NQ=NFOR GOTO3250 C 3250 CONTINUE CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1992 MINN2=4 IF(NQ.GE.MINN2)GOTO3290 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3251) 3251 FORMAT('***** ERROR IN DPCOPL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3252) 3252 FORMAT(' AFTER THE APPROPRIATE SUBSET HAS BEEN ', 1'EXTRACTED,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3253)IHRI11,IHRI12 3253 FORMAT(' THE NUMBER OF OBSERVATIONS REMAINING', 1'FROM VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3254) 3254 FORMAT(' (FOR WHICH AN CONTOUR PLOT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3255) 3255 FORMAT(' IS TO BE FORMED)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3256)MINN2 3256 FORMAT(' MUST BE ',I8,' OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3257)NQ 3257 FORMAT(' SUCH WAS NOT THE CASE HERE (NQ = ',I8,')') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3258) 3258 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,3259)(IANS(I),I=1,IWIDTH) 3259 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 3290 CONTINUE C C ********************************************** C ** STEP 33-- ** C ** FORM THE SUBSETTED VARIABLES ** C ** Y1(.) ** C ** Y2(.) ** C ** Y3(.) ** C ** CONTAINING ** C ** THE RESPONSE Z VARIABLE ** C ** THE HORIZONTAL AXIS VARIABLE ** C ** THE VERTICAL AXIS VARIABLE ** C ** RESPECTIVELY. ** C ********************************************** C ISTEPN='33' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C J=0 IMAX=NIRIG1 IF(NQ.LT.NIRIG1)IMAX=NQ DO3300I=1,IMAX IF(ISUB(I).EQ.0)GOTO3390 J=J+1 C IJ=MAXN*(ICOLR1-1)+I IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ) IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I) IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I) IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I) IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I) IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I) IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I) C IJ=MAXN*(ICOLR2-1)+I IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ) IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I) IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I) IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I) IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I) IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I) IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I) C IJ=MAXN*(ICOLR3-1)+I IF(ICOLR3.LE.MAXCOL)Y3(J)=V(IJ) IF(ICOLR3.EQ.MAXCP1)Y3(J)=PRED(I) IF(ICOLR3.EQ.MAXCP2)Y3(J)=RES(I) IF(ICOLR3.EQ.MAXCP3)Y3(J)=YPLOT(I) IF(ICOLR3.EQ.MAXCP4)Y3(J)=XPLOT(I) IF(ICOLR3.EQ.MAXCP5)Y3(J)=X2PLOT(I) IF(ICOLR3.EQ.MAXCP6)Y3(J)=TAGPLO(I) C 3300 CONTINUE C 3390 CONTINUE NS=J C C ********************************************** C ** STEP 34-- ** C ** FORM THE FULL VARIABLE ** C ** Y4(.) ** C ** CONTAINING THE VALUES ** C ** OF THE RESPONSE VARIABLE ** C ** WHERE IT IS DESIRED THAT ** C ** CONTOUR CURVES BE DETERMINED. ** C ********************************************** C ISTEPN='34' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C J=0 IMAX=NIRIG4 DO3400I=1,IMAX J=J+1 IJ=MAXN*(ICOLR4-1)+I Y4(I)=V(IJ) 3400 CONTINUE N4=J C C **************************************************************** C ** STEP 41-- * C ** FORM THE VERTICAL AND HORIZONTAL AXIS * C ** VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT. * C ** FORM THE CURVE DESIGNATION VARIABLE D(.) . * C ** THIS WILL BE BOTH ONES FOR BOTH CASES * C ** DEFINE THE NUMBER OF PLOT POINTS (NPLOTP). * C ** DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV). * C **************************************************************** C ISTEPN='41' IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COPL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC CALL DPCOP2(Y1,Y2,Y3,NS,Y4,N4,ICASPL,MAXN, CCCCC1XD,YD,ZMAT, CCCCC1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR) C IWRITE='OFF' CALL DISTIN(Y2,NS,IWRITE,XD,NXD,IBUGG3,IERROR) CALL DISTIN(Y3,NS,IWRITE,YD,NYD,IBUGG3,IERROR) C K=0 CCCCC THE FOLLOWING 2 LINES WERE FIXED JULY 1989 CCCCC TO FIX BACKWARDS AXES PROBLEM JULY 1989 CCCCC DO4100I=1,NXD CCCCC DO4200J=1,NYD DO4100J=1,NYD DO4200I=1,NXD K=K+1 ZMAT(I,J)=Y1(K) 4200 CONTINUE 4100 CONTINUE C XMN=0.0 YMN=0.0 C XSCL=1.0 YSCL=1.0 C DO4300I=1,MAXNCN WLN(I)=1.0 IDSH(I)=0 COLR(I)=1 LBL(I)=1 4300 CONTINUE C C LDEC=2 SZL=10.0 DLMM=1.0 C CALL DPCOP2(ZMAT,XD,YD,NXD,NYD,Y4,N4, 1BOX, 1XMN,YMN,XSCL,YSCL, 1WLN,IDSH,COLR,LBL, 1LDEC,SZL,DLMM, 1Y,X,D,NPLOTP,NPLOTV, 1IBUGG3,ISUBRO,IERROR) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'COPL')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCOPL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IFOUND,IERROR 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ', 1I8,I8,I8,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ICASPL,MAXN 9014 FORMAT('ICASPL,MAXN = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)NIRIG1,NIRIG2,NIRIG3,NIRIG4 9015 FORMAT('NIRIG1,NIRIG2,NIRIG3,NIRIG4 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)NLOCAL,NQ,MINN2 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8) CALL DPWRST('XXX','BUG ') IF(NPLOTP.LE.0)GOTO9090 DO9020I=1,NPLOTP WRITE(ICOUT,9021)I,Y(I),X(I),D(I) 9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5) CALL DPWRST('XXX','BUG ') 9020 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPCOP2(A,X,Y,IMX,JMX,CNV,NCNN, 1BOX, 1XMN,YMN,XSCL,YSCL, 1WLN,IDSH,COLR,LBL, 1LDEC,SZL,DLMM, 1YTEMP,XTEMP,TATEMP,NTEMP,NTRACE, 1IBUGG3,ISUBRO,IERROR) C C PURPOSE--GENERATE A CONTOUR PLOT C C WRITTEN BY--DAVID W. BEHRINGER NOAA/AOML (MIAMI). C AS PART OF NOAA'S CONCX V.3 MARCH 1988. C ORIGINAL VERSION (IN DATAPLOT)--AUGUST 1988. C C NOTE--CALLING SEQUENCE-- C DPCOPL C DPCOP2 (= CONCX) C BNDRY. C START1(2). C START2. C START3. C START4. C CHASE(5). C INOUT. C SIDEDI(8). C DRWFIL C PLYSRT C STRSWP(6). C SIDEDI(2). C INOUT(3). C CONINSRT(3) C STRSWP(3). C RSURF... C GWICOL... C DRAW0 C GDASH... C GVECT... C DRAWL C GCHARJ(2)... C GCHAR(2)... C GCHARA... C DRAW0(6) C GDASH... C GVECT... C C NOTE--RECOMMENDED DIMENSIONS-- C A(IMX,JMX) C X(IMX) C Y(JMX) C XC(NMX,3) C YC(NMX,3) C DST(NDX) C IB(NMX) C JB(NMX) C NEES(2,NSGX,3) C CNV(NCNN) C LBL(NCNN) C WLN(NCNN) C IDSH(NCNN) C BOX(4,IMX,JMX) C C ORIGINAL VERSION (IN DATAPLOT)--AUGUST 1988. C MODIFICATIONS INCLUDE-- C NO TABS C NO LOWER CASE C NO UNDERSCORES C NO ENTRY POINTS C NO LONG NAMES C REMOVE UNDERLYING GRAPHICS "SET" SUBROUT.-- C GWICOL, GDASH, GCHARJ, GCHARA C INSERT BUG AND TRACE SWITCHES C MULTI-RETURNS TO ONE RETURN? C SPLIT DIMENSIONS--ONE PER LINE C CHAR/INT BEFORE DIMENSION STATEMENTS C SPLIT INTEGER DECLARATIONS AND DIMENSIONS C NO CARRYING DIMENSIONS VIA ARGUMENTS C C UPDATED --JANUARY 1989. MORE CHANGES TO STANDARD FORTRAN 77-- C VAX BYTE TO CHARACTER*1, C DO WHILE/END DO (ALAN HECKERT). C UPDATED --JULY 1990. 999.999 TO ANINE C UPDATED --JULY 1990. REWRITE IF/THEN/ELSE DUE TO C IBM-PC COMPILER ERROR C UPDATED --JULY 1990. REWRITE IF/THEN/ELSE DUE TO C I & J = 0 C UPDATED --JULY 1990. PRMTR DEF. WITH I & J = 0 C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOCP.INC' C C--------------------------------------------------------------------- C CCCCC PARAMETER NMX=9000,NSGX=100,NDX=MAX0(NMX,6*NSGX) AUGUST 1988 CCCCC INTEGER NPTS(NSGX,3),SNSE(NSGX,3),CLSD(NSGX,3),NSEG(3), CCCCC1 COLR(NCNN+1) CCCCC BYTE BOX(4,IMX,JMX) JANUARY 1989 CCCCC DIMENSION A(IMX,JMX),X(IMX),Y(JMX) CCCCC DIMENSION XC(NMX,3),YC(NMX,3),DST(NDX),IB(NMX),JB(NMX), CCCCC1 NEES(2,NSGX,3),CNV(NCNN),LBL(NCNN),WLN(NCNN),IDSH(NCNN) C INTEGER NPTS INTEGER SNSE INTEGER CLSD INTEGER NSEG INTEGER COLR C CCCCC BYTE BOX JANUARY 1989 CHARACTER*1 BOX C CHARACTER*4 IBUGG3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C DIMENSION NPTS(MAXNSG,3) DIMENSION SNSE(MAXNSG,3) DIMENSION CLSD(MAXNSG,3) DIMENSION NSEG(3) DIMENSION COLR(MAXNCN+1) C DIMENSION A(MAXIMX,MAXJMX) DIMENSION X(MAXIMX) DIMENSION Y(MAXJMX) DIMENSION XC(MAXNMX,3) DIMENSION YC(MAXNMX,3) DIMENSION DST(MAXNDX) DIMENSION IB(MAXNMX) DIMENSION JB(MAXNMX) DIMENSION NEES(2,MAXNSG,3) DIMENSION CNV(MAXNCN) DIMENSION LBL(MAXNCN) DIMENSION WLN(MAXNCN) DIMENSION IDSH(MAXNCN) C DIMENSION BOX(4,MAXIMX,MAXJMX) C DIMENSION XTEMP(*) DIMENSION YTEMP(*) DIMENSION TATEMP(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C NTEMP=0 NTRACE=0 C IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP2')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCOP2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG3,ISUBRO 52 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IMX,JMX,NCNN 53 FORMAT('IMX,JMX,NCNN = ',3I8) CALL DPWRST('XXX','BUG ') DO55I=1,IMX WRITE(ICOUT,56)I,X(I) 56 FORMAT('I,X(I) = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 55 CONTINUE DO60I=1,JMX WRITE(ICOUT,61)I,Y(I) 61 FORMAT('I,Y(I) = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 60 CONTINUE DO65I=1,IMX DO66J=1,JMX WRITE(ICOUT,67)I,J,A(I,J) 67 FORMAT('I,J,A(I,J) = ',I8,I8,E15.7) CALL DPWRST('XXX','BUG ') 66 CONTINUE 65 CONTINUE DO70I=1,NCNN WRITE(ICOUT,71)I,CNV(I) 71 FORMAT('I,CNV(I) = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 70 CONTINUE 90 CONTINUE C C ADJUST CONTOUR LIMITS TO AVOID LATER ATTEMPTS TO USE NONEXISTENT CONTOURS C EXCLUDE NON-CONTOURABLE PARTS OF THE FIELD FROM THE SEARCH FOR AMIN/AMAX C CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990 CCCCC AND ALL SUBSEQUENT OCCURRANCES OF HARD-CODED 999.999'S JULY 1990 CCCCC WERE CHANGE TO SOFT-CODED ANINE JULY 1990 ANINE=999.999 C CCCCC THE FOLLOWING 2 LINES WERE CHANGED JULY 1990 CCCCC AMIN=999.999 CCCCC AMAX=999.999 AMIN=ANINE AMAX=ANINE C CCCCC THE FOLLOWING SECTION WAS REPLACED JULY 1990 CCCCC DUE TO A IBM-PC COMPILER ERROR JULY 1990 CCCCC DO1000J=1,JMX CCCCC DO1010I=1,IMX CCCCC THE FOLLOWING 5 LINES WERE CHANGED JULY 1990 CCCCC IF (A(I,J).NE.999.999.AND. CCCCC1 ((I.GT.1.AND.A(I-1,J).NE.999.999).OR. CCCCC2 (I.LT.IMX.AND.A(I+1,J).NE.999.999)).AND. CCCCC3 ((J.GT.1.AND.A(I,J-1).NE.999.999).OR. CCCCC4 (J.LT.JMX.AND.A(I,J+1).NE.999.999))) THEN CCCCC IF (A(I,J).NE.ANINE.AND. CCCCC1 ((I.GT.1.AND.A(I-1,J).NE.ANINE).OR. CCCCC2 (I.LT.IMX.AND.A(I+1,J).NE.ANINE)).AND. CCCCC3 ((J.GT.1.AND.A(I,J-1).NE.ANINE).OR. CCCCC4 (J.LT.JMX.AND.A(I,J+1).NE.ANINE))) THEN CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1990 CCCCC IF (AMIN.NE.999.999) THEN CCCCC IF (AMIN.NE.ANINE) THEN CCCCC AMIN=AMIN1(AMIN,A(I,J)) CCCCC ELSE CCCCC AMIN=A(I,J) CCCCC END IF CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1990 CCCCC IF (AMAX.NE.999.999) THEN CCCCC IF (AMAX.NE.ANINE) THEN CCCCC AMAX=AMAX1(AMAX,A(I,J)) CCCCC ELSE CCCCC AMAX=A(I,J) CCCCC END IF CCCCC END IF C1010 CONTINUE C1000 CONTINUE C CCCCC THE FOLLOWING SECTION REPLACES THE ABOVE SECTION JULY 1990 DO1000J=1,JMX DO1010I=1,IMX AM0=ANINE A0M=ANINE A00=ANINE A0P=ANINE AP0=ANINE IF(I.GT.1.AND.J.GT.0)AM0=A(I-1,J) IF(I.GT.0.AND.J.GT.1)A0M=A(I,J-1) IF(I.GT.0.AND.J.GT.0)A00=A(I,J) IF(I.GT.0.AND.J.LT.JMX)A0P=A(I,J+1) IF(I.LT.IMX.AND.J.GT.0)AP0=A(I+1,J) IF (A00.NE.ANINE.AND. 1 ((AM0.NE.ANINE).OR. 2 (AP0.NE.ANINE)).AND. 3 ((A0M.NE.ANINE).OR. 4 (A0P.NE.ANINE))) THEN C IF (AMIN.NE.ANINE) THEN AMIN=AMIN1(AMIN,A(I,J)) ELSE AMIN=A(I,J) END IF C IF (AMAX.NE.ANINE) THEN AMAX=AMAX1(AMAX,A(I,J)) ELSE AMAX=A(I,J) END IF C END IF 1010 CONTINUE 1000 CONTINUE C C WRITE(9,'('' AMIN/AMAX: '',2F10.3)') AMIN,AMAX N=1 1100 CONTINUE IF(CNV(N).GE.AMIN)GOTO1199 CCCCC DO WHILE (CNV(N).LT.AMIN) JANUARY 1989 N=N+1 IF (N.GT.NCNN) GOTO9000 CCCCC END DO JANUARY 1989 GOTO1100 1199 CONTINUE NCOFF=N N=NCNN CCCCC DO WHILE (CNV(N).GT.AMAX) JANUARY 1989 1200 CONTINUE IF(CNV(N).LE.AMAX)GOTO1299 N=N-1 IF (N.LT.1) GOTO9000 CCCCC END DO JANUARY 1989 GOTO1200 1299 CONTINUE NCN=N+1-NCOFF C CONVERT X & Y FROM USER UNITS TO DEVICE UNITS (MM OR WHATEVER) DO1300I=1,IMX X(I)=(X(I)-XMN)*XSCL 1300 CONTINUE DO1310J=1,JMX Y(J)=(Y(J)-YMN)*YSCL 1310 CONTINUE C SET UP IB, JB & BOX ARRAYS TO CONTROL CONTOURING NEAR BOUNDARIES C DATA VOIDS CONNECTED TO PERIMETER ARE ALLOWED, BUT NO ISOLATED VOIDS C CALL BNDRY(A,BOX,IMX,JMX,IB,JB,NBX) NBM=NBX-1 C WRITE(9,'('' A'')') C CALL PRTMTX(9,A,IMX,JMX,1) C WRITE(9,'('' BOUNDARY: '',I6)') NBX C DO NB=1,NBX C I=IB(NB) C J=JB(NB) C WRITE(9,'(1X,I5,5X,2I5,5X,2F9.2)') NB,I,J,X(I),Y(J) CCCCC END DO JANUARY 1989 C C SET UP PRMTR I=IB(1) J=JB(1) PRMTR=0. DO1400NB=2,NBX IM=I JM=J I=IB(NB) J=JB(NB) IF (I.EQ.IM) THEN CCCCC THE FOLLOWING LINE WAS REPLACED BY SUBSEQUENT 2 LINES JULY 1990 CCCCC PRMTR=PRMTR+ABS(Y(J)-Y(JM)) IF(J.GE.1.AND.J.LE.JMX.AND.JM.GE.1.AND.JM.LE.JMX) 1 PRMTR=PRMTR+ABS(Y(J)-Y(JM)) ELSE CCCCC THE FOLLOWING LINE WAS REPLACED BY SUBSEQUENT 2 LINES JULY 1990 CCCCC PRMTR=PRMTR+ABS(X(I)-X(IM)) IF(I.GE.1.AND.I.LE.IMX.AND.IM.GE.1.AND.IM.LE.IMX) 1 PRMTR=PRMTR+ABS(X(I)-X(IM)) END IF 1400 CONTINUE C BEGIN MAIN LOOP -> SEARCH FOR STARTING POINTS OF CONTOURS DO1500NC=0,NCN NCC=NC+NCOFF IF (NC.LT.NCN) THEN CN=CNV(NCC) C RESET 'BOX' WHICH DOES BOOKEEPING FOR CONTOUR-CHASES DO1510J=1,JMX DO1520I=1,IMX DO1530L=1,4 IF (BOX(L,I,J).EQ.'1') BOX(L,I,J)='0' IF (BOX(L,I,J).EQ.'3') BOX(L,I,J)='2' 1530 CONTINUE 1520 CONTINUE 1510 CONTINUE NSG=0 NP=1 N=1 C SEARCH PERIMETER OF AREA FOR CONTOUR-STARTS DO1540NB=1,NBM IF (IB(NB).EQ.IB(NB+1)) THEN I=IB(NB) IF (JB(NB).LT.JB(NB+1)) THEN JS=JB(NB) JE=JB(NB+1)-1 DO1550J=JS,JE IF (BOX(1,I,J).EQ.'2') THEN NS=1 CALL START1(A(I,J),X(I),Y(J), 1 IMX,NS,CN,XC(NP,2),YC(NP,2)) IF (NS.GT.0) THEN C -> CONTOUR-START FOUND, BEGIN CHASE II=I JJ=J CALL CHASE(A,X,Y,IMX,JMX,II,JJ, 1 NS,CN,XC(NP,2),YC(NP,2),NMX,N,BOX) IF (N.GT.1) THEN NSG=NSG+1 NPTS(NSG,2)=N IF (A(I,J).LT.A(I,J+1)) THEN SNSE(NSG,2)=1 ELSE SNSE(NSG,2)=-1 END IF CLSD(NSG,2)=0 C WRITE(9,'('' CN='',F7.2,'' SNSE='',I3)') CN,SNSE(NSG,2) C CALL SIDEDI(XC(NP,2),YC(NP,2),NSS,DDD,IB,JB,X,Y) C WRITE(9,'('' 1'',2F10.3,I6)')XC(NP,2),YC(NP,2),NSS C CALL SIDEDI(XC(NP+N-1,2),YC(NP+N-1,2),NSS,DDD,IB,JB,X,Y) C WRITE(9,'('' 1'',2F10.3,I6)')XC(NP+N-1,2),YC(NP+N-1,2),NSS C CALL PRT_STR(9,XC(NP,2),YC(NP,2),1,N) NP=NP+N N=1 END IF END IF END IF 1550 CONTINUE ELSE JS=JB(NB)-1 JE=JB(NB+1) DO1560J=JS,JE,-1 IF (BOX(3,I-1,J).EQ.'2') THEN NS=3 CALL START3(A(I,J),X(I),Y(J), 1 IMX,NS,CN,XC(NP,2),YC(NP,2)) IF (NS.GT.0) THEN C -> CONTOUR-START FOUND, BEGIN CHASE II=I-1 JJ=J CALL CHASE(A,X,Y,IMX,JMX,II,JJ, 1 NS,CN,XC(NP,2),YC(NP,2),NMX,N,BOX) IF (N.GT.1) THEN NSG=NSG+1 NPTS(NSG,2)=N IF (A(I,J+1).LT.A(I,J)) THEN SNSE(NSG,2)=1 ELSE SNSE(NSG,2)=-1 END IF CLSD(NSG,2)=0 C WRITE(9,'('' CN='',F7.2,'' SNSE='',I3)') CN,SNSE(NSG,2) C CALL SIDEDI(XC(NP,2),YC(NP,2),NSS,DDD,IB,JB,X,Y) C WRITE(9,'('' 3'',2F10.3,I6)')XC(NP,2),YC(NP,2),NSS C CALL SIDEDI(XC(NP+N-1,2),YC(NP+N-1,2),NSS,DDD,IB,JB,X,Y) C WRITE(9,'('' 3'',2F10.3,I6)')XC(NP+N-1,2),YC(NP+N-1,2),NSS C CALL PRT_STR(9,XC(NP,2),YC(NP,2),1,N) NP=NP+N N=1 END IF END IF END IF 1560 CONTINUE END IF ELSE J=JB(NB) IF(IB(NB).LT.IB(NB+1)) THEN IS=IB(NB) IE=IB(NB+1)-1 DO1570I=IS,IE IF (BOX(2,I,J-1).EQ.'2') THEN NS=2 CALL START2(A(I,J),X(I),Y(J), 1 IMX,NS,CN,XC(NP,2),YC(NP,2)) IF (NS.GT.0) THEN C -> CONTOUR-START FOUND, BEGIN CHASE II=I JJ=J-1 CALL CHASE(A,X,Y,IMX,JMX,II,JJ, 1 NS,CN,XC(NP,2),YC(NP,2),NMX,N,BOX) IF (N.GT.1) THEN NSG=NSG+1 NPTS(NSG,2)=N IF (A(I,J).LT.A(I+1,J)) THEN SNSE(NSG,2)=1 ELSE SNSE(NSG,2)=-1 END IF CLSD(NSG,2)=0 C WRITE(9,'('' CN='',F7.2,'' SNSE='',I3)') CN,SNSE(NSG,2) C CALL SIDEDI(XC(NP,2),YC(NP,2),NSS,DDD,IB,JB,X,Y) C WRITE(9,'('' 2'',2F10.3,I6)')XC(NP,2),YC(NP,2),NSS C CALL SIDEDI(XC(NP+N-1,2),YC(NP+N-1,2),NSS,DDD,IB,JB,X,Y) C WRITE(9,'('' 2'',2F10.3,I6)')XC(NP+N-1,2),YC(NP+N-1,2),NSS C CALL PRT_STR(9,XC(NP,2),YC(NP,2),1,N) NP=NP+N N=1 END IF END IF END IF 1570 CONTINUE ELSE IS=IB(NB)-1 IE=IB(NB+1) DO1580I=IS,IE,-1 IF (BOX(4,I,J).EQ.'2') THEN NS=4 CALL START4(A(I,J),X(I),Y(J), 1 IMX,NS,CN,XC(NP,2),YC(NP,2)) IF (NS.GT.0) THEN C -> CONTOUR-START FOUND, BEGIN CHASE II=I JJ=J CALL CHASE(A,X,Y,IMX,JMX,II,JJ, 1 NS,CN,XC(NP,2),YC(NP,2),NMX,N,BOX) IF (N.GT.1) THEN NSG=NSG+1 NPTS(NSG,2)=N IF (A(I+1,J).LT.A(I,J)) THEN SNSE(NSG,2)=1 ELSE SNSE(NSG,2)=-1 END IF CLSD(NSG,2)=0 C WRITE(9,'('' CN='',F7.2,'' SNSE='',I3)') CN,SNSE(NSG,2) C CALL SIDEDI(XC(NP,2),YC(NP,2),NSS,DDD,IB,JB,X,Y) C WRITE(9,'('' 4'',2F10.3,I6)')XC(NP,2),YC(NP,2),NSS C CALL SIDEDI(XC(NP+N-1,2),YC(NP+N-1,2),NSS,DDD,IB,JB,X,Y) C WRITE(9,'('' 4'',2F10.3,I6)')XC(NP+N-1,2),YC(NP+N-1,2),NSS C CALL PRT_STR(9,XC(NP,2),YC(NP,2),1,N) NP=NP+N N=1 END IF END IF END IF 1580 CONTINUE END IF END IF 1540 CONTINUE C SEARCH INTERIOR FOR CONTOUR-STARTS OF CLOSED CONTOURS DO1800I=2,IMX-1 DO1810J=JMX-1,1,-1 IF (BOX(1,I,J).EQ.'0') THEN NS=1 CALL START1(A(I,J),X(I),Y(J), 1 IMX,NS,CN,XC(NP,2),YC(NP,2)) IF (NS.GT.0) THEN C -> CONTOUR-START FOUND, BEGIN CHASE II=I JJ=J CALL CHASE(A,X,Y,IMX,JMX,II,JJ, 1 NS,CN,XC(NP,2),YC(NP,2),NMX,N,BOX) IF (N.GT.1) THEN IF (A(I,J).NE.CN) THEN JIO=J ELSE JIO=J+1 END IF CALL INOUT(X(I),Y(JIO),XC(NP,2),YC(NP,2),N,IO) NSG=NSG+1 NPTS(NSG,2)=N IF (A(I,J).LT.A(I,J+1)) THEN SNSE(NSG,2)=1 ELSE SNSE(NSG,2)=-1 END IF IF (IO.EQ.1) THEN IF (A(I,JIO).GT.CN) THEN CLSD(NSG,2)=1 ELSE CLSD(NSG,2)=-1 END IF ELSE IF (A(I,JIO).LT.CN) THEN CLSD(NSG,2)=1 ELSE CLSD(NSG,2)=-1 END IF END IF C NSS=0 C WRITE(9,'('' I CN='',F7.2,'' SNSE='',I3)') CN,SNSE(NSG,2) C WRITE(9,'('' 1'',2F10.3,I6)')XC(NP,2),YC(NP,2),NSS C WRITE(9,'('' 1'',2F10.3,I6)')XC(NP+N-1,2),YC(NP+N-1,2),NSS C CALL PRT_STR(9,XC(NP,2),YC(NP,2),1,N) NP=NP+N N=1 END IF END IF END IF 1810 CONTINUE 1800 CONTINUE C END SEARCH FOR CONTOUR STARTS NSEG(2)=NSG ELSE NSEG(2)=0 END IF C DRAW CONTOURS; FILL BETWEEN THEM IF DESIRED IF (NC.EQ.0) THEN CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1990 CCCCC WLN1=999.999 WLN1=ANINE IDSH1=999 LBL1=999 CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1990 CCCCC CN1=999.999 CN1=ANINE ELSE NC1=NCC-1 WLN1=WLN(NC1) IDSH1=IDSH(NC1) LBL1=LBL(NC1) CN1=CNV(NC1) CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1990 CCCCC IF (IDSH1.LT.0) CN1=999.999 IF (IDSH1.LT.0) CN1=ANINE C WRITE(9,'('' NP='',I6)') NP END IF CALL DRWFIL(XC,YC,NMX,NSEG,NPTS,SNSE,CLSD,NSGX,X,Y,IMX,JMX, 1 IB,JB,NBX,PRMTR,NEES,DST,CN1,WLN1,IDSH1,COLR(NCC),LBL1, 2 LDEC,SZL,DLMM, 1XTEMP,YTEMP,TATEMP,NTEMP,NTRACE, 1IBUGG3,ISUBRO,IERROR) 1500 CONTINUE C MAIN LOOP COMPLETE -> RETURN TO CALLING PROGRAM AFTER C CONVERTING X & Y BACK TO USER UNITS DO1900I=1,IMX X(I)=XMN+X(I)/XSCL 1900 CONTINUE DO1910J=1,JMX Y(J)=YMN+Y(J)/YSCL 1910 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP2')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCOP2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGG3,ISUBRO 9012 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)NTEMP,NTRACE 9013 FORMAT('NTEMP,NTRACE = ',2I8) CALL DPWRST('XXX','BUG ') DO9015I=1,NTEMP WRITE(ICOUT,9016)I,YTEMP(I),XTEMP(I),TATEMP(I) 9016 FORMAT('I,YTEMP(I),XTEMP(I),TATEMP(I) = ',I8,3F10.5) CALL DPWRST('XXX','BUG ') 9015 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPCOP3(Z,NX,NY,Z0, 1X2,Y2,TAG,N,NTRACE, 1IBUGG3,ISUBRO,IERROR) C C PURPOSE--OPERATE ON THE MATRIX Z(.,.) C FOR A FIXED VALUE OF Z (Z0), C EXTRACT ALL CONTOUR LINES. C FILL THE ARRAYS Y2(.), X2(.) AND TAG(.) C ACCORDINGLY. C C NOTE--Z0 = THE TARGET Z VALUE FOR WHICH A CONTOUR LINE C IS DESIRED. C K = THE CURRENT INDEX OF THE Y2(.), X2(.), C AND TAG(.) VARIABLES. C (K IS SET TO 0 AT THE BEGINNING C OF THIS SUBROUTINE). C ITRACE = THE CURRENT TRACE BEING FORMED. C (ITRACE IS SET TO 0 AT THE BEGINNING C OF THIS SUBROUTINE). C C--------------------------------------------------------------------- C CHARACTER*4 IBUGG3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 IDONEH CHARACTER*4 IDONEV C DIMENSION Z(100,100) DIMENSION X2(*) DIMENSION Y2(*) DIMENSION TAG(*) C DIMENSION IDONEH(20,20,20) DIMENSION IDONEV(20,20,20) C DIMENSION IXSAVE(400) DIMENSION IYSAVE(400) DIMENSION KSAVE(400) C C-----COMMON VARIABLES (GENERAL)----------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP3')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCOP3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR 52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)Z0 53 FORMAT('Z0 = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)NX,NY 54 FORMAT('NX,NY = ',2I8) CALL DPWRST('XXX','BUG ') DO55IY=1,NY DO56IX=1,NX WRITE(ICOUT,57)IX,IY,Z(IX,IY) 57 FORMAT('IX,IY,Z(IX,IY) = ',2I8,E15.7) CALL DPWRST('XXX','BUG ') 56 CONTINUE 55 CONTINUE C 90 CONTINUE C NXP1=NX+1 NYP1=NY+1 C DO1110IX1=1,NX DO1120IX2=1,NX DO1130IY1=1,NY IDONEH(IX1,IX2,IY1)='NO' 1130 CONTINUE 1120 CONTINUE 1110 CONTINUE C DO1210IY1=1,NY DO1220IY2=1,NY DO1230IX1=1,NX IDONEV(IY1,IY2,IX1)='NO' 1230 CONTINUE 1220 CONTINUE 1210 CONTINUE C K=0 ITRACE=0 ISAVE=0 C NYM1=NY-1 NXM1=NX-1 C C ********************************************* C ********************************************* C ** STEP 21-- ** C ** SCAN THE MATRIX--FOR EACH ROW, ** C ** SCAN ACROSS THE COLUMNS AND ** C ** SEARCH FOR Z VALUES WHICH BRACKET THE ** C ** TARGET Z0 CONTOUR VALUE. ** C ********************************************* C ********************************************* C DO2100IY1=1,NYM1 IY2=IY1+1 AIY1=IY1 AIY2=IY2 C DO2200IX1=1,NXM1 IX2=IX1+1 AIX1=IX1 AIX2=IX2 C IF(IDONEH(IX1,IX2,IY1).EQ.'YES')GOTO2200 CCCCC WRITE(ICOUT,2201)IX1,IY1,Z(IX1,IY1) 2201 FORMAT('IX1,IY1,Z(IX1,IY1) = ',2I8,E15.7) CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,2202)IDONEH(IX1,IX2,IY1),IDONEV(IY1,IY2,IX1) 2202 FORMAT('IDONEH(IX1,IX2,IY1),IDONEV(IY1,IY2,IX1) = ',2A4) CCCCC CALL DPWRST('XXX','BUG ') IF(Z(IX1,IY1).LE.Z0.AND.Z0.LE.Z(IX2,IY1))GOTO2210 IF(Z(IX2,IY1).LE.Z0.AND.Z0.LE.Z(IX1,IY1))GOTO2210 GOTO2200 C 2210 CONTINUE ITRACE=ITRACE+1 K=K+1 ANUM=Z0-Z(IX1,IY1) ADEN=Z(IX2,IY1)-Z(IX1,IY1) P=ANUM/ADEN X2(K)=AIX1+P*(AIX2-AIX1) Y2(K)=IY1 TAG(K)=ITRACE IDONEH(IX1,IX2,IY1)='YES' C C ******************************************** C ******************************************** C ** STEP 22-- ** C ** A HIT HAS BEEN FOUND. ** C ** THEREFORE, FOLLOW THE TRACE THROUGH ** C ** THE MATRIX UNTIL THE TRACE FINISHES. ** C ******************************************** C ******************************************** C ISAVE=ISAVE+1 IXSAVE(ISAVE)=IX1 IYSAVE(ISAVE)=IY1 KSAVE(ISAVE)=K WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,2355)ISAVE,IXSAVE(ISAVE),IYSAVE(ISAVE),KSAVE(ISAVE) C2355 FORMAT('ISAVE,IXSAVE(ISAVE),IYSAVE(ISAVE),KSAVE(ISAVE)= ',4I8) CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,2356)X2(K),Y2(K) C2356 FORMAT('X2(K),Y2(K) = ',2E15.7) CCCCC CALL DPWRST('XXX','BUG ') C IX3=IX1 IY3=IY2 ISIDE1=2 DO2300I=1,10000 IF(IY3.LE.1)GOTO2370 IF(IY3.GE.NYP1)GOTO2370 IF(IX3.LE.0)GOTO2370 IF(IX3.GE.NX)GOTO2370 CALL DPCOP4(IX3,IY3,ISIDE1,ITRACE,Z0, 1Z,IDONEH,IDONEV, 1X2,Y2,TAG,K,ISIDE2, 1IBUGG3,ISUBRO,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IF(ISIDE2.EQ.0)GOTO2370 IF(ISIDE2.EQ.1)IY3=IY3+1 IF(ISIDE2.EQ.2)IY3=IY3-1 IF(ISIDE2.EQ.3)IX3=IX3-1 IF(ISIDE2.EQ.4)IX3=IX3+1 IF(ISIDE2.EQ.1)ISIDE1=2 IF(ISIDE2.EQ.2)ISIDE1=1 IF(ISIDE2.EQ.3)ISIDE1=4 IF(ISIDE2.EQ.4)ISIDE1=3 2300 CONTINUE 2370 CONTINUE IF(ISAVE.LE.0)GOTO2390 DO2375I=1,ISAVE I2=I IF(IX3.EQ.IXSAVE(I2).AND.IY3.EQ.IYSAVE(I2))GOTO2380 2375 CONTINUE GOTO2390 2380 CONTINUE K=K+1 KS=KSAVE(I2) X2(K)=X2(KS) Y2(K)=Y2(KS) CCCCC TAG(K)=TAG(KS) TAG(K)=ITRACE GOTO2390 2390 CONTINUE C 2200 CONTINUE 2100 CONTINUE C C ********************************************* C ********************************************* C ** STEP 31-- ** C ** SCAN THE MATRIX--FOR EACH COLUMN, ** C ** SCAN DOWN THE ROWS AND ** C ** SEARCH FOR Z VALUES WHICH BRACKET THE ** C ** TARGET Z0 CONTOUR VALUE. ** C ********************************************* C ********************************************* C DO3100IX1=1,NXM1 IX2=IX1+1 AIX1=IX1 AIX2=IX2 C DO3200IY1=1,NYM1 IY2=IY1+1 AIY1=IY1 AIY2=IY2 C IF(IDONEV(IY1,IY2,IX1).EQ.'YES')GOTO3200 CCCCC WRITE(ICOUT,3201)IX1,IY1,Z(IX1,IY1) 3201 FORMAT('IX1,IY1,Z(IX1,IY1) = ',2I8,E15.7) CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,3202)IDONEH(IX1,IX2,IY1),IDONEV(IY1,IY2,IX1) 3202 FORMAT('IDONEH(IX1,IX2,IY1),IDONEV(IY1,IY2,IX1) = ',2A4) CCCCC CALL DPWRST('XXX','BUG ') IF(Z(IX1,IY1).LE.Z0.AND.Z0.LE.Z(IX1,IY2))GOTO3210 IF(Z(IX1,IY2).LE.Z0.AND.Z0.LE.Z(IX1,IY1))GOTO3210 GOTO3200 C 3210 CONTINUE ITRACE=ITRACE+1 CCCCC IF(ITRACE.EQ.5) CCCCC1WRITE(ICOUT,3222)IY1,IY2,IX1,IDONEV(IY1,IY2,IX1) C3222 FORMAT('IY1,IY2,IX1,IDONEV(IY1,IY2,IX1) = ',3I8,2X,A4) CCCCC IF(ITRACE.EQ.5) CCCCC1CALL DPWRST('XXX','BUG ') K=K+1 ANUM=Z0-Z(IX1,IY1) ADEN=Z(IX1,IY2)-Z(IX1,IY1) P=ANUM/ADEN Y2(K)=AIY1+P*(AIY2-AIY1) X2(K)=IX1 TAG(K)=ITRACE IDONEV(IY1,IY2,IX1)='YES' C C ******************************************** C ******************************************** C ** STEP 32-- ** C ** A HIT HAS BEEN FOUND. ** C ** THEREFORE, FOLLOW THE TRACE THROUGH ** C ** THE MATRIX UNTIL THE TRACE FINISHES. ** C ******************************************** C ******************************************** C ISAVE=ISAVE+1 IXSAVE(ISAVE)=IX1 IYSAVE(ISAVE)=IY2 KSAVE(ISAVE)=K WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,3355)ISAVE,IXSAVE(ISAVE),IYSAVE(ISAVE),KSAVE(ISAVE) C3355 FORMAT('ISAVE,IXSAVE(ISAVE),IYSAVE(ISAVE),KSAVE(ISAVE)= ',4I8) CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,3356)X2(K),Y2(K) C3356 FORMAT('X2(K),Y2(K) = ',2E15.7) CCCCC CALL DPWRST('XXX','BUG ') C IX3=IX1 IY3=IY2 ISIDE1=3 DO3300I=1,10000 IF(IY3.LE.1)GOTO3370 IF(IY3.GE.NYP1)GOTO3370 IF(IX3.LE.0)GOTO3370 IF(IX3.GE.NX)GOTO3370 CALL DPCOP4(IX3,IY3,ISIDE1,ITRACE,Z0, 1Z,IDONEH,IDONEV, 1X2,Y2,TAG,K,ISIDE2, 1IBUGG3,ISUBRO,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IF(ISIDE2.EQ.0)GOTO3370 IF(ISIDE2.EQ.1)IY3=IY3+1 IF(ISIDE2.EQ.2)IY3=IY3-1 IF(ISIDE2.EQ.3)IX3=IX3-1 IF(ISIDE2.EQ.4)IX3=IX3+1 IF(ISIDE2.EQ.1)ISIDE1=2 IF(ISIDE2.EQ.2)ISIDE1=1 IF(ISIDE2.EQ.3)ISIDE1=4 IF(ISIDE2.EQ.4)ISIDE1=3 3300 CONTINUE 3370 CONTINUE IF(ISAVE.LE.0)GOTO3390 DO3375I=1,ISAVE I2=I CCCCC WRITE(ICOUT,3376)I2,IX3,IY3,IXSAVE(I2),IYSAVE(I2) C3376 FORMAT('I2,IX3,IY3,IXSAVE(I2),IYSAVE(I2) = ',5I8) CCCCC CALL DPWRST('XXX','BUG ') IF(IX3.EQ.IXSAVE(I2).AND.IY3.EQ.IYSAVE(I2))GOTO3380 3375 CONTINUE GOTO3390 3380 CONTINUE K=K+1 KS=KSAVE(I2) X2(K)=X2(KS) Y2(K)=Y2(KS) CCCCC TAG(K)=TAG(KS) TAG(K)=ITRACE CCCCC WRITE(ICOUT,3381)K,KS,X2(KS),Y2(KS),TAG(KS) C3381 FORMAT('K,KS,X2(KS),Y2(KS),TAG(KS) = ',2I8,3E15.7) CCCCC CALL DPWRST('XXX','BUG ') GOTO3390 3390 CONTINUE C 3200 CONTINUE 3100 CONTINUE C 8000 CONTINUE N=K NTRACE=ITRACE C C ***************** C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C ***************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP3')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCOP3--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)Z0 9013 FORMAT('Z0 = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NX,NY 9014 FORMAT('NX,NY = ',2I8) CALL DPWRST('XXX','BUG ') DO9015IY=1,NY DO9016IX=1,NX WRITE(ICOUT,9017)IX,IY,Z(IX,IY) 9017 FORMAT('IX,IY,Z(IX,IY) = ',2I8,E15.7) CALL DPWRST('XXX','BUG ') 9016 CONTINUE 9015 CONTINUE C 9090 CONTINUE C RETURN END SUBROUTINE DPCOP4(IX3,IY3,ISIDE1,ITRACE,Z0, 1Z,IDONEH,IDONEV, 1X2,Y2,TAG,K,ISIDE2, 1IBUGG3,ISUBRO,IERROR) C C PURPOSE--EXAMINE THE BOX WITH LOWER LEFT CORNER C AT (IX3,IY3) AND WITH TRACE ENTRY SIDE C GIVEN BY ISIDE1-- C ISIDE1 = 1 IMPLIES ENTRY FROM BOTTOM C ISIDE1 = 2 IMPLIES ENTRY FROM TOP C ISIDE1 = 3 IMPLIES ENTRY FROM LEFT C ISIDE1 = 4 IMPLIES ENTRY FROM RIGHT C DETERMINE IF THE TRACE EXITS ANYWHERE C FROM THE BOX--THAT IS, IN ANY OF THE C 3 REMAINING SIDES OF THE BOX. C IF AN EXIT IS FOUND, RECORD WHICH SIDE C THE EXIT WAS MADE FROM, C INTERPOLATE TO GET AN X AND Y VALUE C FROM THAT SIDE SO THAT Z(.,.) = Z0, C AND UPDATE THE ARRAYS Y2(.), X2(.), AND TAG(.) C ACCORDINGLY. C NOTE--THIS SUBROUTINE USED TO BE CALLED NEXT C C--------------------------------------------------------------------- C CHARACTER*4 IDONEH CHARACTER*4 IDONEV C CHARACTER*4 IBUGG3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C DIMENSION Z(100,100) DIMENSION IDONEH(20,20,20) DIMENSION IDONEV(20,20,20) C DIMENSION X2(1) DIMENSION Y2(1) DIMENSION TAG(1) C C-----COMMON VARIABLES (GENERAL)----------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C CCCCC IF(K.EQ.52.OR.K.EQ.53)IBUGG3='ON' CCCCC IBUGG3='OFF' CCCCC IF(ITRACE.EQ.3)IBUGG3='ON' C IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP4')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPNEXT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR 52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IX3,IY3 53 FORMAT('IX3,IY3 = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ISIDE1 54 FORMAT('ISIDE1 = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)ITRACE 55 FORMAT('ITRACE = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)Z0 56 FORMAT('Z0 = ',E15.7) CALL DPWRST('XXX','BUG ') 90 CONTINUE C IX1=IX3 IY1=IY3 IX2=IX3+1 IY2=IY3-1 AIX1=IX1 AIY1=IY1 AIX2=IX2 AIY2=IY2 C ISIDE2=0 DO1000I=1,4 IF(I.EQ.ISIDE1)GOTO1000 IF(I.EQ.1)GOTO1100 IF(I.EQ.2)GOTO1200 IF(I.EQ.3)GOTO1300 IF(I.EQ.4)GOTO1400 C C *************************************** C *************************************** C ** STEP 11-- ** C ** CHECK TO SEE IF THE TRACE EXITS ** C ** ON THE BOTTOM. ** C *************************************** C *************************************** C 1100 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP4')GOTO1109 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1101) 1101 FORMAT('CHECK FOR EXIT VIA SIDE 1 (BOTTOM)--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1102)IX1,IX2,IY2,IDONEH(IX1,IX2,IY1) 1102 FORMAT('IX1,IX2,IY2,IDONEH(IX1,IX2,IY1) = ',3I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1103)Z(IX1,IY1),Z0,Z(IX2,IY1) 1103 FORMAT('Z(IX1,IY1),Z0,Z(IX2,IY1) = ',3E15.7) CALL DPWRST('XXX','BUG ') 1109 CONTINUE IF(IDONEH(IX1,IX2,IY1).EQ.'YES')GOTO1000 IF(Z(IX1,IY1).LE.Z0.AND.Z0.LE.Z(IX2,IY1))GOTO1110 IF(Z(IX2,IY1).LE.Z0.AND.Z0.LE.Z(IX1,IY1))GOTO1110 GOTO1000 C 1110 CONTINUE K=K+1 ANUM=Z0-Z(IX1,IY1) ADEN=Z(IX2,IY1)-Z(IX1,IY1) P=ANUM/ADEN X2(K)=AIX1+P*(AIX2-AIX1) Y2(K)=IY1 TAG(K)=ITRACE IDONEH(IX1,IX2,IY1)='YES' ISIDE2=1 GOTO9000 C C *************************************** C *************************************** C ** STEP 12-- ** C ** CHECK TO SEE IF THE TRACE EXITS ** C ** ON THE TOP. ** C *************************************** C *************************************** C 1200 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP4')GOTO1209 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1201) 1201 FORMAT('CHECK FOR EXIT VIA SIDE 2 (TOP)--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1202)IX1,IX2,IY2,IDONEH(IX1,IX2,IY2) 1202 FORMAT('IX1,IX2,IY2,IDONEH(IX1,IX2,IY2) = ',3I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1203)Z(IX1,IY2),Z0,Z(IX2,IY2) 1203 FORMAT('Z(IX1,IY2),Z0,Z(IX2,IY2) = ',3E15.7) CALL DPWRST('XXX','BUG ') 1209 CONTINUE IF(IDONEH(IX1,IX2,IY2).EQ.'YES')GOTO1000 IF(Z(IX1,IY2).LE.Z0.AND.Z0.LE.Z(IX2,IY2))GOTO1210 IF(Z(IX2,IY2).LE.Z0.AND.Z0.LE.Z(IX1,IY2))GOTO1210 GOTO1000 C 1210 CONTINUE K=K+1 ANUM=Z0-Z(IX1,IY2) ADEN=Z(IX2,IY2)-Z(IX1,IY2) P=ANUM/ADEN X2(K)=AIX1+P*(AIX2-AIX1) Y2(K)=IY2 TAG(K)=ITRACE IDONEH(IX1,IX2,IY2)='YES' ISIDE2=2 GOTO9000 C C *************************************** C *************************************** C ** STEP 13-- ** C ** CHECK TO SEE IF THE TRACE EXITS ** C ** ON THE LEFT. ** C *************************************** C *************************************** C 1300 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP4')GOTO1309 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1301) 1301 FORMAT('CHECK FOR EXIT VIA SIDE 3 (LEFT)--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1302)IY2,IY1,IX1,IDONEV(IY2,IY1,IX1) 1302 FORMAT('IY2,IY1,IX1,IDONEV(IY2,IY1,IX1) = ',3I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1303)Z(IX1,IY1),Z0,Z(IX1,IY2) 1303 FORMAT('Z(IX1,IY1),Z0,Z(IX1,IY2) = ',3E15.7) CALL DPWRST('XXX','BUG ') 1309 CONTINUE IF(IDONEV(IY2,IY1,IX1).EQ.'YES')GOTO1000 IF(Z(IX1,IY1).LE.Z0.AND.Z0.LE.Z(IX1,IY2))GOTO1310 IF(Z(IX1,IY2).LE.Z0.AND.Z0.LE.Z(IX1,IY1))GOTO1310 GOTO1000 C 1310 CONTINUE K=K+1 ANUM=Z0-Z(IX1,IY1) ADEN=Z(IX1,IY2)-Z(IX1,IY1) P=ANUM/ADEN Y2(K)=AIY1+P*(AIY2-AIY1) X2(K)=IX1 TAG(K)=ITRACE IDONEV(IY2,IY1,IX1)='YES' ISIDE2=3 GOTO9000 C C *************************************** C *************************************** C ** STEP 14-- ** C ** CHECK TO SEE IF THE TRACE EXITS ** C ** ON THE RIGHT. ** C *************************************** C *************************************** C 1400 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP4')GOTO1409 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1401) 1401 FORMAT('CHECK FOR EXIT VIA SIDE 4 (RIGHT)--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1402)IY2,IY1,IX2,IDONEV(IY2,IY1,IX2) 1402 FORMAT('IY2,IY1,IX2,IDONEV(IY2,IY1,IX2) = ',3I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1403)Z(IX2,IY1),Z0,Z(IX2,IY2) 1403 FORMAT('Z(IX2,IY1),Z0,Z(IX2,IY2) = ',3E15.7) CALL DPWRST('XXX','BUG ') 1409 CONTINUE IF(IDONEV(IY2,IY1,IX2).EQ.'YES')GOTO1000 IF(Z(IX2,IY1).LE.Z0.AND.Z0.LE.Z(IX2,IY2))GOTO1410 IF(Z(IX2,IY2).LE.Z0.AND.Z0.LE.Z(IX2,IY1))GOTO1410 GOTO1000 C 1410 CONTINUE K=K+1 ANUM=Z0-Z(IX2,IY1) ADEN=Z(IX2,IY2)-Z(IX2,IY1) P=ANUM/ADEN Y2(K)=AIY1+P*(AIY2-AIY1) X2(K)=IX2 TAG(K)=ITRACE IDONEV(IY2,IY1,IX2)='YES' ISIDE2=4 GOTO9000 C 1000 CONTINUE C C ***************** C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C ***************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COP4')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPNEXT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IX3,IY3 9013 FORMAT('IX3,IY3 = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ISIDE1 9014 FORMAT('ISIDE1 = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)ITRACE 9015 FORMAT('ITRACE = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)Z0 9016 FORMAT('Z0 = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)ISIDE2 9021 FORMAT('ISIDE2 = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)K 9022 FORMAT('K = ',I8) CALL DPWRST('XXX','BUG ') DO9023I=1,K CCCCC WRITE(ICOUT,9024)I,X2(I),Y2(I),TAG(I) 9024 FORMAT('I,X2(I),Y2(I),TAG(I) = ',I8,3E15.7) CCCCC CALL DPWRST('XXX','BUG ') 9023 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPCORU(ICOM,IHARG,NUMARG, 1IFOUND,IERROR) C C PURPOSE--WRITE OUT A COLUMN RULER (1 TO 132) C TO ALLOW THE USER TO ASSESS WHAT COLUMN LIMITS C ARE APPROPRIATE IN READING FROM A FILE. C INPUT ARGUMENTS--ICOM C --IHARG C --NUMARG C OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO') C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-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--89/12 C ORIGINAL VERSION--NOVEMBER 1989. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICOM CHARACTER*4 IHARG C CHARACTER*4 IFOUND CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION IHARG(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IFOUND='YES' IERROR='NO' C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'RULE')GOTO1110 IF(ICOM.EQ.'RULE')GOTO1110 C GOTO1120 C 1110 CONTINUE WRITE(ICOUT,1111) 1111 FORMAT('123456789.123456789.123456789.123456789.123456789.', 1'123456789.123456789.123456789.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1112) 1112 FORMAT(' 10 20 30 40 5', 1'0 60 70 ') CALL DPWRST('XXX','BUG ') GOTO9000 C 1120 CONTINUE WRITE(ICOUT,1121) 1121 FORMAT(' 123456789.123456789.123456789.123456789.', 1'123456789.123456789.123456789.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1122) 1122 FORMAT(' 10 20 30 4', 1'0 50 60 ') CALL DPWRST('XXX','BUG ') GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE RETURN END SUBROUTINE GRKICR CC CC PURPOSE--KILL (SUPPRESS) THE CARRIAGE RETURN AFTER FUTURE WRITES CC ON A GENERAL GRAPHICS DEVICE CC THIS IS NEEDED FOR SOME DEVICES IN ORDER TO CC READ THE CROSS-HAIR POSITION FROM THE SCREEN. CC NOTE--THIS SUBROUTINE IS NON-STANDARD FORTRAN CC AND WILL VARY FROM SITE TO SITE. CC THE BODY OF THIS SUBROUTINE MUST BE CC CHANGED BY THE IMPLEMENTOR. CC THIS SUBROUTINE IS FOR UNIVAC 1100/82. CC THE PURPOSE OF GRKICH IS TO SUPPRESS THE CARRIAGE RETURN CC AT THE END OF A WRITE STATEMENT BECAUSE IT CC "GETS IN THE WAY" DURING THE CC READING OF THE CROSS-HAIR. CC WRITTEN BY--MICHAEL VOGT CC COMPUTER SERVICES DIVISION CC CENTER FOR APPLIED MATHEMATICS CC NATIONAL BUREAU OF STANDARDS CC WASHINGTON, D. C. 20234 CC LANGUAGE--ANSI FORTRAN (1977) CC VERSION NUMBER--82.6 CC ORIGINAL VERSION--APRIL 1978. CC UPDATED --APRIL 1982. CC UPDATED --MAY 1982. CC CC--------------------------------------------------------------------- CC C CHARACTER*80 ISTRIN CC C DIMENSION ISPKT(8) CC C-----COMMON---------------------------------------------------------- C C INCLUDE 'DPCOHO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- CC C CHARACTER*4 IFEEDB C CHARACTER*4 IPRINT CHARACTER*240 ICOUT CC C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW C COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT CC CC-----START POINT----------------------------------------------------- CC C INCLUDE FIOP CC CC THE FOLLOWING IS FOR THE UNIVAC-- CC C IF(IHOST1.EQ.'UNIV')GOTO510 C GOTO520 C 510 CONTINUE C GOTO1000 CC CC THE FOLLOWING IS FOR THE VAX-- CC THE FOLLOWING IS FOR THE IBM-- CC THE FOLLOWING IS FOR THE PERKIN-ELMER-- CC THE FOLLOWING IS FOR THE INTERDATA-- CC THE FOLLOWING IS FOR ALL NON-UNIVAC-- CC C 520 CONTINUE C GOTO9000 CC C 1000 CONTINUE C DO1100I=1,8 C ISPKT(I)=0 C 1100 CONTINUE CC C ISPKT(1)=14 C IFUNC(ISPKT)=FSM C IMODE(ISPKT)=IASC C IIMGAD(ISPKT)=LOC(ISTRIN) C ISTRIN='D,@@TTY A,2' C ICHCT(ISPKT)=TRMLEN(ISTRIN) C CALL FSYMB(ISPKT) CC CC ***************** CC ** STEP 90-- ** CC ** EXIT ** CC ***************** CC C 9000 CONTINUE RETURN END SUBROUTINE GRRECR CC CC PURPOSE--REVIVE THE CARRIAGE RETURN FOR FUTURE WRITES CC THIS IS NEEDED FOR SOME DEVICES AFTER CC READING THE CROSS-HAIR POSITION FROM THE SCREEN. CC NOTE--THIS SUBROUTINE IS NON-STANDARD FORTRAN CC AND WILL VARY FROM SITE TO SITE. CC THE BODY OF THIS SUBROUTINE MUST BE CC CHANGED BY THE IMPLEMENTOR. CC THIS SUBROUTINE IS FOR UNIVAC 1100/82. CC THE PURPOSE OF GRKICH IS TO REVIVE THE CARRIAGE RETURN CC AT THE END OF A WRITE STATEMENT. CC THE REASON THAT THE CARRIAGE RETURN WOULD HAVE BEEN CC KILLED (SUPPRESSED) IS THAT IT (FOR EXAMPLE) CC "GETS IN THE WAY" DURING THE CC READING OF THE CROSS-HAIR. CC WRITTEN BY--MICHAEL VOGT CC COMPUTER SERVICES DIVISION CC CENTER FOR APPLIED MATHEMATICS CC NATIONAL BUREAU OF STANDARDS CC WASHINGTON, D. C. 20234 CC LANGUAGE--ANSI FORTRAN (1977) CC VERSION NUMBER--82.6 CC ORIGINAL VERSION--APRIL 1978. CC UPDATED --APRIL 1982. CC UPDATED --MAY 1982. CC CC--------------------------------------------------------------------- CC C CHARACTER*80 ISTRIN CC C DIMENSION ISPKT(8) CC C-----COMMON---------------------------------------------------------- C C INCLUDE 'DPCOHO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- CC C CHARACTER*4 IFEEDB C CHARACTER*4 IPRINT CHARACTER*240 ICOUT CC C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW C COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT CC CC-----START POINT----------------------------------------------------- CC C INCLUDE FIOP CC CC THE FOLLOWING IS FOR THE UNIVAC-- CC C IF(IHOST1.EQ.'UNIV')GOTO510 C GOTO520 C 510 CONTINUE C GOTO1000 CC CC THE FOLLOWING IS FOR THE VAX-- CC THE FOLLOWING IS FOR THE IBM-- CC THE FOLLOWING IS FOR THE PERKIN-ELMER-- CC THE FOLLOWING IS FOR THE INTERDATA-- CC THE FOLLOWING IS FOR ALL NON-UNIVAC-- CC C 520 CONTINUE C GOTO9000 CC C 1000 CONTINUE C DO1100I=1,8 C ISPKT(I)=0 C 1100 CONTINUE CC C ISPKT(1)=14 C IFUNC(ISPKT)=FSM C IMODE(ISPKT)=IASC C IIMGAD(ISPKT)=LOC(ISTRIN) C ISTRIN='D,@@TTY A,0' C ICHCT(ISPKT)=TRMLEN(ISTRIN) C CALL FSYMB(ISPKT) CC CC ***************** CC ** STEP 90-- ** CC ** EXIT ** CC ***************** CC C 9000 CONTINUE RETURN END SUBROUTINE UNIRAN(N,ISEED,X) C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE UNIFORM (RECTANGULAR) C DISTRIBUTION ON THE UNIT INTERVAL (0,1). C THIS DISTRIBUTION HAS MEAN = 0.5 C AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513. C THIS DISTRIBUTION HAS THE PROBABILITY C DENSITY FUNCTION F(X) = 1. C C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --ISEED = AN INTEGER ISEED VALUE C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE RECTANGULAR DISTRIBUTION ON (0,1). C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C C ALGORITHM--FIBONACCI GENERATOR C AS DEFINED BY GEORGE MARSAGLIA. C C NOTE--THIS GENERATOR IS TRANSPORTABLE. C IT IS NOT MACHINE-INDEPENDENT C IN THE SENSE THAT FOR A GIVEN VALUE C OF THE INPUT SEED ISEED AND FOR A GIVEN VALUE C OF MDIG (TO BE DEFINED BELOW), C THE SAME SEQUENCE OF UNIRFORM RANDOM C NUMBERS WILL RESULT ON DIFFERENT COMPUTERS C (VAX, PRIME, PERKIN-ELMER, IBM, UNIVAC, HONEYWELL, ETC.) C C NOTE--IF MDIG = 32 AND IF ISEED = 305, C THEN THE OUTPUT FROM THIS GENERATOR SHOULD BE AS FOLLOWS-- C THE FIRST NUMBER TO RESULT IS .4771580... C THE SECOND NUMBER TO RESULT IS .4219293... C THE THIRD NUMBER TO RESULT IS .6646181... C ... C THE THOUSANDTH NUMBER TO RESULT IS .2036834... C C NOTE--IF MDIG = 16 AND IF ISEED = 305, C THEN THE OUTPUT FROM THIS GENERATOR SHOULD BE AS FOLLOWS-- C THE FIRST NUMBER TO RESULT IS .027832881... C THE SECOND NUMBER TO RESULT IS .56102176... C THE THIRD NUMBER TO RESULT IS .41456343... C ... C THE THOUSANDTH NUMBER TO RESULT IS .19797357... C C NOTE--IT IS RECOMMENDED THAT UPON C IMPLEMENTATION OF DATAPLOT, THE OUTPUT C FROM UNIRAN BE CHECKED FOR AGREEMENT C WITH THE ABOVE SAMPLE OUTPUT. C ALSO, THERE ARE MANY ANALYSIS AND DIAGNOSTIC C TOOLS IN DATAPLOT THAT WILL ALLOW THE C TESTING OF THE RANDOMNESS AND UNIFORMITY C OF THIS GENERATOR. C SUCH CHECKING IS ESPECIALLY IMPORTANT C IN LIGHT OF THE FACT THAT OTHER DATAPLOT RANDOM C NUMBER GENERATOR SUBROUTINES (NORRAN--NORMAL, C LOGRAN--LOGISTIC, ETC.) ALL MAKE USE OF INTERMEDIATE C OUTPUT FROM UNIRAN. C C NOTE--THE OUTPUT FROM THIS SUBROUTINE DEPENDS C ON THE INPUT SEED (ISEED) AND ON THE C VALUE OF MDIG. C MDIG MAY NOT BE SMALLER THAN 16. C MDIG MAY NOT BE LARGER THAN MAX INTEGER ON YOUR COMPUTER. C C NOTE--BECAUSE OF THE PREPONDERANCE OF MAINFRAMES C WHICH HAVE WORDS OF 32 BITS AND LARGER C (E.G, VAX (= 32 BITS), UNIVAC (= 36 BITS), CDC (= 60 BITS), ETC.) C MDIG HAS BEEN SET TO 32. C THUS THE SAME SEQUENCE OF RANDOM NUMBERS SHOULD RESULT C ON ALL OF THESE COMPUTERS. C C NOTE--FOR SMALLER WORD SIZE COMPUTERS (E.G., 24-BIT AND 16-BIT), C THE VALUE OF MDIG SHOULD BE CHANGED TO 24 OR 16. C IN SUCH CASE, THE OUTPUT WILL NOT BE IDENTICAL TO C THE OUTPUT WHEN MDIG = 32. C C NOTE--THE CYCLE OF THE RANDOM NUMBERS DEPENDS ON MDIG. C THE CYCLE FROM MDIG = 32 IS LONG ENOUGH FOR MOST C PRACTICAL APPLICATIONS. C IF A LONGER CYCLE IS DESIRED, THEN INCREASE MDIG. C C NOTE--THE SEED MAY BE ANY POSITIVE INTEGER. C NO APPRECIABLE DIFFERENCE IN THE QUALITY C OF THE RANDOM NUMBERS HAS BEEN NOTED C BY THE CHOICE OF THE SEED. THERE IS NO C NEED TO USE PRIMES, NOR TO USE EXCEPTIONALLY C LARGE NUMBERS, ETC. C C REFERENCES--MARSAGLIA G., "COMMENTS ON THE PERFECT UNIFORM RANDOM C NUMBER GENERATOR", UNPUBLISHED NOTES, WASH S. U. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 57-74. C WRITTEN BY--JAMES BLUE C SCIENTIFIC COMPUTING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C --DAVID KAHANER C SCIENTIFIC COMPUTING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C --GEORGE MARSAGLIA C COMPUTER SCIENCE DEPARTMENT C WASHINGTON STATE UNIVERSITY C --JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C C LANGUAGE--ANSI FORTRAN (1977) C ORIGINAL VERSION--JUNE 1972. C UPDATED --AUGUST 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --NOVEMBER 1981. C UPDATED --MAY 1982. C UPDATED --MARCH 1984. C UPDATED --MAY 2002. ADD SUPPORT FOR ADDITIONAL C RANDOM NUMBER GENERATORS. C INITIAL LIST INCLUDES: C RUNIF = LINEAR CONGRUENTIAL C SUNIF = MULTIPLICATIVE C CONGRUENTIAL C NOTE THAT DEFAULT GENERATOR C IS EQUIVALENT TO CMLIB C ROUTINE "UNI" (SO WE DO NOT C INCLUDE THAT ONE). C GENERALIZED FEEDBACK SHIFT C REGISTER (GFSR) OF PAYNE AND C LEWIS (AS IMPLEMENTED BY C MONOHAN). C GENERALIZED FEEDBACK SHIFT C REGISTER (GFSR) OF FUSHIMI AND C TEZUKA (AS IMPLEMENTED BY C MONOHAN). C APPLIED STATISTICS 183 (SUM C OF 3 MULTIPLICATIVE C CONGRUENTIAL GENERATORS) C UPDATED --APRIL 2003. ADD ALAN GENZ GENERATOR C UPDATED --MAY 2003. ADD R250 AND RANLUX C GENERATORS C UPDATED --NOVEMBER 2003. ADD MERSENNE TWISTER C ALGORITHM C UPDATED --DECEMBER 2003. SEPARATE SEED VALUES FOR C DIFFERENT GENERATORS C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C DIMENSION M(17) DIMENSION T(33) C EXTERNAL UNI DOUBLE PRECISION UNI DOUBLE PRECISION GRND C C--------------------------------------------------------------------- C INCLUDE 'DPCOST.INC' 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-----SAVE STATEMENTS------------------------------------------------- C SAVE I,J,M,M1,M2 SAVE ISED1,ISED2,ISED3,ISED4,ISED5,ISED6 SAVE ISED7,ISED8,ISED9,ISED10,ISED11 SAVE ISDSAV C C-----DATA STATEMENTS------------------------------------------------- C DATA M(1),M(2),M(3),M(4),M(5),M(6),M(7),M(8),M(9),M(10),M(11), 1 M(12),M(13),M(14),M(15),M(16),M(17) 1/ 30788,23052,2053,19346,10646,19427,23975, 1 19049,10949,19693,29746,26748,2796,23890, 1 29168,31924,16499/ DATA M1,M2,I,J / 32767,256,5,17 / DATA ISED1 /0/ DATA ISED2 /0/ DATA ISED3 /0/ DATA ISED4 /0/ DATA ISED5 /0/ DATA ISED6 /0/ DATA ISED7 /0/ DATA ISED8 /0/ DATA ISED9 /0/ DATA ISED10 /0/ DATA ISED11 /0/ DATA ISDSAV /305/ C C-----START POINT----------------------------------------------------- C C ******************************************** C ** STEP 1-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C IF(N.LT.1)THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** ERROR IN UNIRAN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52) 52 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS IS ', 1 'NON-POSITIVE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)N 53 FORMAT(' N = ',I8) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C IF(IRANAL.EQ.'FIBO')GOTO1000 IF(IRANAL.EQ.'FIBC')GOTO1500 IF(IRANAL.EQ.'LINE')GOTO2000 IF(IRANAL.EQ.'MULT')GOTO3000 IF(IRANAL.EQ.'GFSR')GOTO4000 IF(IRANAL.EQ.'GFS2')GOTO5000 IF(IRANAL.EQ.'183 ')GOTO6000 IF(IRANAL.EQ.'GENZ')GOTO7000 IF(IRANAL.EQ.'R250')GOTO8000 IF(IRANAL.EQ.'LUXU')GOTO8500 IF(IRANAL.EQ.'MERT')GOTO8600 C 1000 CONTINUE C C ******************************************************* C ** STEP 2-- ** C ** IF A POSITIVE INPUT SEED HAS BEEN GIVEN, ** C ** THEN THIS INDICATES THAT THE GENERATOR ** C ** SHOULD HAVE ITS INTERNAL M(.) ARRAY REDEFINED-- ** C ** DO SO IN THIS SECTION. ** C ** IF A NON-POSITIVE INPUT SEED HAS BEEN GIVEN, ** C ** THEN THIS INDICATES THAT THE GENERATOR ** C ** SHOULD CONTINUE ON FROM WHERE IT LEFT OFF, ** C ** AND THEREFORE THIS SECTION IS SKIPPED. ** C ******************************************************* C CCCCC IF(ISEED.LE.0)GOTO290 C C INITIALIZE IF NECESSARY C IF(ISED1.EQ.0)THEN ISED1=-1 IF(ISEED.GT.0)THEN ISDSAV=ISEED ELSE ISEED=ISDSAV ENDIF ELSE IF(ISEED.LE.0)GOTO290 ISDSAV=ISEED ENDIF C C END OF INITIALIZATION C C CCCCC MDIG=16 MDIG=32 C M1=2**(MDIG-2)+(2**(MDIG-2)-1) M2=2**(MDIG/2) CCCCC ISEED3=MIN0(IABS(ISEED),M1) ISEED3=IABS(ISEED) IF(M1.LT.IABS(ISEED))ISEED3=M1 IF(MOD(ISEED3,2).EQ.0)ISEED3=ISEED3-1 K0=MOD(9069,M2) K1=9069/M2 J0=MOD(ISEED3,M2) J1=ISEED3/M2 C DO200I=1,17 ISEED3=J0*K0 J1=MOD(ISEED3/M2+J0*K1+J1*K0,M2/2) J0=MOD(ISEED3,M2) M(I)=J0+M2*J1 200 CONTINUE C I=5 J=17 C 290 CONTINUE C C ************************************* C ** STEP 3-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ************************************* C DO300L=1,N K=M(I)-M(J) IF(K.LT.0)K=K+M1 M(J)=K I=I-1 IF(I.EQ.0)I=17 J=J-1 IF(J.EQ.0)J=17 AK=K AM1=M1 X(L)=AK/AM1 300 CONTINUE C C ***************************************************** C ** STEP 4-- ** C ** REGARDLESS OF THE VALUE OF THE INPUT SEED, ** C ** REDEFINE THE VALUE OF ISEED UPON EXIT HERE ** C ** TO -1 WITH THE NET EFFECT THAT ** C ** IF THE USER DOES NOT REDEFINE THE SEED ** C ** VALUE BEFORE THE NEXT CALL TO THIS GENERATOR, ** C ** THEN THIS GENERATOR WILL PICK UP ** C ** WHERE IT LEFT OFF. ** C ***************************************************** C ISEED=(-1) GOTO9000 C C ***************************************** C ** STEP 1500-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING THE COMBINED FIBONACCI/ ** C ** CONGUENTIAL GENERATOR OF ** C ** KAHANER AND MARSAGALIA GIVEN ** C ** IN "NUMERICAL METHODS AND SOFTWARE"** C ** BY KAHANER, MOLER, AND NASH. ** C ***************************************** C 1500 CONTINUE C C INITIALIZE IF NECESSARY C IF(ISED2.EQ.0)THEN IF(ISEED.GT.0)THEN ISDSAV=ISEED USEED=USTART(ISEED) ISEED=(-1) ELSE USEED=USTART(ISDSAV) ENDIF ISED2=-1 ELSE IF(ISEED.GT.0)THEN ISDSAV=ISEED USEED=USTART(ISEED) ISEED=(-1) ENDIF ENDIF C C END OF INITIALIZATION C DO1510L=1,N X(L)=UNIKMN() 1510 CONTINUE GOTO9000 C C ************************************* C ** STEP 2000-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING THE LINEAR CONGRUENTIAL ** C ** GENERATOR RUNIF (FROM CMLIB). ** C ************************************* C 2000 CONTINUE NSIZE=32 NSTRT=1 C C INITIALIZE IF NECESSARY C IF(ISED3.EQ.0)THEN NSTRT=2 IF(ISEED.GT.0)THEN ISDSAV=ISEED X(1)=RUNIF(T,NSIZE) ISEED=(-1) ELSE X(1)=RUNIF(T,NSIZE) ENDIF ISED3=-1 ELSE IF(ISEED.GT.0)THEN ISDSAV=ISEED X(1)=RUNIF(T,NSIZE) ISEED=(-1) NSTRT=2 ENDIF ENDIF C C END OF INITIALIZATION C IF(NSTRT.LE.N)THEN DO2020L=NSTRT,N X(L)=RUNIF(T,NSIZE) 2020 CONTINUE ENDIF ISEED=(-1) GOTO9000 C C ********************************************** C ** STEP 3000-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING THE MULTIPLICATIVE CONGRUENTIAL ** C ** GENERATOR SUNIF (FROM ACM 599). ** C ********************************************** C 3000 CONTINUE C C INITIALIZE IF NECESSARY C C ISED3 = 0 - THIS GENERATOR HAS NOT BEEN INITIALIZED YET C ISEED > 0 - A NEW INITIALIZATION IS BEING REQUESTED C C FOR THIS GENERATOR, THE SEED SHOULD BE OF THE FORM 4*K + 1 C NSTRT=1 C C CASE WHERE GENERATOR HAS NOT BEEN INITIALIZED. IF ISEED IS -1 (I.E., C ANOTHER GENERATOR HAS BEEN CALLED), THEN RESET DEFAULT SEED. C IF(ISED3.EQ.0)THEN NSTRT=2 IF(ISEED.GT.0)THEN ISDSAV=ISEED IREM=MOD(ISEED,4) IF(IREM.EQ.0)ISEED2=ISEED+1 IF(IREM.EQ.1)ISEED2=ISEED IF(IREM.EQ.2)ISEED2=ISEED+3 IF(IREM.EQ.3)ISEED2=ISEED+2 X(1)=SUNIF(ISEED2) ISEED=ISEED2 ELSE ISEED2=ISDSAV IREM=MOD(ISEED2,4) IF(IREM.EQ.0)ISEED2=ISEED2+1 IF(IREM.EQ.1)ISEED2=ISEED2 IF(IREM.EQ.2)ISEED2=ISEED2+3 IF(IREM.EQ.3)ISEED2=ISEED2+2 X(1)=SUNIF(ISEED2) ISEED=ISEED2 ENDIF ISED3=-1 C C CASE WHERE GENERATOR HAS BEEN PREVIOUSLY INITIALIZED. IF ISEED > 0, C THIS IMPLIES A NEW INITIALIZATION IS BEING REQUESTED. C ELSE IF(ISEED.GT.0)THEN ISDSAV=ISEED IREM=MOD(ISEED,4) IF(IREM.EQ.0)ISEED2=ISEED+1 IF(IREM.EQ.1)ISEED2=ISEED IF(IREM.EQ.2)ISEED2=ISEED+3 IF(IREM.EQ.3)ISEED2=ISEED+2 X(1)=SUNIF(ISEED2) ISEED=(-1) NSTRT=2 ELSE NSTRT=1 ENDIF ENDIF C C END OF INITIALIZATION C IF(NSTRT.LE.N)THEN DO3020L=NSTRT,N X(L)=SUNIF(ISEED) 3020 CONTINUE ISEED=(-1) ENDIF GOTO9000 C C ********************************************** C ** STEP 4000-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING THE GENERALIZED FEEDACK SHIFT ** C ** REGISTER (GFSR) GENERATOR RANLP (FROM ** C ** MONOHAM, 2001). ** C ********************************************** C 4000 CONTINUE DO4020L=1,N X(L)=RANLP(L) 4020 CONTINUE GOTO9000 C C ********************************************** C ** STEP 5000-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING THE GENERALIZED FEEDACK SHIFT ** C ** REGISTER (GFSR) GENERATOR RANFT (FROM ** C ** MONOHAM, 2001). ** C ********************************************** C 5000 CONTINUE DO5020L=1,N X(L)=RANFT(L) 5020 CONTINUE GOTO9000 C C ********************************************** C ** STEP 6000-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING APPLIED STATISTICS ALGORITHM 183. ** C ** NOTE: GENERATE 3 RANDOM NUMBERS BEFORE ** C ** CALLING RAN183. ** C ********************************************** C 6000 CONTINUE C C INITIALIZE IF NECESSARY C IF(ISED4.EQ.0)THEN IF(ISEED.GT.0)THEN ISDSAV=ISEED ELSE ISEED=ISDSAV ENDIF IREM=MOD(ISEED,4) IF(IREM.EQ.0)ISEED2=ISEED+1 IF(IREM.EQ.1)ISEED2=ISEED IF(IREM.EQ.2)ISEED2=ISEED+3 IF(IREM.EQ.3)ISEED2=ISEED+2 XTEMP=SUNIF(ISEED2) IX=INT(30000.*XTEMP) XTEMP=SUNIF(ISEED2) IY=INT(30000.*XTEMP) XTEMP=SUNIF(ISEED2) IZ=INT(30000.*XTEMP) ISED4=-1 ISEED=(-1) ELSE IF(ISEED.GT.0)THEN ISDSAV=ISEED IREM=MOD(ISEED,4) IF(IREM.EQ.0)ISEED2=ISEED+1 IF(IREM.EQ.1)ISEED2=ISEED IF(IREM.EQ.2)ISEED2=ISEED+3 IF(IREM.EQ.3)ISEED2=ISEED+2 XTEMP=SUNIF(ISEED2) IX=INT(30000.*XTEMP) XTEMP=SUNIF(ISEED2) IY=INT(30000.*XTEMP) XTEMP=SUNIF(ISEED2) IZ=INT(30000.*XTEMP) ISEED=(-1) ELSE XTEMP=SUNIF(ISEED) IX=INT(30000.*XTEMP) XTEMP=SUNIF(ISEED) IY=INT(30000.*XTEMP) XTEMP=SUNIF(ISEED) IZ=INT(30000.*XTEMP) ENDIF ENDIF C C END OF INITIALIZATION C C DO6020L=1,N X(L)=RAN183(IX,IY,IZ) 6020 CONTINUE GOTO9000 C C ********************************************** C ** STEP 7000-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING ALGORITHM FROM ALAN GENZ. BASED ** C ** ON: L'Ecuyer, Pierre (1996). "Combined ** C ** Multiple Recursive Random Number ** C ** Generator", Operations Research 44, ** C ** pp. 816-822. ** C ********************************************** C 7000 CONTINUE C DO7020L=1,N X(L)=REAL(UNI()) 7020 CONTINUE GOTO9000 C ********************************************** C ** STEP 8000-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING R250 ALGORITHM. ** C ** BASED ON KIRKPATRICK AND STOLL ** C ** FAST SHOFT-REGISTER SEQUENCE GENERATOR. ** C ********************************************** C 8000 CONTINUE C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8051) 8051 FORMAT('***** WARNING FROM UNIRAN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8053) 8053 FORMAT(' THE R250 GENERATOR IS NOT CURRENTLY WORKING.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8055) 8055 FORMAT(' THE RESULTS FROM THIS GENERATOR ARE NOT VALID.') CALL DPWRST('XXX','BUG ') C C C INITIALIZE IF NECESSARY C IF(ISED5.EQ.0)THEN IF(ISEED.GT.0)THEN ISDSAV=ISEED CALL R250IN(ISEED) ISEED=(-1) ELSE CALL R250IN(ISDSAV) ENDIF ISED5=-1 ELSE IF(ISEED.GT.0)THEN ISDSAV=ISEED CALL R250IN(ISEED) ISEED=(-1) ENDIF ENDIF C C END OF INITIALIZATION C DO8050L=1,N X(L)=RND250() 8050 CONTINUE GOTO9000 C ********************************************** C ** STEP 8500-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING LUXURY GENERATOR OF F. JAMES. ** C ** THIS IS A MODIFICATION OF MARSAGLIA AND ** C ** ZAMAN RCARRY GENERATOR. ** C ** RANLUX KEEPS TRACK OF INITIALIZATION ** C ********************************************** C 8500 CONTINUE C CALL RANLUX(X,N) GOTO9000 C C ********************************************** C ** STEP 8600-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ** USING MERSENNE TWISTER GENERATOR. ** C ** THIS IS A FORTRAN IMPLEMENTATION ** C ** PROVIDED BY HIROSHI TAKANO. ** C ********************************************** C 8600 CONTINUE C C C INITIALIZE IF NECESSARY C IF(ISED6.EQ.0)THEN IF(ISEED.GT.0)THEN ISDSAV=ISEED CALL SGRND(ISEED) ISEED=(-1) ELSE ISEED=ISDSAV CALL SGRND(ISEED) ENDIF ISED6=-1 ELSE IF(ISEED.GT.0)THEN ISDSAV=ISEED CALL SGRND(ISEED) ISEED=(-1) ENDIF ENDIF C C END OF INITIALIZATION C DO8610I=1,N X(I)=REAL(GRND()) 8610 CONTINUE C GOTO9000 C C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE RETURN CCCCC DEBUG TRACE,INIT CCCCC AT 90 CCCCC TRACE ON END SUBROUTINE DPTRAN(IHARG,IHARG2,NUMARG, 1ICTRA1,NCTRA1,ICTRA2,NCTRA2,NUMTRA, 1IBUGS2,ISUBRO,IFOUND,IERROR) C C PURPOSE--CREATE USER-DEFINED STRING TRANSLATIONS C WHICH WILL ALLOW EVERY SUB-STRING THAT COMES OUT C OF SUBROUTINE GRWRST TO BE TRANSLATED C IF SO DESIRED. C EXAMPLE OF USE--THE UNIVERSITY OF MARYLAND GANDOLPH C COMMUNICATIONS BOX EATSD UP ESCAPES C (NOT ONLY FROM THE TERMINAL) BUT ALSO C FROM THE HOSST--THUS AN ESCAPE FORMFEED C FROM THE HOST TO CLEAR THE SCREEN RESULTS C IN ONLY A FORMFEED (AND THUS THERE IS NO C HOST-GENERATED WAY TO CLEAR THE SCREEN). C THIS PROBLEM CAN NOW BE SOLVED VIA THE C TRANSLATE COMMAND BY TELLING DATAPLOT C TRANSLATE ESC FF TO ESC ESC FF C AND THUS THE SECOND ESC WILL GET THROUGH C AND THE SCREEN WILL BE CLEARED. C INPUT ARGUMENTS--IHARG (A CHARACTER VECTOR) C --IHARG2 (A CHARACTER VECTOR) C --NUMARG C OUTPUT ARGUMENTS--ICTRA1 C NCTRA1 C ICTRA2 C NCTRA2 C NUMTRA C IFOUND C IERROR 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--86/6 C ORIGINAL VERSION--FEBRUARY 1986. C UPDATED --JANUARY 1989. BUG FIX FROM JJF NOTES (ALAN) C C-----NON-COMMON VARIABLES---------------------------------------- C CHARACTER*4 IHARG CHARACTER*4 IHARG2 C CHARACTER*30 ICTRA1 CHARACTER*30 ICTRA2 C CHARACTER*1 IC1 CHARACTER*4 IC4 CHARACTER*30 ISTRIN C CHARACTER*4 IBUGS2 CHARACTER*4 ISUBRO CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 C DIMENSION IHARG(*) DIMENSION IHARG2(*) C DIMENSION ICTRA1(*) DIMENSION NCTRA1(*) DIMENSION ICTRA2(*) DIMENSION NCTRA2(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCONP.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPTR' ISUBN2='AN ' C IFOUND='YES' IERROR='NO' C IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'DEFI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('AT THE BEGINNING OF DPTRAN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGS2,ISUBRO 53 FORMAT('IBUGS2,ISUBRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)NUMARG 55 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') IF(NUMARG.LE.0)GOTO59 DO56I=1,NUMARG WRITE(ICOUT,57)I,IHARG(I) 57 FORMAT('I,IHARG(I) = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') 56 CONTINUE 59 CONTINUE WRITE(ICOUT,61)NUMTRA 61 FORMAT('NUMTRA = ',I8) CALL DPWRST('XXX','BUG ') IF(NUMTRA.LE.0)GOTO69 DO62I=1,NUMTRA WRITE(ICOUT,63)I,ICTRA1(I),NCTRA1(I) 63 FORMAT('I,ICTRA1(I),NCTRA1(I) = ',I8,2X,A30,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)I,ICTRA2(I),NCTRA2(I) 64 FORMAT('I,ICTRA2(I),NCTRA2(I) = ',I8,2X,A30,I8) CALL DPWRST('XXX','BUG ') 62 CONTINUE 69 CONTINUE WRITE(ICOUT,81)IFOUND,IERROR 81 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************************************ C ** STEP 11-- ** C ** LOCATE THE LOCATION IN THE ARGUMENT LIST ** C ** OF THE WORD TO . ** C ************************************************ C ILOCTO=0 IF(NUMARG.LE.0)GOTO1120 DO1100I=1,NUMARG ILOCTO=I IF(IHARG(I).EQ.'TO ')GOTO1190 1100 CONTINUE C 1110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1111) 1111 FORMAT('***** ERROR IN SUBROUTINE DPTRAN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1112) 1112 FORMAT(' WHEN USING THE TRANSLATE COMMAND,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1113) 1113 FORMAT(' YOU MUST USE TO ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1114) 1114 FORMAT(' TO SEPARATE THE OLD STRING') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115) 1115 FORMAT(' FROM THE NEW STRING, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1116) 1116 FORMAT(' TRANSLATE ESC FF TO ESC ESC FF') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117) 1117 FORMAT(' PROBLEM-- TO WAS NOT FOUND.') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1120 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1121) 1121 FORMAT('***** ERROR IN SUBROUTINE DPTRAN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1122) 1122 FORMAT(' NO ARGUMENTS FOUND') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1123) 1123 FORMAT(' AFTER THE WORD TRANSLATE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1124)NUMARG 1124 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1190 CONTINUE C C *************************************************** C ** STEP 12-- ** C ** DETERMINE THE ELEMENT NUMBER FOR THE STRING ** C *************************************************** C I2=NUMTRA+1 IF(I2.LE.100)GOTO1290 C 1210 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1211) 1211 FORMAT('***** ERROR IN SUBROUTINE DPTRAN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1212) 1212 FORMAT(' WHEN USING THE TRANSLATE COMMAND,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1213) 1213 FORMAT(' YOU CAN HAVE AT MOST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1214) 1214 FORMAT(' 100 SEQUENCES TO TRANSLATE;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1215) 1215 FORMAT(' YOU HAVE JUST EXCEEDED 100.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1216)I2 1216 FORMAT(' I2 = ',I8) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1290 CONTINUE C C *************************************************** C ** STEP 21-- ** C ** EXTRACT THE INPUT SEQUENCE. ** C *************************************************** C ISTRIN(1:30)=' ' ICTRA1(I2)=ISTRIN(1:30) NCTRA1(I2)=0 C J=0 IMAX=ILOCTO-1 IF(IMAX.LE.0)GOTO2180 DO2100I=1,IMAX J=J+1 IC4=IHARG(I) C IC1=IC4(1:1) IF(IC4(1:3).EQ.'NUL')IC1=INULC IF(IC4(1:3).EQ.'SOH')IC1=ISOHC IF(IC4(1:3).EQ.'STX')IC1=ISTXC IF(IC4(1:3).EQ.'ETX')IC1=IETXC IF(IC4(1:3).EQ.'EOT')IC1=IEOTC IF(IC4(1:3).EQ.'ENQ')IC1=IENQC IF(IC4(1:3).EQ.'ACK')IC1=IACKC IF(IC4(1:3).EQ.'BEL')IC1=IBELC IF(IC4(1:2).EQ.'BS')IC1=IBSC IF(IC4(1:3).EQ.'HTX')IC1=IHTC IF(IC4(1:2).EQ.'LF')IC1=ILFC IF(IC4(1:2).EQ.'VT')IC1=IVTC IF(IC4(1:2).EQ.'FF')IC1=IFFC IF(IC4(1:2).EQ.'CR')IC1=ICRC IF(IC4(1:2).EQ.'SO')IC1=ISOC IF(IC4(1:2).EQ.'SI')IC1=ISIC IF(IC4(1:3).EQ.'DLE')IC1=IDLEC IF(IC4(1:3).EQ.'DC1')IC1=IDC1C IF(IC4(1:3).EQ.'DC2')IC1=IDC2C IF(IC4(1:3).EQ.'DC3')IC1=IDC3C IF(IC4(1:3).EQ.'DC4')IC1=IDC4C IF(IC4(1:3).EQ.'NAK')IC1=INAKC IF(IC4(1:3).EQ.'SYN')IC1=ISYNC IF(IC4(1:3).EQ.'ETB')IC1=IETBC IF(IC4(1:3).EQ.'CAN')IC1=ICANC IF(IC4(1:2).EQ.'EM')IC1=IEMC IF(IC4(1:3).EQ.'SUB')IC1=ISUBC IF(IC4(1:3).EQ.'ESC')IC1=IESCC IF(IC4(1:2).EQ.'FS')IC1=IFSC IF(IC4(1:2).EQ.'GS')IC1=IGSC IF(IC4(1:2).EQ.'RS')IC1=IRSC IF(IC4(1:2).EQ.'US')IC1=IUSC IF(IC4(1:2).EQ.'BL')IC1=' ' IF(IC4(1:3).EQ.'BLA')IC1=' ' IF(IC4(1:4).EQ.'BLAN')IC1=' ' IF(IC4(1:2).EQ.'SP')IC1=' ' IF(IC4(1:3).EQ.'SPA')IC1=' ' IF(IC4(1:4).EQ.'SPAC')IC1=' ' IF(IC4(1:4).EQ.'SEMI')IC1=';' C ISTRIN(J:J)=IC1 2100 CONTINUE GOTO2190 C 2180 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2181) 2181 FORMAT('***** ERROR IN SUBROUTINE DPTRAN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2182) 2182 FORMAT(' WHEN USING THE TRANSLATE COMMAND,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2183) 2183 FORMAT(' YOU CANNOT HAVE THE WORD TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2184) 2184 FORMAT(' AS THE FIRST ARGUMENT AFTER TRANSLATE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2185) 2185 FORMAT(' (YOU WOULD BE ATTEMPTING TO TRANSLATE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2186) 2186 FORMAT(' NOTHING TO SOMETHING).') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 2190 CONTINUE ICTRA1(I2)=ISTRIN(1:30) NCTRA1(I2)=J C C *************************************************** C ** STEP 22-- ** C ** EXTRACT THE OUTPUT SEQUENCE. ** C *************************************************** C ISTRIN(1:30)=' ' ICTRA2(I2)=ISTRIN(1:30) NCTRA2(I2)=0 C J=0 ILOCTP=ILOCTO+1 IF(ILOCTP.GT.NUMARG)GOTO2290 DO2200I=ILOCTP,NUMARG J=J+1 IC4=IHARG(I) C IC1=IC4(1:1) IF(IC4(1:3).EQ.'NUL')IC1=INULC IF(IC4(1:3).EQ.'SOH')IC1=ISOHC IF(IC4(1:3).EQ.'STX')IC1=ISTXC IF(IC4(1:3).EQ.'ETX')IC1=IETXC IF(IC4(1:3).EQ.'EOT')IC1=IEOTC IF(IC4(1:3).EQ.'ENQ')IC1=IENQC IF(IC4(1:3).EQ.'ACK')IC1=IACKC IF(IC4(1:3).EQ.'BEL')IC1=IBELC IF(IC4(1:2).EQ.'BS')IC1=IBSC IF(IC4(1:3).EQ.'HTX')IC1=IHTC IF(IC4(1:2).EQ.'LF')IC1=ILFC IF(IC4(1:2).EQ.'VT')IC1=IVTC IF(IC4(1:2).EQ.'FF')IC1=IFFC IF(IC4(1:2).EQ.'CR')IC1=ICRC IF(IC4(1:2).EQ.'SO')IC1=ISOC IF(IC4(1:2).EQ.'SI')IC1=ISIC IF(IC4(1:3).EQ.'DLE')IC1=IDLEC IF(IC4(1:3).EQ.'DC1')IC1=IDC1C IF(IC4(1:3).EQ.'DC2')IC1=IDC2C IF(IC4(1:3).EQ.'DC3')IC1=IDC3C IF(IC4(1:3).EQ.'DC4')IC1=IDC4C IF(IC4(1:3).EQ.'NAK')IC1=INAKC IF(IC4(1:3).EQ.'SYN')IC1=ISYNC IF(IC4(1:3).EQ.'ETB')IC1=IETBC IF(IC4(1:3).EQ.'CAN')IC1=ICANC IF(IC4(1:2).EQ.'EM')IC1=IEMC IF(IC4(1:3).EQ.'SUB')IC1=ISUBC IF(IC4(1:3).EQ.'ESC')IC1=IESCC IF(IC4(1:2).EQ.'FS')IC1=IFSC IF(IC4(1:2).EQ.'GS')IC1=IGSC IF(IC4(1:2).EQ.'RS')IC1=IRSC IF(IC4(1:2).EQ.'US')IC1=IUSC IF(IC4(1:2).EQ.'BL')IC1=' ' IF(IC4(1:3).EQ.'BLA')IC1=' ' IF(IC4(1:4).EQ.'BLAN')IC1=' ' IF(IC4(1:2).EQ.'SP')IC1=' ' IF(IC4(1:3).EQ.'SPA')IC1=' ' IF(IC4(1:4).EQ.'SPAC')IC1=' ' IF(IC4(1:4).EQ.'SEMI')IC1=';' C ISTRIN(J:J)=IC1 2200 CONTINUE C 2290 CONTINUE ICTRA2(I2)=ISTRIN(1:30) NCTRA2(I2)=J IF(I2.GT.NUMTRA)NUMTRA=I2 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'DEFI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('AT THE END OF DPTRAN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IBUGS2,ISUBRO 9013 FORMAT('IBUGS2,ISUBRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)NUMARG 9015 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') IF(NUMARG.LE.0)GOTO9019 DO9016I=1,NUMARG WRITE(ICOUT,9017)I,IHARG(I) 9017 FORMAT('I,IHARG(I) = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') 9016 CONTINUE 9019 CONTINUE WRITE(ICOUT,9021)I2,NUMTRA 9021 FORMAT('I2,NUMTRA = ',2I8) CALL DPWRST('XXX','BUG ') IF(NUMTRA.LE.0)GOTO9029 DO9022I=1,NUMTRA WRITE(ICOUT,9023)I,ICTRA1(I),NCTRA1(I) 9023 FORMAT('I,ICTRA1(I),NCTRA1(I) = ',I8,2X,A30,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)I,ICTRA2(I),NCTRA2(I) 9024 FORMAT('I,ICTRA2(I),NCTRA2(I) = ',I8,2X,A30,I8) CALL DPWRST('XXX','BUG ') 9022 CONTINUE 9029 CONTINUE WRITE(ICOUT,9051)IFOUND,IERROR 9051 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPOPMS(IANS,IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR) C C PURPOSE--SEND A MESSAGE TO THE HOST CONSOLE OPERATOR. 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--86/1 C ORIGINAL VERSION--NOVEMBER 1980. C UPDATED --MAY 1982. C UPDATED --JANUARY 1986. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IANS CHARACTER*4 IBUGS2 CHARACTER*4 ISUBRO CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*4 ISTAT C CHARACTER*80 ICANS CHARACTER*80 ISTRIN C DIMENSION IANS(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOF2.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPOP' ISUBN2='MS ' C IFOUND='YES' IERROR='NO' C IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'OPMS')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPOPMS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR 53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IWIDTH 54 FORMAT('IWIDTH = ',I8) CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,55)(IANS(I),I=1,IWIDTH) 55 FORMAT('(IANS(I),I=1,IWIDTH) = ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') 90 CONTINUE C C **************************** C ** STEP 13-- ** C ** EXTRACT THE MESSAGE ** C **************************** C ISTEPN='13' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIL') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C DO1310I=1,80 ICANS(I:I)=IANS(I) 1310 CONTINUE C ISTART=1 ISTOP=IWIDTH IWORD=2 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C J=0 IF(ICOL1.GT.IWIDTH)GOTO1339 DO1330I=ICOL1,IWIDTH J=J+1 ISTRIN(J:J)=ICANS(I:I) 1330 CONTINUE NCSTRI=J 1339 CONTINUE C CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR) IF(IERROR.EQ.'YES')GOTO9000 NCSTRI=JMAX C IF(NCSTRI.GE.1)GOTO1349 IERROR='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1341) 1341 FORMAT('***** ERROR IN DPOPMS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1342) 1342 FORMAT(' A MESSAGE IS REQUIRED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1343) 1343 FORMAT(' IN THE OPERATOR COMMAND') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1344) 1344 FORMAT(' (FOR EXAMPLE, OPERATOR HOW DO I GENERATE ', 1'3-D PLOTS?)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1346) 1346 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1347)(IANS(I),I=1,IWIDTH) 1347 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IF(IWIDTH.LE.0)WRITE(ICOUT,999) IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ') GOTO9000 1349 CONTINUE C 1390 CONTINUE C C ********************************************** C ** STEP 14-- ** C ** IF THE NEEDED SYSTEM CALL ** C ** EXISTS AT THIS COMPUTER INSTALLATION, ** C ** THEN HAVE THE DATAPLOT IMPLEMENTOR ** C ** ENTER THE CODE FOR SUCH A CALL. ** C ** IF THE NEEDED SYSTEM CALL ** C ** DOES NOT EXIST (THE DEFAULT) AT THIS ** C ** COMPUTER INSTALLATION, ** C ** THEN WRITE OUT AN ERROR MESSAGE. ** C ********************************************** C ISTEPN='12' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'OPMS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ISTAT='NONE' C IF(ISTAT.EQ.'NONE')GOTO1200 GOTO1290 1200 CONTINUE IERROR='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1211) 1211 FORMAT('***** ERROR IN DPOPMS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1212) 1212 FORMAT(' THE ENTERED MESSAGE TO THE OPERATOR') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1213) 1213 FORMAT(' CANNOT BE SENT BECAUSE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1214) 1214 FORMAT(' THE REQUIRED CALL TO A SYSTEM-DEPENDENT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1215) 1215 FORMAT(' ROUTINE TO SEND SUCH MESSAGES') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1216) 1216 FORMAT(' HAS NOT BEEN IMPLEMENTED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1217) 1217 FORMAT(' AT THIS INSTALLATION.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1218)ISTAT 1218 FORMAT(' ISTAT = ',A12) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1221) 1221 FORMAT(' PLEASE REQUEST THE IMPLEMENTOR') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1222) 1222 FORMAT(' TO ENTER THE CODE INTO THIS SUBROUTINE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1223) 1223 FORMAT(' (DPOPMS) TO CALL SUCH A SYSTEM-DEPENDENT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1224) 1224 FORMAT(' ROUTINE.') CALL DPWRST('XXX','BUG ') GOTO9000 1290 CONTINUE C CCCCC CALL XXX(ISTRIN,NCSTRI) C C **************** C ** STEP 90-- ** C ** EXIT. ** C **************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'OPMS')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPOPMS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,9031)ISUBN0 C9031 FORMAT('ISUBN0 = ',A12) CCCCC CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9041)IWIDTH 9041 FORMAT('IWIDTH = ',I8) CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,9042)(IANS(I),I=1,IWIDTH) 9042 FORMAT('(IANS(I),I=1,IWIDTH) = ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9043)NCSTRI 9043 FORMAT('NCSTRI = ',I8) CALL DPWRST('XXX','BUG ') IF(NCSTRI.GE.1)WRITE(ICOUT,9044)(ISTRIN(I:I),I=1,NCSTRI) 9044 FORMAT('(ISTRIN(I:I),I=1,NCSTRI) = ',80A1) IF(NCSTRI.GE.1)CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPUPPE(IA,IWIDTH,IB,IBUGMA,IERROR) C C PURPOSE--CONVERT LOWER CASE ALPHABETIC (A TO Z) ASCII CHARACTERS C TO UPPER CASE ASCII CHARACTERS. C DO SO FOR EACH OF THE IWIDTH CHARACTERS C IN THE CHARACTER ARRAY IA(.). C IT IS ASSUMED THAT IA IS CHARACTER*4 C AND HAS 1 CHARACTER (LEFT-JUSTIFIED) PER WORD. C C INPUT ARGUMENTS--IA = HOLLERITH ARRAY WITH 1 CHARACTER PER WORD C IWIDTH = INTEGER NUMBER OF WORDS IN IA. C IBUGMA = HOLLERITH BUG (= TRACE) VARIABLE C IERROR = HOLLERITH VARIABLE C OUTPUT ARGUMENTS--IB = HOLLERITH ARRAY WITH 1 CHARACTER PER WORD C C NOTE--IF SO DESIRED, THE CALLING SEQUENCE FOR DPUPPE C MAY HAVE IB(.) IDENTICAL TO IA(.). 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--82/7 C ORIGINAL VERSION--JANUARY 1981. C UPDATED --MAY 1982. C UPDATED --OCTOBER 1991. ONLY FIRST CHARACTER WAS C BEING CONVERTED. FIX. C EXTENSIVELY MODIFIED. ALAN C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IA CHARACTER*4 IB C CHARACTER*1 IA1 CHARACTER*1 IB1 C CHARACTER*4 IBUGMA CHARACTER*4 IERROR C CCCCC CHARACTER*4 IA4 C C--------------------------------------------------------------------- C DIMENSION IA(*) DIMENSION IB(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGMA.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPUPPE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IWIDTH,IBUGMA,IERROR 52 FORMAT('IWIDTH,IBUGMA,IERROR = ',I8,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)(IA(I),I=1,MIN(100,IWIDTH)) 53 FORMAT('(IA(I),I=1,IWIDTH) = ',100A1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)(IB(I),I=1,MIN(100,IWIDTH)) 54 FORMAT('(IB(I),I=1,IWIDTH) = ',100A1) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C **************************************************************** C ** THE FOLLOWING CODE WILL CARRY OUT THE LOWER CASE C ** TO UPPER CASE CONVERSION FOR ALL COMPUTERS C ** WITH AN ANSI 77 FORTRAN COMPILER--IT MAKES C ** USE OF THE ANSI FORTRAN 77 INTRINSIC FUNCTIONS C ** 1) ICHAR (FOR ASCII CHARACTER TO ASCII NUMERIC CONVERSION C ** 2) CHAR (FOR ASCII NUMERIC TO ASCII CHARACTER CONVERSIO C **************************************************************** C C IF(IWIDTH.LE.0)GOTO9000 DO100I=1,IWIDTH C C OCTOBER, 1991. ADD INNER LOOP (I.E., J LOOP) DO200J=1,4 IA1=IA(I)(J:J) CCCCC IVALUE=ICHAR(IA1) CALL DPCOAN(IA1,IVALUE) IF(97.LE.IVALUE.AND.IVALUE.LE.122)GOTO110 GOTO120 C 110 CONTINUE IVAM32=IVALUE-32 CCCCC IB1=CHAR(IVAM32) CALL DPCONA(IVAM32,IB1) IB(I)(J:J)=IB1 GOTO200 C 120 CONTINUE IB(I)(J:J)=IA(I)(J:J) GOTO200 C 200 CONTINUE 100 CONTINUE C GOTO9000 C C **************************************************************** C ** CONVERSION TO UPPER CASE FOR THE UNIVAC 1100 SERIES. FTN COM C **************************************************************** C CCCCC IF(IWIDTH.LE.0)GOTO1190 CCCCC DO1100I=1,IWIDTH CCCCC IA4=IA(I) CCCCC IB(I)=UPPERC(IA4) C1100 CONTINUE C1190 CONTINUE CCCCC GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGMA.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPUPPE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IWIDTH,IBUGMA,IERROR 9012 FORMAT('IWIDTH,IBUGMA,IERROR = ',I8,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)(IA(I),I=1,MIN(100,IWIDTH)) 9013 FORMAT('(IA(I),I=1,IWIDTH) = ',100A1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)(IB(I),I=1,MIN(100,IWIDTH)) 9014 FORMAT('(IB(I),I=1,IWIDTH) = ',100A1) CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,9015)IA4,IA4 C9015 FORMAT('IA4,IA4 = ',A1,2X,A4) CCCCC CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPNONP(IA,IWIDTH,IB,IBUGMA,IERROR) C C PURPOSE--CONVERT NON-PRINTING CHARACTERS TO SPACES C INPUT ARGUMENTS--IA = HOLLERITH ARRAY WITH 1 CHARACTER PER WORD C IWIDTH = INTEGER NUMBER OF WORDS IN IA. C IBUGMA = HOLLERITH BUG (= TRACE) VARIABLE C IERROR = HOLLERITH VARIABLE C OUTPUT ARGUMENTS--IB = HOLLERITH ARRAY WITH 1 CHARACTER PER WORD C C NOTE--IF SO DESIRED, THE CALLING SEQUENCE FOR DPNONP C MAY HAVE IB(.) IDENTICAL TO IA(.). 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--93/10 C ORIGINAL VERSION--OCTOBER 1993 C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IA CHARACTER*4 IB C CHARACTER*1 IA1 C CHARACTER*4 IBUGMA CHARACTER*4 IERROR C CHARACTER*4 IFLAG C C--------------------------------------------------------------------- C DIMENSION IA(*) DIMENSION IB(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGMA.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPNONP--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IWIDTH,IBUGMA,IERROR 52 FORMAT('IWIDTH,IBUGMA,IERROR = ',I8,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)(IA(I),I=1,IWIDTH) 53 FORMAT('(IA(I),I=1,IWIDTH) = ',100A1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)(IB(I),I=1,IWIDTH) 54 FORMAT('(IB(I),I=1,IWIDTH) = ',100A1) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ****************************************************** C ** THE FOLLOWING CODE WILL CONVERT NON_PRINTING ** C ** CHARACTERS TO SPACES. ** C ****************************************************** C C IF(IWIDTH.LE.0)GOTO9000 IFLAG='ON' DO100I=1,IWIDTH C DO200J=1,4 IA1=IA(I)(J:J) CALL DPCOAN(IA1,IVALUE) IF(IFLAG.EQ.'ON')THEN IF(IVALUE.LE.31.OR.IVALUE.GE.128)GOTO130 IF(IVALUE.EQ.34.OR.IVALUE.EQ.39)IFLAG='OFF' ENDIF GOTO120 C 120 CONTINUE IB(I)(J:J)=IA(I)(J:J) GOTO200 CCCCC ADDED FOLLOWING SECTION OCTOBER 1993. 130 CONTINUE IB(I)(J:J)=' ' GOTO200 C 200 CONTINUE 100 CONTINUE C GOTO9000 C C **************************************************************** C ** CONVERSION TO UPPER CASE FOR THE UNIVAC 1100 SERIES. FTN COM C **************************************************************** C CCCCC IF(IWIDTH.LE.0)GOTO1190 CCCCC DO1100I=1,IWIDTH CCCCC IA4=IA(I) CCCCC IB(I)=UPPERC(IA4) C1100 CONTINUE C1190 CONTINUE CCCCC GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGMA.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPNONP--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IWIDTH,IBUGMA,IERROR 9012 FORMAT('IWIDTH,IBUGMA,IERROR = ',I8,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)(IA(I),I=1,IWIDTH) 9013 FORMAT('(IA(I),I=1,IWIDTH) = ',100A1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)(IB(I),I=1,IWIDTH) 9014 FORMAT('(IB(I),I=1,IWIDTH) = ',100A1) CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,9015)IA4,IA4 C9015 FORMAT('IA4,IA4 = ',A1,2X,A4) CCCCC CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPUPP4(IA4,IB4,IBUGMA,IERROR) C C PURPOSE--CONVERT 4-CHARACTER LOWER CASE ALPHABETIC (A TO Z) C ASCII WORD IA4 C TO UPPER CASE ASCII WORD IB4. C NOTE--IA4 AND IB4 ARE ASSUMED TO BE CHARACTER*4 C NOTE--IA4 AND IB4 MAY BE THE SAME VARIABLE IN THE CALLING ROUTINE. C WRITTEN BY--JAMES J. FILLIBEN C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--86/9 C ORIGINAL VERSION--AUGUST 1986. C C--------------------------------------------------------------------- C CHARACTER*4 IA4 CHARACTER*4 IB4 CHARACTER*4 IBUGMA CHARACTER*4 IERROR C CHARACTER*1 IA1 CHARACTER*1 IB1 C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGMA.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPUPP4--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IA4 52 FORMAT('IA4 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGMA,IERROR 53 FORMAT('IBUGMA,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************************************************** C ** STEP 11-- C ** THE FOLLOWING CODE WILL CARRY OUT THE LOWER CASE C ** TO UPPER CASE CONVERSION FOR ALL COMPUTERS C ** WITH AN ANSI 77 FORTRAN COMPILER--IT MAKES C ** USE OF THE ANSI FORTRAN 77 INTRINSIC FUNCTIONS C ** 1) ICHAR (FOR ASCII CHARACTER TO ASCII NUMERIC CO C ** 2) CHAR (FOR ASCII NUMERIC TO ASCII CHARACTER CO C ******************************************************** C IB4=IA4 C IA1=' ' IB1=' ' C DO1100I=1,4 C IA1=IA4(I:I) IVALUE=ICHAR(IA1) IF(97.LE.IVALUE.AND.IVALUE.LE.122)GOTO1110 GOTO1100 C 1110 CONTINUE IVAM32=IVALUE-32 IB1=CHAR(IVAM32) IB4(I:I)=IB1 GOTO1100 C 1100 CONTINUE C GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGMA.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPUPP4--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IA4,IA1,IB1,IB4 9012 FORMAT('IA4,IA1,IB1,IB4 = ',A4,2X,A1,2X,A1,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IBUGMA,IERROR 9013 FORMAT('IBUGMA,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPUPNT(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN, 1IVSTAR,IVSTOP,MAXNAM,NUMNAM,V,MAXN,MAXCOL,NUMCOL, 1IBUGS2,IERROR) C C PURPOSE--HANDLE THE CASE IN WHICH ARBITRARY ENTRIES HAVE C BEEN EARMARKED FOR DELETION IN THE NAME TABLE C (BY IN(.) BEING SET TO NON-POSITIVE) C AND SO ENTIRES C MUST BE SHIFTED TO AVOID HOLES IN THE TABLE. C UPDATE HOUSEKEEPING TABLES ACCORDINGLY. 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--89/1 C ORIGINAL VERSION--DECEMBER 1988. C UPDATED --NOVEMBER 1998. BUG FIX. ONLY DELETE IF C IN(.) IS NEGATIVE C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IHNAME CHARACTER*4 IHNAM2 CHARACTER*4 IUSE CHARACTER*4 IBUGS2 CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C DIMENSION IHNAME(*) DIMENSION IHNAM2(*) DIMENSION IUSE(*) DIMENSION IVALUE(*) DIMENSION VALUE(*) DIMENSION IN(*) DIMENSION IVSTAR(*) DIMENSION IVSTOP(*) C DIMENSION V(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPUP' ISUBN2='NT ' C IERROR='NO' C IF(IBUGS2.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPUPNT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGS2,IERROR 52 FORMAT('IBUGS2,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)MAXNAM,NUMNAM 53 FORMAT('MAXNAM,NUMNAM = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)MAXN,MAXCOL,NUMCOL 54 FORMAT('MAXN,MAXCOL,NUMCOL = ',3I8) CALL DPWRST('XXX','BUG ') DO60I=1,NUMNAM WRITE(ICOUT,61)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) 61 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ', 1I8,2X,A4,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) 62 FORMAT('I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) = ', 1I8,2X,A4,A4,6X,I8,I8,I8) CALL DPWRST('XXX','BUG ') 60 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO70J=1,NUMCOL IJ=MAXN*(J-1)+1 WRITE(ICOUT,71)J,MAXN,IJ,V(IJ) 71 FORMAT('J,MAXN,IJ,V(IJ) = ',I8,I8,I8,E15.7) CALL DPWRST('XXX','BUG ') 70 CONTINUE 90 CONTINUE C C ********************************************* C ** STEP 1-- ** C ** UPDATE THE HOUSEKEEPING TABLES. ** C ** ELIMINATE ANY ENTRIES IN THESE TABLES ** C ** WHICH HAVE LENGTH OF VARIABLE = NON-POSITIVE; ** C ** THAT IS, WHICH HAVE IN(.) = NON-POSITIVE. ** C ********************************************* C ISTEPN='1' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMNAM.LE.0)GOTO1129 J=0 1101 CONTINUE J=J+1 IF(J.GT.NUMNAM)GOTO1129 IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.' ')GOTO1100 IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.' ')GOTO1100 IF(IHNAME(J).EQ.'YPLO'.AND.IHNAM2(J).EQ.'T ')GOTO1100 IF(IHNAME(J).EQ.'XPLO'.AND.IHNAM2(J).EQ.'T ')GOTO1100 IF(IHNAME(J).EQ.'X2PL'.AND.IHNAM2(J).EQ.'OT ')GOTO1100 IF(IHNAME(J).EQ.'TAGP'.AND.IHNAM2(J).EQ.'LOT ')GOTO1100 CCCCC BUG FIX. ONLY DELETE IF NEGATIVE. STRINGS AND PARAMETERS CCCCC ARE ZERO BY DEFAULT, DON'T NECCESSARILY WANT TO DELETE. 11/98. CCCCC IF(IN(J).LE.0)GOTO1109 IF(IN(J).LT.0)GOTO1109 GOTO1100 1109 CONTINUE C JP1=J+1 IF(JP1.GT.NUMNAM)GOTO1119 DO1110K=JP1,NUMNAM KM1=K-1 IHNAME(KM1)=IHNAME(K) IHNAM2(KM1)=IHNAM2(K) IUSE(KM1)=IUSE(K) IVALUE(KM1)=IVALUE(K) VALUE(KM1)=VALUE(K) IN(KM1)=IN(K) IVSTAR(KM1)=IVSTAR(K) IVSTOP(KM1)=IVSTOP(K) 1110 CONTINUE 1119 CONTINUE NUMNAM=NUMNAM-1 J=J-1 C 1100 CONTINUE GOTO1101 1129 CONTINUE C C ************************************************ C ** STEP 2-- ** C ** DETERMINE THE LARGEST COLUMN REFERENCED. ** C ************************************************ C ISTEPN='2' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICOLMX=0 IF(NUMNAM.LE.0)GOTO2159 DO2150J=1,NUMNAM IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.' ')GOTO2150 IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.' ')GOTO2150 IF(IHNAME(J).EQ.'YPLO'.AND.IHNAM2(J).EQ.'T ')GOTO2150 IF(IHNAME(J).EQ.'XPLO'.AND.IHNAM2(J).EQ.'T ')GOTO2150 IF(IHNAME(J).EQ.'X2PL'.AND.IHNAM2(J).EQ.'OT ')GOTO2150 IF(IHNAME(J).EQ.'TAGP'.AND.IHNAM2(J).EQ.'LOT ')GOTO2150 IF(IUSE(J).EQ.'V'.AND.IVALUE(J).GT.ICOLMX)ICOLMX=IVALUE(J) 2150 CONTINUE 2159 CONTINUE C C ******************************************************* C ** STEP 3-- ** C ** TREAT THE CASE WHERE THERE IS AT LEAST ** C ** 1 VARIABLE IN THE DATA ARRAY WHICH MAY ** C ** (AT LEAST POTENTIALLY) BE SHIFTED (COMPRESSED). ** C ******************************************************* C ISTEPN='3' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICODE=0 NUMCO2=NUMCOL IF(ICOLMX.LE.0)GOTO3900 DO3300ICOL=1,ICOLMX C IPASS=0 IF(NUMNAM.LE.0)GOTO3900 DO3400J=1,NUMNAM IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.' ')GOTO3400 IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.' ')GOTO3400 IF(IHNAME(J).EQ.'YPLO'.AND.IHNAM2(J).EQ.'T ')GOTO3400 IF(IHNAME(J).EQ.'XPLO'.AND.IHNAM2(J).EQ.'T ')GOTO3400 IF(IHNAME(J).EQ.'X2PL'.AND.IHNAM2(J).EQ.'OT ')GOTO3400 IF(IHNAME(J).EQ.'TAGP'.AND.IHNAM2(J).EQ.'LOT ')GOTO3400 IF(IUSE(J).EQ.'V'.AND.IVALUE(J).EQ.ICOL)GOTO3450 GOTO3400 C 3450 CONTINUE IPASS=IPASS+1 IF(IPASS.EQ.1)ICODE=ICODE+1 IF(IPASS.EQ.1)GOTO3460 GOTO3470 C 3460 CONTINUE IF(IVALUE(J).EQ.ICODE)GOTO3490 ICOLOL=IVALUE(J) C IMAX=MAXN DO3461I=1,IMAX IJ=MAXN*(ICODE-1)+I V(IJ)=CPUMIN 3461 CONTINUE C IMAX=IN(J) DO3462I=1,IMAX IJ=MAXN*(ICODE-1)+I IJOL=MAXN*(ICOLOL-1)+I V(IJ)=V(IJOL) 3462 CONTINUE C IMAX=MAXN DO3463I=1,IMAX IJOL=MAXN*(ICOLOL-1)+I V(IJOL)=CPUMIN 3463 CONTINUE C GOTO3470 C 3470 CONTINUE IVALUE(J)=ICODE VALUE(J)=IVALUE(J) IVSTAR(J)=MAXN*(ICODE-1)+1 IVSTOP(J)=MAXN*(ICODE-1)+IN(J) C 3490 CONTINUE 3400 CONTINUE 3300 CONTINUE 3900 CONTINUE NUMCOL=ICODE C C ***************************************** C ** STEP 4-- ** C ** TREAT THE CASE WHERE NO VARIABLES ** C ** REMAIN IN THE DATA ARRAY. ** C ***************************************** C ISTEPN='4' IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICOLMX.LE.0)GOTO4100 GOTO4900 4100 CONTINUE IF(NUMCO2.LE.0)GOTO4900 DO4200J=1,NUMCO2 DO4300I=1,MAXN IJ=MAXN*(J-1)+I V(IJ)=CPUMIN 4300 CONTINUE 4200 CONTINUE 4900 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPUPNT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGS2,IERROR 9012 FORMAT('IBUGS2,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)MAXNAM,NUMNAM 9013 FORMAT('MAXNAM,NUMNAM = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)MAXN,MAXCOL,NUMCOL 9014 FORMAT('MAXN,MAXCOL,NUMCOL = ',3I8) CALL DPWRST('XXX','BUG ') DO9020I=1,NUMNAM WRITE(ICOUT,9021)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) 9021 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ', 1I8,2X,A4,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) 9022 FORMAT('I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I) = ', 1I8,2X,A4,A4,6X,I8,I8,I8) CALL DPWRST('XXX','BUG ') 9020 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO9030J=1,NUMCOL IJ=MAXN*(J-1)+1 WRITE(ICOUT,9031)J,MAXN,IJ,V(IJ) 9031 FORMAT('J,MAXN,IJ,V(IJ) = ',I8,I8,I8,E15.7) CALL DPWRST('XXX','BUG ') 9030 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPUP80(IA,IB,IBUGS2,IERROR) C C PURPOSE--FOR THE CHARACTER*80 VARIABLE IA, C CONVERT LOWER CASE ALPHABETIC (A TO Z) ASCII CHARACTERS C TO UPPER CASE ASCII CHARACTERS. C DO SO FOR ALL 80 CHARACTERS. C DO SO FOR STRLEZ(IA) C C INPUT ARGUMENTS--IA = CHARACTER*80 VARIABLE C IBUGS2 = HOLLERITH BUG (= TRACE) VARIABLE C IERROR = HOLLERITH VARIABLE C OUTPUT ARGUMENTS--IB = CHARACTER*80 VARIABLE C NOTE--IT IS PERMISSIBLE FOR IB TO BE THE SAME AS IA C C NOTE--IF SO DESIRED, THE CALLING SEQUENCE FOR DPUP80 C MAY HAVE IB IDENTICAL TO IA. 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--87/11 C ORIGINAL VERSION--OCTOBER 1987. C UPDATED --MARCH 1992. OTG COMPILER ERROR C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*80 IA CHARACTER*80 IB C CHARACTER*1 IA1 CHARACTER*1 IB1 C CHARACTER*4 IBUGS2 CHARACTER*4 IERROR C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C CCCCC THE FOLLOWING LINE WAS FIXED MARCH 1992 CCCCC IWIDTH=80 CALL STRLEZ(IA,IWIDTH) C IF(IBUGS2.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPUP80--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGS2,IERROR 52 FORMAT('IBUGS2,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IA 53 FORMAT('IA = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IB 54 FORMAT('IB = ',A80) CALL DPWRST('XXX','BUG ') CALL STRLEZ(IA,NIA) WRITE(ICOUT,55)NIA 55 FORMAT('NIA = ',I8) CALL DPWRST('XXX','BUG ') CALL STRLEZ(IB,NIB) WRITE(ICOUT,56)NIB 56 FORMAT('NIB = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,57)IWIDTH 57 FORMAT('IWIDTH = ',I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C **************************************************************** C ** THE FOLLOWING CODE WILL CARRY OUT THE LOWER CASE C ** TO UPPER CASE CONVERSION FOR ALL COMPUTERS C ** WITH AN ANSI 77 FORTRAN COMPILER--IT MAKES C ** USE OF THE ANSI FORTRAN 77 INTRINSIC FUNCTIONS C ** 1) ICHAR (FOR ASCII CHARACTER TO ASCII NUMERIC CONVERSION C ** 2) CHAR (FOR ASCII NUMERIC TO ASCII CHARACTER CONVERSIO C **************************************************************** C DO100I=1,IWIDTH C IA1=IA(I:I) CCCCC IVALUE=ICHAR(IA1) CALL DPCOAN(IA1,IVALUE) IF(97.LE.IVALUE.AND.IVALUE.LE.122)GOTO110 GOTO120 C 110 CONTINUE IVAM32=IVALUE-32 CCCCC IB1=CHAR(IVAM32) CALL DPCONA(IVAM32,IB1) IB(I:I)=IB1 GOTO100 C 120 CONTINUE IF(IBUGS2.EQ.'ON')WRITE(ICOUT,777)I,IA1,IB(I:I) 777 FORMAT('I,IA1,IB(I:I) = ',I8,2X,A1,2X,A1) IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS CHANGED--OTG COMPILER ERROR MARCH 1992 CCCCC IB(I:I)=IA(I:I) IB(I:I)=IA1 GOTO100 C 100 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPUP80--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IWIDTH,IBUGS2,IERROR 9012 FORMAT('IWIDTH,IBUGS2,IERROR = ',I8,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IA 9013 FORMAT('IA = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IB 9014 FORMAT('IB = ',A80) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPLO80(IA,IB,IBUGS2,IERROR) C C PURPOSE--FOR THE CHARACTER*80 VARIABLE IA, C CONVERT UPPER CASE ALPHABETIC (A TO Z) ASCII CHARACTERS C TO LOWER CASE ASCII CHARACTERS. C DO SO FOR ALL 80 CHARACTERS. C C INPUT ARGUMENTS--IA = CHARACTER*80 VARIABLE C IBUGS2 = HOLLERITH BUG (= TRACE) VARIABLE C IERROR = HOLLERITH VARIABLE C OUTPUT ARGUMENTS--IA = CHARACTER*80 VARIABLE C C NOTE--IF SO DESIRED, THE CALLING SEQUENCE FOR DPLO80 C MAY HAVE IB IDENTICAL TO IA. 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--87/11 C ORIGINAL VERSION--OCTOBER 1987. C UPDATED --JANUARY 1988. MISSING COMMON IN FORMAT 52 C UPDATED --APRIL 1989. CORRECTED RANGE FOR UPPER CASE C UPDATED --AUGUST 1990. OTG COMPILER ERROR? C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*80 IA CHARACTER*80 IB C CHARACTER*1 IA1 CHARACTER*1 IB1 C CHARACTER*4 IBUGS2 CHARACTER*4 IERROR C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C CCCCC THE FOLLOWING LINE WAS FIXED MARCH 1992 CCCCC IWIDTH=80 CALL STRLEZ(IA,IWIDTH) C IF(IBUGS2.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPLO80--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGS2,IERROR 52 FORMAT('IBUGS2,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IA 53 FORMAT('IA = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IB 54 FORMAT('IB = ',A80) CALL DPWRST('XXX','BUG ') CALL STRLEZ(IA,NIA) WRITE(ICOUT,55)NIA 55 FORMAT('NIA = ',I8) CALL DPWRST('XXX','BUG ') CALL STRLEZ(IB,NIB) WRITE(ICOUT,56)NIB 56 FORMAT('NIB = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,57)IWIDTH 57 FORMAT('IWIDTH = ',I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C **************************************************************** C ** THE FOLLOWING CODE WILL CARRY OUT THE UPPER CASE C ** TO LOWER CASE CONVERSION FOR ALL COMPUTERS C ** WITH AN ANSI 77 FORTRAN COMPILER--IT MAKES C ** USE OF THE ANSI FORTRAN 77 INTRINSIC FUNCTIONS C ** 1) ICHAR (FOR ASCII CHARACTER TO ASCII NUMERIC CONVERSION C ** 2) CHAR (FOR ASCII NUMERIC TO ASCII CHARACTER CONVERSIO C **************************************************************** C DO100I=1,IWIDTH C IA1=IA(I:I) CCCCC IVALUE=ICHAR(IA1) CALL DPCOAN(IA1,IVALUE) CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1989 CCCCC IF(97.LE.IVALUE.AND.IVALUE.LE.122)GOTO110 IF(65.LE.IVALUE.AND.IVALUE.LE.90)GOTO110 GOTO120 C 110 CONTINUE IVAP32=IVALUE+32 CCCCC IB1=CHAR(IVAP32) CALL DPCONA(IVAP32,IB1) IB(I:I)=IB1 GOTO100 C 120 CONTINUE CCCCC THE FOLLOWING LINE WAS CHANGED--OTG COMPILER ERROR AUG 1990 CCCCC IB(I:I)=IA(I:I) IB(I:I)=IA1 GOTO100 C 100 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPLO80--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IWIDTH,IBUGS2,IERROR 9012 FORMAT('IWIDTH,IBUGS2,IERROR = ',I8,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IA 9013 FORMAT('IA = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IB 9014 FORMAT('IB = ',A80) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPSET(ILISMX,IREPCH,IOSW, 1IPPDE1,IPPDE2, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IBUGEX,IBUGE2,IBUGHE,IBUGH2,IBUGLO, CCCCC AUGUST 1995. ADD IFTORD 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 THE FOLLOWING LINE WAS ADDED APRIL 1995 1IUNFOF,IUNFNR,IUNFMC, CCCCC THE FOLLOWING LINE WAS ADDED MARCH 1996 CCCCC1IRHSTG, 1IFOUND,IERROR) C C PURPOSE--SET AND WRITE OUT THE VALUE C OF CERTAIN FORTRAN VARIABLES IN COMMON. C NOTE--THIS CAPABILITY IS USEFUL FOR IMPLEMENTATION AND DEBUGGING. C INPUT ARGUMENTS--NONE C OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-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--82/7 C ORIGINAL VERSION--OCTOBER 1981. C UPDATED --NOVEMBER 1981. C UPDATED --MAY 1982. C UPDATED --FEBRUARY 1986. C UPDATED --SEPTEMBER 1986. (SET HELP LINES) C UPDATED --SEPTEMBER 1986. (SET FOURIER EXPONENT) C UPDATED --OCTOBER 1986. (SET WRITE DECIMALS SWITCH) C UPDATED --NOVEMBER 1987. (WRITE DEPENDS ON FEEDBACK) C UPDATED --JANUARY 1988. (SET GENERAL JUSTIFICATION) C (SET GENERAL REGION FILL) C (SET GENERAL PEN WIDTH) C (SET GENERAL PEN THICKNESS) C UPDATED --MARCH 1988. (SET READ FORMAT) C UPDATED --MAY 1988. (SET QMS/QUIC FONT) C (SET QMS/QUIC LANDSCAPE MARGINS) C (SET QMS/QUIC PORTRAIT MARGINS) C (SET QMS/QUIC PPI) C UPDATED --AUGUST 1988 (SET POSTSCRIPT FONT) C (SET POSTSCRIPT LANDSCAPE MARGINS) C (SET POSTSCRIPT PORTRAIT MARGINS) C (SET POSTSCRIPT PPI) C (SET CALCOMP COLORS) C (SET CALCOMP WIDTH) C (SET ZETA COLORS) C (SET ZETA WIDTH) C UPDATED --DECEMBER 1988. (SET WRITE FORMAT) C UPDATED --DECEMBER 1988. (SET READ REWIND) C UPDATED --DECEMBER 1988. (CORRECTED READ FORMAT IF SPACES) C UPDATED --DECEMBER 1988. (SET WRITE REWIND) C UPDATED --APRIL 1989. SOFT-CODE BACKSLASH FOR UNIX C UPDATED --MAY 1989. ALLOW SPELLED-OUT POSTSCRIPT FONTS C UPDATED --AUGUST 1989. SET READ REWIND FIXED C UPDATED --MARCH 1990. X11 COMMANDS C (SET X11 FONT) C (SET X11 CAP) C (SET X11 JOIN) C (SET X11 PIXMAP) C (SET X11 PAUSE) C (SET X11 DISPLAY NAME) C UPDATED --JULY 1990. (LIST LINES FROM 24 TO 20) C UPDATED --AUGUST 1990. IBUGWI (FOR WINDOWS) C UPDATED --AUGUST 1990. ISUBWI (FOR WINDOWS) C UPDATED --AUGUST 1990. WINDOW SYSTEMS COMMON C UPDATED --OCTOBER 1991. "SET POSTSCRIPT SPACE " C ADDITIONAL POSTSCRIPT FONTS C UPDATED --OCTOBER 1991. BUG FIX FOR HELP, LIST LINES C UPDATED --APRIL 1992. ADD NPLOTP TO INPUT ARGS C UPDATED --MAY 1992. IPL1CS, IPL2CS C UPDATED --MAY 1992. IPSTBP, IPSTPN C UPDATED --MAY 1992. IHV12 C UPDATED --MAY 1992. IX11DN: 20 TO 80 C UPDATED --MAY 1992. IBUGG4=IBUGU2,IBUGU2=IBUGG4 C UPDATED --APRIL 1993. MAX LIST LINES: 50=>MAXLIS C UPDATED --MAY 1993. MINMAX FOR EV1/EV2/WEIBULL C UPDATED --NOVEMBER 1993. SET PATH C UPDATED --DECEMBER 1993. FIX MINMAX FOR EV1/EV2/WEIBULL C UPDATED --DECEMBER 1993. FIX SET PATH AGAIN C UPDATED --JANUARY 1994. WEIB MINMAX TO DPCOS2.INC C UPDATED --JUNE 1994. IX11FS, IPSTFS C UPDATED --APRIL 1995. IUNFOF, IUNFNR, IUNFMC C UPDATED --JULY 1995. FIT ITER., SD, ADDITIVE CONST. C UPDATED --FEBRUARY 1996. SET MENU PATH C UPDATED --MARCH 1996. IRHSTG C UPDATED --JULY 1996. LAHEY DEVICE DRIVER SWITCHES C UPDATED --NOVEMBER 1996. MICROSOFT QUICK-WIN SWITCHES C UPDATED --APRIL 1997. SET CONTROL CHART C UPDATED --APRIL 1997. SET NETSCAPE C UPDATED --APRIL 1997. SET BROWSER C UPDATED --APRIL 1997. SET DATAPLOT URL C UPDATED --APRIL 1997. SET CONTROL CHART WEIGHTING C UPDATED --APRIL 1997. SET URL C UPDATED --OCTOBER 1997. SET X11 WINDOW ID C UPDATED --DECEMBER 1997. SET GENERAL FACTOR C UPDATED --FEBRUARY 1998. SET PRINTER C UPDATED --MAY 1998. SET KAPLAN-MEIER C UPDATED --MAY 1998. SET CENSORING C UPDATED --JUNE 1998. SET MATRIX SCALE C UPDATED --JULY 1998. SET QWIN TEXT BACKGROUND COLOR <0/1/2/../15> C UPDATED --JULY 1998. SET QWIN TEXT FOREGROUND COLOR <0/1/2/../15> C UPDATED --SEPTEMBER 1998. SET PERCENT POINT PLOT C C UPDATED --SEPTEMBER 1998. SET QUANTILE-QUANTILE PLOT C C UPDATED --NOVEMBER 1998. IRHSTG TO DPCOST.INC C UPDATED --MARCH 1999. SET HANDBOOK URL C UPDATED --JULY 1999. SET AUTOCORRELATION BAND C C UPDATED --SEPTEMBER 1999. SET SCATTER PLOT MATRIX C UPDATED --SEPTEMBER 1999. SET CONDITIONING PLOT C UPDATED --SEPTEMBER 1999. SET FACTOR PLOT C UPDATED --JANUARY 2000. SET CROSS TABULATE DIMENSION C UPDATED --JANUARY 2000. SET SORT DIRECTION C UPDATED --FEBRUARY 2000. SET DEX CONTOUR PLOT C UPDATED --OCTOBER 2000. SET MANDEL PAULE C UPDATED --FEBRUARY 2001. SET LAHEY WINTERACTOR C UPDATED --MARCH 2001. SET LOCATION STATISTIC C UPDATED --MARCH 2001. SET SCALE STATISTIC C UPDATED --MARCH 2001. SET SUPERSCRIPT C SCALE C UPDATED --APRIL 2001. SET ORTHOGNAL DISTANCE C TRUST REGION RADIUS C UPDATED --APRIL 2001. SET ORTHOGNAL DISTANCE C STOP TOLERANCE C UPDATED --APRIL 2001. SET ORTHOGNAL DISTANCE C PARAMETER TOLERANCE C UPDATED --APRIL 2001. SET ORTHOGNAL DISTANCE C PRINT OPTION C UPDATED --MARCH 2002. SVG COMMANDS C (SET SVG COORDINATE SYSTEM) C (SET SVG FONT NAME) C (SET SVG FONT WEIGHT) C (SET SVG FONT STYLE) C (SET SVG CAP) C (SET SVG JOIN) C (SET SVG FOREGROUND COLOR) C (SET SVG HARDWARE FILL) C (SET SVG STYLE SHEET) C (SET SVG STYLE SHEET NAME) C UPDATED --MARCH 2002. SET BOX PLOT WIDTH C C UPDATED --MARCH 2002. SET 4-PLOT MULTIPLOT C UPDATED --MARCH 2002. SET 6-PLOT MULTIPLOT C UPDATED --MAY 2002. SET RANDOM NUMBER GENERATOR C UPDATED --JUNE 2002. SET NUMBER OF CP C UPDATED --JUNE 2002. SET CAPTURE LINES C UPDATED --JUNE 2002. SET CAPTURE BOX C UPDATED --JUNE 2002. SET CAPTURE NUMBER C UPDATED --JULY 2002. SET QUANTILE METHOD C UPDATED --JULY 2002. SET QUANTILE METHOD STAN ERROR C UPDATED --JULY 2002. SET COVARIANCE TYPE C UPDATED --JULY 2002. SET CORRELATION TYPE C UPDATED --JULY 2002. SET FILE NAME QUOTE C UPDATED --JULY 2002. SET BOOTSTRAP FIT METHOD C UPDATED --NOVEMBER 2002. SET QWIN SYSTEM C UPDATED --NOVEMBER 2002. SET GHOSTSCRIPT PRINTER C UPDATED --NOVEMBER 2002. SET GHOSTVIEW PATH C UPDATED --JANUARY 2003. SET GHOSTSCRIPT PATH C UPDATED --JANUARY 2003. SET POSTSCRIPT BOUNDING BOX C UPDATED --JANUARY 2003. SET POSTSCRIPT CONVERT C UPDATED --JANUARY 2003. SET HTML HEADER FILE C UPDATED --JANUARY 2003. SET HTML FOOTER FILE C UPDATED --FEBRUARY 2003. SET AUTOCORRELATION ZERO C UPDATED --MARCH 2003. SET PARALLEL COORDINATES C STANDARDIZE C UPDATED --MARCH 2003. SET BOOTSTRAP GROUPS C UPDATED --MAY 2003. SET MULTIVARIATE NORMAL C UPDATED --SEPTEMBER 2003. SET TABLE TITLE C UPDATED --SEPTEMBER 2003. SET TABLE BORDER C UPDATED --SEPTEMBER 2003. SET TABLE SPACING C UPDATED --SEPTEMBER 2003. SET TABLE WIDTH C UPDATED --SEPTEMBER 2003. SET TABLE HEIGHT C UPDATED --SEPTEMBER 2003. SET LATEX HEADER FILE C UPDATED --SEPTEMBER 2003. SET LATEX FOOTER FILE C UPDATED --JANUARY 2004. SET READ VARIABLE LABEL C UPDATED --JANUARY 2004. SET CONVERT CHARACTER C UPDATED --JANUARY 2004. SET READ DELIMITER C UPDATED --JANUARY 2004. SET READ MISSING VALUE C UPDATED --MARCH 2004. SET GEOMETRIC DEFINITION C UPDATED --MARCH 2004. SET HYPERGEOMETRIC MAXI LIKE C UPDATED --MAY 2004. SET PPCC PLOT C UPDATED --MAY 2004. SET PPCC FORMAT C UPDATED --JUNE 2004. SET DEFAULT POSTSCRIPT COLOR C UPDATED --JUNE 2004. SET ASYMMETRIC LAPLACE C DEFINITION C UPDATED --JUNE 2004. SET GENERALIZED PARETO C DEFINITION C UPDATED --JULY 2004. SET GOMPERTZ-MAKEHAM C DEFINITION C UPDATED --AUGUST 2004. FOR SET COMMANDS THAT ACCEPT C FILE NAMES, ALLOW QUOTING TO C HANDLE SPACES AND HYPHENS IN C FILE NAME C UPDATED --SEPTEMBER 2004. SET BESSEL I FUNCTION C DEFINITION C UPDATED --SEPTEMBER 2004. SET BESSEL K FUNCTION C DEFINITION C UPDATED --SEPTEMBER 2004. SET PROBABILITY PLOT DATA C POINTS C UPDATED --SEPTEMBER 2004. SET PPCC PLOT DATA POINTS C UPDATED --SEPTEMBER 2004. SET PPCC PLOT AXIS POINTS C UPDATED --SEPTEMBER 2004. SET PPCC PLOT AXIS POINTS C UPDATED --SEPTEMBER 2004. SET PPCC PLOT AXIS ORDER C UPDATED --SEPTEMBER 2004. SET HISTOGRAM CLASS WIDTH C UPDATED --OCTOBER 2004. SET READ SUBSET C UPDATED --OCTOBER 2004. SET READ PAD MISSING COLUMNS C UPDATED --OCTOBER 2004. SET CENSORED PROB PLOT C UPDATED --OCTOBER 2004. SET CENSORED PPCC PLOT C UPDATED --OCTOBER 2004. SET MAXIMUM LIKELIHOOD C PERCENTILES C UPDATED --OCTOBER 2004. SET EXPONENTIAL BIAS CORRECTED C UPDATED --NOVEMBER 2004. SET WEIBULL BIAS CORRECTED C UPDATED --NOVEMBER 2004. SET GUMBEL BIAS CORRECTED C UPDATED --NOVEMBER 2004. SET MATRIX CORRELATION DIRECTION C UPDATED --NOVEMBER 2004. SET MATRIX COVARIANCE DIRECTION C UPDATED --DECEMBER 2004. SET GUI C UPDATED --FEBRUARY 2005. SET DISTRIBUTIONAL BOOTSTRAP C UPDATED --FEBRUARY 2005. SET PARAMETER EXPAND DIGIT C UPDATED --FEBRUARY 2005. SET RTF FIXED FONT C UPDATED --FEBRUARY 2005. SET RTF PROPORTIONAL FONT C UPDATED --MARCH 2005. SET LINE PRINTER COLUMNS C UPDATED --MARCH 2005. SET LINE PRINTER COLUMNS C UPDATED --MARCH 2005. SET AQUA FONT NAME C UPDATED --MARCH 2005. SET AQUA CAP STYLE C UPDATED --MARCH 2005. SET AQUA JOIN STYLE C UPDATED --MARCH 2005. SET AQUA HARDWARE FILL C UPDATED --APRIL 2005. SET DECIMAL POINT C UPDATED --APRIL 2005. SET PEAKS OVER THRESHOLD C METHOD C UPDATED --APRIL 2005. SET PEAKS OVER THRESHOLD C ITERATIONS C UPDATED --APRIL 2005. SET PEAKS OVER THRESHOLD C INITIAL POINTS C UPDATED --APRIL 2005. SET PEAKS OVER THRESHOLD C INITIAL THRESHOLD C UPDATED --APRIL 2005. SET PEAKS OVER THRESHOLD C INCREMENT C UPDATED --APRIL 2005. SET PEAKS OVER THRESHOLD C PERIOD C UPDATED --APRIL 2005. SET PEAKS OVER THRESHOLD C TOLERANCE C UPDATED --APRIL 2005. SET PEAKS OVER THRESHOLD C LOAD FACTOR C UPDATED --APRIL 2005. SET PEAKS OVER THRESHOLD C X AXIS C UPDATED --MAY 2005. SET FRECHET BIAS CORRECTION C UPDATED --MAY 2005. SET GRUBBS ONE SIDED C UPDATED --JULY 2005. SET LOG GAMMA DEFINITION C UPDATED --JULY 2005. SET SKEW NORMAL DEFINITION C UPDATED --OCTOBER 2005. SET GENERALIZED PARETO C MLE STARTING VALUES C UPDATED --FEBRUARY 2006. SET IBUGLO C UPDATED --FEBRUARY 2006. SET LATEX COLOR C UPDATED --FEBRUARY 2006. SET LATEX LINE THICK C C UPDATED --FEBRUARY 2006. SET LATEX FILL SWITCH C C UPDATED --FEBRUARY 2006. SET GENERALIZED TUKEY C LAMBDA DEFINITION C UPDATED --MARCH 2006. SET TEMPORARY FILE C UPDATED --MAY 2006. SET PPCC PLOT LOCA SCALE C UPDATED --MAY 2006. SET BETA GEOMETRIC C DEFINITION C UPDATED --JUNE 2006. SET FORTRAN FORMAT CONTROL C UPDATED --JUNE 2006. SET MANDEL PAULE C UPDATED --JUNE 2006. SET MODIFIED MANDEL PAULE C UPDATED --JUNE 2006. SET VANGEL RUHKIN C UPDATED --JUNE 2006. SET BOB C UPDATED --JUNE 2006. SET SCHILLER EBERHARDT C UPDATED --JUNE 2006. SET METHOD OF MEANS C UPDATED --JUNE 2006. SET GRAYBILL DEAL C UPDATED --JUNE 2006. SET GRAND MEAN C UPDATED --JUNE 2006. SET GENERALIZED CONF INTE C UPDATED --JUNE 2006. SET DERSIMONIAN LAIRD C UPDATED --JUNE 2006. SET FAIRWEATHER C UPDATED --JUNE 2006. SET BAYESIAN CONSENSUS C PROCEDURE C UPDATED --JULY 2006. SET GEETA DEFINITION C UPDATED --JULY 2006. SET CHISQUARE LIMIT C UPDATED --AUGUST 2006. SET CONSUL DEFINITION C UPDATED --OCTOBER 2006. SET 4PLOT DISTRIBUTION C UPDATED --OCTOBER 2006. SET MAXWELL LOCATION C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*1 IREPCH C CHARACTER*4 IOSW C CHARACTER*4 IPPDE1 CHARACTER*4 IPPDE2 C CHARACTER*4 IBUGUG CHARACTER*4 IBUGU2 CHARACTER*4 IBUGU3 CHARACTER*4 IBUGU4 C CHARACTER*4 ISUBRO C CHARACTER*4 IBUGEX CHARACTER*4 IBUGE2 CHARACTER*4 IBUGHE CHARACTER*4 IBUGH2 CHARACTER*4 IBUGLO C CHARACTER*4 IFTEXP CCCCC AUGUST 1995. ADD FOLLOWING LINE CHARACTER*4 IFTORD C CHARACTER*4 IFORSW C CHARACTER*4 IFILQZ C CCCCC MARCH 1996. ADD FOLLOWING LINE CCCCC NOVEMBER 1998. MOVE TO DPCOST CCCCC CHARACTER*4 IRHSTG C CHARACTER*4 IFILQS C CHARACTER*80 ICREAF CHARACTER*80 ICWRIF CHARACTER*80 ITEMP C CHARACTER*4 IREARW CHARACTER*4 IWRIRW C CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993 CHARACTER*4 IPRITY CCCCC THE FOLLOWING LINE WAS ADDED JULY 1995 CCCCC CHARACTER*4 IFITAC C CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 ICASPR CHARACTER*4 IHV CHARACTER*4 IHV2 CCCCC THE FOLLOWING LINE WAS ADDED MAY 1992 (JJF) CHARACTER*12 IHV12 CHARACTER*4 IPART1 CHARACTER*4 IPART2 CHARACTER*4 IPART3 CHARACTER*4 IPART4 CHARACTER*4 IPART5 CHARACTER*4 IPART6 C CHARACTER*80 ICANS CHARACTER*80 ISTRIN C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOMC.INC' INCLUDE 'DPCODB.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCOPC.INC' INCLUDE 'DPCODG.INC' INCLUDE 'DPCOSU.INC' CCCCC THE FOLLOWING LINE (FOR WEIBULL MINMAX) WAS ADDED JANUARY 1994 INCLUDE 'DPCOS2.INC' INCLUDE 'DPCODA.INC' INCLUDE 'DPCOTR.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCOF2.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCODV.INC' CCCCC THE FOLLOWING COMMON FOR NON-PRINTING CHAR. WAS ADDED APRIL 1989 INCLUDE 'DPCONP.INC' CCCCC THE FOLLOWING COMMON FOR WINDOW SYSTEMS WAS ADDED AUGUST 1990 INCLUDE 'DPCOWI.INC' CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1997 INCLUDE 'DPCOHO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IFOUND='NO' IERROR='NO' C CCCCC THE FOLLOWING 2 LINES WERE ADDED DECEMBER 1993 ISUBN1='DPSE' ISUBN2='T ' C ICASPR=' ' IFILQZ=IFILQU IFILQU='ON' C C *************************************** C ** STEP 11-- ** C ** TREAT THE PREPLOT/POSTPLOT CASE ** C *************************************** C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PRE')GOTO1110 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PREP')GOTO1110 C SEPTEMBER, 1988. ADJUST TO AVOID CONFLICT WITH POSTSCRIPT COMMANDS IF(NUMARG.GE.1.AND.IHARG(1).EQ.'POST'.AND.IHARG2(1).NE.'SCRI') * GOTO1110 GOTO1190 1110 CONTINUE CALL DPPRPO(ICOM,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1IPPDE1,IPPDE2, 1IBUGS2,ISUBRO,IFOUND,IERROR) GOTO9000 1190 CONTINUE C C ********************************************* C ** STEP 12-- ** C ** TREAT THE SET READ FORMAT CASE ** C ********************************************* C CCCCC THEW FOLLOWING LINE WAS FIXED AUGUST 1989 CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'READ')GOTO1210 IF(NUMARG.GE.2.AND.IHARG(1).EQ.'READ'.AND. 1IHARG(2).EQ.'FORM')GOTO1210 GOTO1290 C 1210 CONTINUE ICREAF(1:40)=' ' ICREAF(41:80)=' ' NCREAF=0 CCCCC IF(NUMARG.LE.1)GOTO1250 MARCH 1988 IF(NUMARG.LE.2)GOTO1250 IF(IHARG(NUMARG).EQ.'OFF')GOTO1250 IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250 C DO1230I=1,80 ICANS(I:I)=IANS(I) 1230 CONTINUE C CCCCC ALAN AND I DO THINGS DIFFERENTLY BETWEEN HERE AND 1290 CONTINUE ISTART=1 ISTOP=IWIDTH IWORD=NUMARG+1 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C IF(NCSTRI.GE.1)GOTO1240 GOTO1250 C 1240 CONTINUE CCCCC ICREAF=ISTRIN CCCCC NCREAF=NCSTRI NCREAF=NCSTRI NCP2=NCREAF+2 IF(NCP2.GT.80)NCP2=80 ICREAF(2:80)=ISTRIN(1:79) ICREAF(1:1)='(' ICREAF(NCP2:NCP2)=')' NCREAF=NCP2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1249 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1241) 1241 FORMAT('THE (FORTRAN-LIKE) READ FORMAT HAS JUST BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1242)(ICREAF(I:I),I=1,NCREAF) 1242 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 1249 CONTINUE GOTO9000 C 1250 CONTINUE NCSTRI=0 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1259 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1251) 1251 FORMAT('THE (FORTRAN-LIKE) READ FORMAT HAS JUST BEEN', 1'TURNED OFF;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1252) 1252 FORMAT('THUS SUBSEQUENT READS WILL BE FREE-FORMAT.') CALL DPWRST('XXX','BUG ') 1259 CONTINUE GOTO9000 1290 CONTINUE C C ********************************************* C ** STEP 13-- ** C ** TREAT THE SET WRITE FORMAT CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'WRIT'.AND. 1IHARG(2).EQ.'FORM')GOTO1310 GOTO1390 C 1310 CONTINUE ICWRIF(1:40)=' ' ICWRIF(41:80)=' ' NCWRIF=0 IF(NUMARG.LE.2)GOTO1350 IF(IHARG(NUMARG).EQ.'OFF')GOTO1350 IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350 C DO1330I=1,80 ICANS(I:I)=IANS(I) 1330 CONTINUE C ISTART=1 ISTOP=IWIDTH IWORD=4 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C ISTART=1 ISTOP=IWIDTH IWORD=NUMARG+1 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL3,ICOL4,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C NCSTRI=ICOL4-ICOL1+1 IF(NCSTRI.GE.1)GOTO1340 GOTO1350 C 1340 CONTINUE NCWRIF=NCSTRI NCP2=NCWRIF+2 IF(NCP2.GT.80)NCP2=80 DO1341I=2,80 J=ICOL1-2+I IF(J.LE.ICOL4)ICWRIF(I:I)=ICANS(J:J) IF(J.GT.ICOL4)ICWRIF(I:I)=' ' 1341 CONTINUE ICWRIF(1:1)='(' ICWRIF(NCP2:NCP2)=')' NCWRIF=NCP2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1349 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1342) 1342 FORMAT('THE (FORTRAN-LIKE) WRITE FORMAT HAS JUST BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1343)(ICWRIF(I:I),I=1,NCWRIF) 1343 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 1349 CONTINUE GOTO9000 C 1350 CONTINUE NCSTRI=0 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1359 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1351) 1351 FORMAT('THE (FORTRAN-LIKE) WRITE FORMAT HAS JUST BEEN', 1'TURNED OFF;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1352) 1352 FORMAT('THUS SUBSEQUENT WRITES WILL BE FREE-FORMAT.') CALL DPWRST('XXX','BUG ') 1359 CONTINUE GOTO9000 1390 CONTINUE C C ********************************************* C ** STEP 14-- ** C ** TREAT THE SET READ REWIND CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'READ'.AND. 1IHARG(2).EQ.'REWI')GOTO1410 GOTO1490 C 1410 CONTINUE IREARW='ON' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'OFF')IREARW='OFF' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'AUTO')IREARW='OFF' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'DEFA')IREARW='OFF' 1419 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1429 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1421)IREARW 1421 FORMAT('THE READ REWIND SWITCH HAS JUST BEEN SET TO ', 1A4) CALL DPWRST('XXX','BUG ') 1422 FORMAT(80A1) 1429 CONTINUE GOTO9000 C 1490 CONTINUE C C ********************************************* C ** STEP 15-- ** C ** TREAT THE SET WRITE REWIND CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'WRIT'.AND. 1IHARG(2).EQ.'REWI')GOTO1510 GOTO1590 C 1510 CONTINUE IWRIRW='ON' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'OFF')IWRIRW='OFF' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'AUTO')IWRIRW='OFF' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'DEFA')IWRIRW='OFF' 1519 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1529 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1521)IWRIRW 1521 FORMAT('THE WRITE REWIND SWITCH HAS JUST BEEN SET TO ', 1A4) CALL DPWRST('XXX','BUG ') 1522 FORMAT(80A1) 1529 CONTINUE GOTO9000 C 1590 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 C ********************************************* C ** STEP 16-- ** C ** TREAT THE SET PRINTER TYPE CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'PRIN'.AND. 1IHARG(2).EQ.'TYPE')GOTO1610 GOTO1690 C 1610 CONTINUE IPRITY='POST' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'POST')IPRITY='POST' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'PS')IPRITY='POST' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'EPS')IPRITY='POST' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ASCI')IPRITY='ASCI' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'PCL')IPRITY='ASCI' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'AUTO')IPRITY='POST' IF(NUMARG.GE.3.AND.IHARG(3).EQ.'DEFA')IPRITY='POST' 1619 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1629 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1621)IPRITY 1621 FORMAT('THE PRINT TYPE SWITCH HAS JUST BEEN SET TO ', 1A4) CALL DPWRST('XXX','BUG ') 1622 FORMAT(80A1) 1629 CONTINUE GOTO9000 C 1690 CONTINUE C C ******************************************** C ** STEP 18-- ** C ** EXTRACT THE SECOND ARGUMENT STRING ** C ******************************************** C ISTEPN='18' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SET') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IV=(-999) AV=(-999.0) IHV='-999' IHV2='-999' IF(NUMARG.LE.1)GOTO1829 IV=IARG(NUMARG) AV=ARG(NUMARG) IHV=IHARG(NUMARG) IHV2=IHARG2(NUMARG) CCCCC THE FOLLOWING 4 LINES WERE ADDED MAY 1992 (JJF) IHV12=' ' IHV12(1:4)=IHV IHV12(5:8)=IHV2 IHV12(9:12)=' ' 1829 CONTINUE C IF(NUMARG.LE.1)GOTO1890 C CCCCC OCTOBER 2002. FILE NAMES FOR UNIX ARE CASE SENSITIVE, SO USE CCCCC LOWER CASE CHARACTERS (FOR ISTRIN). C DO1830I=1,80 CCCCC ICANS(I:I)=IANS(I) ICANS(I:I)=IANSLC(I) 1830 CONTINUE C ISTART=1 ISTOP=IWIDTH IWORD=3 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C IF(NCSTRI.GE.1)GOTO1890 IERROR='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1841) 1841 FORMAT('***** ERROR IN DPSET--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1842) 1842 FORMAT(' THE SET COMMAND REQUIRES') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1843) 1843 FORMAT(' AT LEAST 2 ARGUMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1844) 1844 FORMAT(' (FOR EXAMPLE, SET IPL1NA DPPL1F.TEX)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1845) 1845 FORMAT(' BUT NO SECOND ARGUMENT EXISTED HERE .') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1846) 1846 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1847)(IANS(I),I=1,IWIDTH) 1847 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IF(IWIDTH.LE.0)WRITE(ICOUT,999) IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ') GOTO9000 1890 CONTINUE CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1993 C C *********************************** C ** STEP 19-- ** C ** CHECK FOR SET PATH ** C *********************************** C CCCCC THE FOLLOWING 3 LINES WERE ADDED DECEMBER 1993 ISTEPN='19' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SET') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IPART1='PATH' IPART2=' ' CCCCC THE FOLLOWING LINE WAS FIXED DECEMBER 1993 CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATH')THEN C CCCCC OCTOBER 2002. PATH NAMES FOR UNIX ARE CASE SENSITIVE, SO USE CCCCC LOWER CASE CHARACTERS. C DO1911I=1,80 CCCCC ICANS(I:I)=IANS(I) ICANS(I:I)=IANSLC(I) 1911 CONTINUE C ISTART=1 ISTOP=IWIDTH IWORD=3 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, CCCCC1 ICOL1,ICOL2,ISTRIN,NCSTRI, 1 ICOL1,ICOL4,ISTRIN,NCSTRI, 1 IBUGS2,ISUBRO,IERROR) C CCCCC ISTART=1 CCCCC ISTOP=IWIDTH CCCCC IWORD=NUMARG+1 CCCCC CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, CCCCC1 ICOL3,ICOL4,ISTRIN,NCSTRI, CCCCC1 IBUGS2,ISUBRO,IERROR) C NCSTRI=ICOL4-ICOL1+1 IF(NCSTRI.GE.1)THEN NCPATH=NCSTRI PATH=' ' ITEMP(1:NCPATH)=ICANS(ICOL1:ICOL4) CALL DEQUOT(ITEMP,NCSTRI,PATH,NCPATH,IBUGS2,ISUBRO) IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1916) 1916 FORMAT('THE PATH FOR THE DATAPLOT DIRECTORY = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1917)PATH 1917 FORMAT(A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1918)NCPATH 1918 FORMAT('THE NUMBER OF CHARACTERS IN THE PATH NAME = ',I8) CALL DPWRST('XXX','BUG ') GOTO9000 ELSE GOTO9000 ENDIF ENDIF CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1996 C *********************************** C ** STEP 19.X-- ** C ** CHECK FOR MENU PATH ** C *********************************** C ISTEPN='20' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SET') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IPART1='MENU' IPART2=' ' IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MENU' 1.AND.IHARG(2).EQ.'PATH')THEN C CCCCC OCTOBER 2002. PATH NAMES FOR UNIX ARE CASE SENSITIVE, SO USE CCCCC LOWER CASE CHARACTERS. C DO2011I=1,80 CCCCC ICANS(I:I)=IANS(I) ICANS(I:I)=IANSLC(I) 2011 CONTINUE C ISTART=1 ISTOP=IWIDTH IWORD=4 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, CCCCC1 ICOL1,ICOL2,ISTRIN,NCSTRI, 1 ICOL1,ICOL4,ISTRIN,NCSTRI, 1 IBUGS2,ISUBRO,IERROR) C CCCCC ISTART=1 CCCCC ISTOP=IWIDTH CCCCC IWORD=NUMARG+1 CCCCC CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, CCCCC1 ICOL3,ICOL4,ISTRIN,NCSTRI, CCCCC1 IBUGS2,ISUBRO,IERROR) C NCSTRI=ICOL4-ICOL1+1 IF(NCSTRI.GE.1)THEN NCMPAT=NCSTRI MPATH=' ' ITEMP(1:NCMPAT)=ICANS(ICOL1:ICOL4) CALL DEQUOT(ITEMP,NCSTRI,MPATH,NCMPAT,IBUGS2,ISUBRO) IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2016) 2016 FORMAT('THE PATH FOR THE DATAPLOT MENU = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2017)MPATH 2017 FORMAT(A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2018)NCMPAT 2018 FORMAT('THE NUMBER OF CHARACTERS IN THE MENU PATH ', 1 'NAME = ') CALL DPWRST('XXX','BUG ') GOTO9000 ELSE GOTO9000 ENDIF ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 1995. C ********************************* C ** SET UNFORMATTED COLUMNS ** C ********************************* C IPART1='UNFO' IPART2='COLU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IUNFMC=IV IF(IUNFMC.LT.0)IUNFMC=0 IV=IUNFMC GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 1995. C ********************************* C ** SET UNFORMATTED RECORDS ** C ********************************* C IPART1='UNFO' IPART2='RECO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IUNFNR=IV IF(IUNFNR.LT.0)IUNFNR=0 IV=IUNFNR GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 1995. C ********************************* C ** SET UNFORMATTED OFFSET ** C ********************************* C IPART1='UNFO' IPART2='OFFS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IUNFOF=IV IF(IUNFOF.LT.0)IUNFOF=0 IV=IUNFOF GOTO5150 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1995. C ****************************************** C ** SET FIT ITERATIONS (#) ** C ****************************************** C IPART1='FIT' IPART2='ITER' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IFITIT=IV GOTO5150 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1995. C ****************************************** C ** SET FIT STANDARD DEVIATION (#) ** C ****************************************** C IPART1='FIT ' IPART2='STAN' IPART3='DEVI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(3).EQ.IPART3)THEN FITSD=AV GOTO5170 ENDIF ENDIF C IPART1='FIT ' IPART2='SD' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN FITSD=AV GOTO5170 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1995. C ****************************************** C ** SET FIT ADDITIVE CONSTANT (ON/OFF) ** C ****************************************** C IPART1='FIT ' IPART2='ADDI' IPART3='CONS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(3).EQ.IPART3)THEN IFITAC=IHV GOTO5160 ENDIF ENDIF C IPART1='FIT ' IPART2='CONS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IFITAC=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 1996. C ******************************************** C ** SET RELATIVE HISTOGRAM ** C ******************************************** C IPART1='RELA' IPART2='HIST' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IRHSTG=IHV IF(IRHSTG.NE.'AREA'.AND.IRHSTG.NE.'PERC')THEN IRHSTG='AREA' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 1998. C *************************************************** C ** SET KAPLAN MEIER ** C *************************************************** C IPART1='KAPL' IPART2='MEIE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IKAPSW=IHV IF(IKAPSW.NE.'CDF ')IKAPSW='RELI' GOTO5160 ENDIF IF(IHARG(1).EQ.IPART1)THEN IKAPSW=IHV IF(IKAPSW.NE.'CDF ')IKAPSW='RELI' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 1998. C *************************************************** C ** SET CENSORING ** C *************************************************** C IPART1='CENS' IPART2='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ICENTY=IHV IF(ICENTY.EQ.'TIME')ICENTY='1 ' IF(ICENTY.EQ.'MULT')ICENTY='3 ' IF(ICENTY.NE.'1 '.AND.ICENTY.NE.'3 '.AND. 1 ICENTY.NE.'NONE')ICENTY='2 ' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 1998. C *************************************************** C ** SET MATRIX SCALE ** C *************************************************** C IPART1='MATR' IPART2='SCAL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IMATSC=IHV IF(IMATSC.EQ.'ZSCO')IMATSC='Z-SC' IF(IMATSC.EQ.'SCOR')IMATSC='Z-SC' IF(IMATSC.NE.'SD '.AND.IMATSC.NE.'RANG'.AND. 1 IMATSC.NE.'Z-SC'.AND.IMATSC.NE.'MEAN') 1 IMATSC='NONE' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 1997. C *************************************************** C ** SET CONTROL CHART WEIGHTING
** C *************************************************** C IPART1='CONT' IPART2='CHAR' IPART3='WEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN ICCHWT=IHV IF(ICCHWT.NE.'CENT'.AND.ICCHWT.NE.'RIGH')THEN ICCHWT='RIGH' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 1997. C ******************************************** C ** SET CONTROL CHART ** C ******************************************** C IPART1='CONT' IPART2='CHAR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ICCHPR=IHV IF(ICCHPR.NE.'DATA'.AND.ICCHPR.NE.'PRIO')THEN ICCHPR='DATA' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1998. C ************************************************************ C ** SET PERCENT POINT PLOT ** C ************************************************************ C IPART1='PERC' IPART2='POIN' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IPPTBI=IHV IF(IPPTBI.NE.'UNBI'.AND.IPPTBI.NE.'INTE')THEN IPPTBI='BINN' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1998. C **************************************************************** C ** SET QUANTILE-QUANTILE PLOT ** C **************************************************************** C IPART1='PERC' IPART2='POIN' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IQQPBI=IHV IF(IQQPBI.NE.'UNBI'.AND.IQQPBI.NE.'INTE')THEN IQQPBI='BINN' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 1999. C **************************************************************** C ** SET AUTOCORRELATION BAND ** C **************************************************************** C IPART1='AUTO' IPART2='BAND' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND. 1 (IHARG(2).EQ.IPART2.OR.IHARG(2).EQ.IPART3))THEN IAUTCP='WHIT' IAUTCP=IHV IF(IAUTCP.EQ.'ARMA'.OR.IAUTCP.EQ.'BOX'.OR.IAUTCP.EQ.'JENK' 1 .OR.IAUTCP.EQ.'BOXJ'.OR.IAUTCP.EQ.'ARIM')THEN IAUTCP='BOXJ' ELSE IAUTCP='WHIT' ENDIF IHV=IAUTCP GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2003. C ********************************************************* C ** SET AUTOCORRELATION LAG ZERO ** C ********************************************************* C IPART1='AUTO' IPART2='LAG' IPART3='ZERO' IPART4='0' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 (IHARG(3).EQ.IPART3.OR.IHARG(2).EQ.IPART4))THEN IAUTL0=IHV IF(IAUTL0.EQ.'OFF'.OR.IAUTL0.EQ.'NO'.OR.IAUTL0.EQ.'NONE' 1 .OR.IAUTL0.EQ.'FALS')THEN IAUTL0='OFF' ELSE IAUTL0='ON' ENDIF IHV=IAUTL0 GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2003. C ********************************************************* C ** SET PARALLEL COORDINATES STANDARDIZE ** C ********************************************************* C IPART1='PARA' IPART2='COOR' IPART3='STAN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IPCCST=IHV IF(IPCCST.EQ.'OFF'.OR.IPCCST.EQ.'NO'.OR.IPCCST.EQ.'NONE' 1 .OR.IPCCST.EQ.'FALS')THEN IPCCST='NONE' ELSEIF(IPCCST.EQ.'ON'.OR.IPCCST.EQ.'YES'.OR. 1 IPCCST.EQ.'TRUE')THEN IPCCST='USCO' ENDIF IF(IPCCST.EQ.'ZSCO'.OR.IPCCST.EQ.'NONE'.OR. 1 IPCCST.EQ.'ZSCO')THEN IHV=IPCCST ELSE IHV='USCO' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2003. C ********************************************************* C ** SET BOOTSTRAP GROUPS ** C ********************************************************* C IPART1='BOOT' IPART2='GROU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IBOOGR=IHV IF(IBOOGR.EQ.'OFF'.OR.IBOOGR.EQ.'NO'.OR.IBOOGR.EQ.'NONE'.OR. 1 IBOOGR.EQ.'FALS'.OR.IBOOGR.EQ.'DEFA'.OR. 1 IBOOGR.EQ.'ON'.OR.IBOOGR.EQ.'YES'.OR. 1 IBOOGR.EQ.'TRUE')THEN IBOOGR='INDE' ENDIF IF(IBOOGR.NE.'DEPE')IBOOGR='INDE' IHV=IBOOGR GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2003. C ************************************************************* C ** SET MULTIVARIATE NORMAL ** C ************************************************************* C IPART1='MULT' IPART2='NORM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IMVNTY=IHV IF(IMVNTY.NE.'RANM'.AND.IMVNTY.NE.'KROM'.AND. 1 IMVNTY.NE.'SPHM')IMVNTY='SADM' IHV=IMVNTY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003. C ************************************************************* C ** SET TABLE BORDER ** C ************************************************************* C IPART1='TABL' IPART2='BORD' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSEIF(IHV.EQ.'RULE' .OR. IHV.EQ.'TOP')THEN IHV='RULE' ELSEIF(IHV.EQ.'COLS' .OR. IHV.EQ.'COLU' .OR. IHV.EQ.'COL')THEN IHV='COLS' ELSE IHV='OFF' ENDIF ITABBR=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003. C ************************************************************* C ** SET TABLE SPACING ** C ************************************************************* C IPART1='TABL' IPART2='SPAC' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ITABSP=IV IF(ITABSP.LT.0)ITABSP=0 IV=ITABSP GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003. C ************************************************************* C ** SET TABLE WIDTH ** C ************************************************************* C IPART1='TABL' IPART2='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ITABWD=IV IF(ITABWD.LE.0)ITABWD=0 IV=ITABWD GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003. C ************************************************************* C ** SET TABLE HEIGHT ** C ************************************************************* C IPART1='TABL' IPART2='HEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ITABHT=IV IF(ITABHT.LE.0)ITABHT=0 IV=ITABHT GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2004. C ************************************************************* C ** SET READ VARIABLE LABEL ** C ************************************************************* C IPART1='READ' IPART2='VARI' IPART3='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSEIF(IHARG(4).EQ.'ROW ' .OR. IHARG(4).EQ.'ROWL')THEN IHV='ROWL' ELSE IHV='OFF' ENDIF IVARLA=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2004. C ************************************************************* C ** SET CONVERT CHARACTER ** C ************************************************************* C IPART1='CONV' IPART2='CHAR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'CHAR' .OR. IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='CHAR' ELSEIF(IHV.EQ.'ERRO' .OR. IHV.EQ.'DEFA')THEN IHV='ERRO' ELSEIF(IHV.EQ.'IGNO' .OR. IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. 1 IHV.EQ.'NONE')THEN IHV='IGNO' ELSE IHV='ERRO' ENDIF IGRPAU=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2004. C ************************************************************* C ** SET READ DELIMITER ** C ************************************************************* C IPART1='READ' IPART2='DELI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES' .OR. IHV.EQ.'DEFA')THEN IHV=',' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='NULL' ENDIF IREADL=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C ************************************************************* C ** SET READ SUBSET ** C ************************************************************* C IPART1='READ' IPART2='SUBS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV='P-D ' IF(NUMARG.GE.3)THEN IF(IHARG(3).EQ.'PD')THEN IHV='P-D ' IREASB=IHV GOTO5160 ELSEIF(IHARG(3).EQ.'PP')THEN IHV='P-P ' IREASB=IHV GOTO5160 ELSEIF(IHARG(3).EQ.'DD')THEN IHV='D-D ' IREASB=IHV GOTO5160 ELSEIF(IHARG(3).EQ.'DP')THEN IHV='D-P ' IREASB=IHV GOTO5160 ELSEIF(IHARG(3).EQ.'DISP' .OR. IHARG(3).EQ.'D')THEN IHV(1:1)='D' ENDIF ENDIF IF(NUMARG.GE.4)THEN IF(IHARG(4).EQ.'PACK' .OR. IHARG(4).EQ.'P')THEN IHV(3:3)='P' ENDIF ENDIF IREASB=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C ************************************************************* C ** SET READ PAD MISSING COLUMNS ** C ************************************************************* C IPART1='READ' IPART2='PAD ' IPART3='MISS' IPART4='COLU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES' .OR. IHV.EQ.'TRUE')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'FALS' .OR. 1 IHV.EQ.'DEFA')THEN IHV='OFF' ELSE IHV='OFF' ENDIF IREAPD=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2004. C ************************************************************* C ** SET READ MISSING VALUE ** C ************************************************************* C IPART1='READ' IPART2='MISS' IPART3='VALU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES' .OR. IHV.EQ.'DEFA')THEN AV=0.0 ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN AV=0.0 ENDIF PREAMV=AV GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2004. C ************************************************************* C ** SET GEOMETRIC DEFINITION ** C ** ** C ************************************************************* C IPART1='GEOM' IPART2='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES' .OR. IHV.EQ.'DEFA')THEN IHV='KOTZ' ELSEIF(IHV.EQ.'JOHN' .OR. IHV.EQ.'KOTZ' .OR. IHV.EQ.'1')THEN IHV='KOTZ' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='KOTZ' ELSEIF(IHV.EQ.'DLMF' .OR. IHV.EQ.'2')THEN IHV='DLMF' ENDIF IGEODF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2006. C ************************************************************* C ** SET BETA GEOMETRIC DEFINITION ** C ** ** C ************************************************************* C IPART1='BETA' IPART2='GEOM' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'SHIF')THEN IHV='SHIF' ELSE IHV='UNSH' ENDIF IBGEDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2006. C ************************************************************* C ** SET GEETA DEFINITION ** C ** ** C ************************************************************* C IPART1='GEET' IPART2='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'MU ' .OR. IHV.EQ.'LOCA' .OR. IHV.EQ.'MEAN')THEN IHV='MU ' ELSE IHV='THET' ENDIF IGETDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2006. C ************************************************************* C ** SET CONSUL DEFINITION ** C ** ** C ************************************************************* C IPART1='CONS' IPART2='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'MU ' .OR. IHV.EQ.'LOCA' .OR. IHV.EQ.'MEAN')THEN IHV='MU ' ELSE IHV='THET' ENDIF ICONDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2004. C ************************************************************* C ** SET ASYMMETRIC DOUBLE EXPONENTIAL DEFINITION ** C ** ** C ************************************************************* C IPART1='ASYM' IPART2='DOUB' IPART3='EXPO' IPART4='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHV.EQ.'MU' .OR. IHV.EQ.'U' .OR. IHV.EQ.'2')THEN IHV='MU' ELSE IHV='K' ENDIF IADEDF=IHV GOTO5160 ENDIF C IPART1='ASYM' IPART2='LAPL' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'MU' .OR. IHV.EQ.'U' .OR. IHV.EQ.'2')THEN IHV='MU' ELSE IHV='K' ENDIF IADEDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2004. C ************************************************************* C ** SET GENERALIZED PARETO DEFINITION ** C ** ** C ************************************************************* C IPART1='GENE' IPART2='PARE' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'JOHN' .OR. IHV.EQ.'KOTZ' .OR. IHV.EQ.'2')THEN IHV='JOHN' ELSE IHV='SIMI' ENDIF IGEPDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2005. C ************************************************************* C ** SET GENERALIZED PARETO MLE STARTING VALUES ** C ** ** C ************************************************************* C IPART1='GENE' IPART2='PARE' IPART3='MLE ' IPART4='STAR' IPART5='VALU' IPART6='ML ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 (IHARG(3).EQ.IPART3.OR.IHARG(3).EQ.IPART6).AND. 1 IHARG(4).EQ.IPART4.AND.IHARG(5).EQ.IPART5)THEN IHV='EPER' IF(IHARG(6).EQ.'MOME')THEN IHV='MOME' ELSEIF(IHARG(6).EQ.'L '.AND.IHARG(7).EQ.'MOME')THEN IHV='LMOM' ELSEIF(IHARG(6).EQ.'ELEM'.AND.IHARG(7).EQ.'PERC')THEN IHV='EPER' ELSEIF(IHARG(6).EQ.'USER')THEN IHV='USER' ELSE IHV='EPER' ENDIF IGEPSV=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2005. C ************************************************************* C ** SET LOG GAMMA DEFINITION ** C ** ** C ************************************************************* C IPART1='LOG ' IPART2='GAMM' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'REPA')THEN IHV='REPA' ELSE IHV='DEFA' ENDIF ILGADF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2005. C ************************************************************* C ** SET SKEW NORMAL DEFINITION ** C ** ** C ************************************************************* C IPART1='SKEW' IPART2='NORM' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'REPA')THEN IHV='REPA' ELSE IHV='DEFA' ENDIF ISKNDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2006. C ************************************************************* C ** SET GENERALIZED TUKEY LAMBDA DEFINITION ** C ** ** C ************************************************************* C IPART1='GENE' IPART2='TUKE' IPART3='LAMB' IPART4='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHV.EQ.'RAMB' .OR. IHV.EQ.'SCHM')THEN IHV='RAMB' ELSE IHV='FMKL' ENDIF IGLDDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2006. C ************************************************************* C ** SET TEMPORARY FILE ** C ************************************************************* C IPART1='TEMP' IPART2='FILE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'PID ' .OR. IHV.EQ.'ID ')THEN IHV='PID ' ELSE IHV='IGNO' ENDIF ITMPFI=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2004. C ************************************************************* C ** SET GOMPERTZ MAKEHAM DEFINITION ** C ** ** C ************************************************************* C IPART1='GOMP' IPART2='MAKE' IPART3='DEFI' IPART4='REPA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(4).EQ.IPART4 .AND. 1 (IHV.EQ.'MEEK' .OR. IHV.EQ.'ESCO' .OR. IHV.EQ.'3'))THEN IHV='REPA' ELSEIF(IHV.EQ.'MEEK' .OR. IHV.EQ.'ESCO' .OR. IHV.EQ.'2')THEN IHV='MEEK' ELSE IHV='DLMF' ENDIF IMAKDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2004. C ************************************************************* C ** SET BESSEL I FUNCTION DEFINITION ** C ** <1/2> ** C ************************************************************* C IPART1='BESS' IPART2='I ' IPART3='FUNC' IPART4='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHARG(5).EQ.'2 ')THEN IHV='2 ' ELSE IHV='1 ' ENDIF IBEIDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2004. C ************************************************************* C ** SET BESSEL K FUNCTION DEFINITION ** C ** <1/2> ** C ************************************************************* C IPART1='BESS' IPART2='K ' IPART3='FUNC' IPART4='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHARG(5).EQ.'2 ')THEN IHV='2 ' ELSE IHV='1 ' ENDIF IBEIDF=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2006. C ************************************************************* C ** SET FORTRAN FORMAT CONTROL ** C ************************************************************* C IPART1='FORT' IPART2='FORM' IPART3='CONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IFORFM=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C *********************************************************** C ** SET MAXIMUM LIKELIHOOD PERCENTILES ** C ************************************************************ C IPART1='MAXI' IPART2='LIKE' IPART3='PERC' IPART4='QUAN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 (IHARG(3).EQ.IPART3.OR.IHARG(3).EQ.IPART4))THEN IF(IHV.EQ.'NO' .OR. IHV.EQ.'OFF' .OR. IHV.EQ.'FALSE')THEN IQUAVR='NONE' ELSEIF(IHV.EQ.'YES' .OR. IHV.EQ.'ON' .OR. IHV.EQ.'TRUE' .OR. 1 IHV.EQ.'DEFA')THEN IQUAVR='DEFAULT' ELSE IQUAVR(1:4)=IHV IQUAVR(5:8)=IHV2 ENDIF IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55161)IQUAVR 55161 FORMAT('THE MAXIMUM LIKELIHOOD PERCENTILES VARIABLE HAS ', 1 'BEEN SET TO ',A8) CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 2004. C *********************************************************** C ** SET MAXIMUM LIKELIHOOD RELIABILITY ** C ************************************************************ C IPART1='MAXI' IPART2='LIKE' IPART3='RELI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'NO' .OR. IHV.EQ.'OFF' .OR. IHV.EQ.'FALSE')THEN IRELVR='NONE' ELSEIF(IHV.EQ.'YES' .OR. IHV.EQ.'ON' .OR. IHV.EQ.'TRUE')THEN IRELVR='DEFAULT' ELSE IRELVR(1:4)=IHV IRELVR(5:8)=IHV2 ENDIF IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55163)IRELVR 55163 FORMAT('THE MAXIMUM LIKELIHOOD PERCENTILES VARIABLE HAS ', 1 'BEEN SET TO ',A8) CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2006. C ********************************************* C ** STEP 20.A-- ** C ** THE FOLLOWING SECTION IS FOR THE ** C ** MEAN COMMAND. YOU CAN TURN EACH ** C ** OF THE METHODS ON INDIVIDUALLY. ** C ** SET MANDEL PAULE ** C ** SET MODIFIED MANDEL PAULE ** C ** SET VANGEL RUHKIN ** C ** SET BOB ** C ** SET SCHILLER EBERHARDT ** C ** SET METHOD OF MEANS ** C ** SET GRAYBILL DEAL ** C ** SET GRAND MEAN ** C ** SET GENERALIZED CONFIDENCE INTERVALS ** C ** SET DERSIMONIAN LAIRD ** C ** SET FAIRWEATHER ** C ********************************************* C IPART1='MAND' IPART2='PAUL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IMPACM=IHV GOTO5160 ENDIF C IPART1='MODI' IPART2='MAND' IPART3='PAUL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IMMPCM=IHV GOTO5160 ENDIF C IPART1='VANG' IPART2='RUHK' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IVRUCM=IHV GOTO5160 ENDIF C IPART1='RUHK' IPART2='VANG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IVRUCM=IHV GOTO5160 ENDIF C IPART1='MAXI' IPART2='LIKE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IVRUCM=IHV GOTO5160 ENDIF C IPART1='SCHI' IPART2='EBER' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF ISCECM=IHV GOTO5160 ENDIF C IPART1='BOB ' IF(IHARG(1).EQ.IPART1)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IBOBCM=IHV GOTO5160 ENDIF C IPART1='MEAN' IPART2='OF ' IPART3='MEAN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IMOMCM=IHV GOTO5160 ENDIF C IPART1='GRAY' IPART2='DEAL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IGRDCM=IHV GOTO5160 ENDIF C IPART1='GRAN' IPART2='MEAN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IGMECM=IHV GOTO5160 ENDIF C IPART1='GENE' IPART2='CONF' IPART3='INTE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IGCICM=IHV GOTO5160 ENDIF C IPART1='DERS' IPART2='LAIR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IDSLCM=IHV GOTO5160 ENDIF C IPART1='FAIR' IF(IHARG(1).EQ.IPART1)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IFAICM=IHV GOTO5160 ENDIF C IPART1='BAYE' IPART2='CONS' IPART3='PROC' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='ON' ENDIF IBCPCM=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2004. C ************************************************************* C ** SET HYPERGEOMETRIC MAXIMUM LIKELIHOOD ** C ** ** C ************************************************************* C IPART1='HYPE' IPART2='MAXI' IPART3='LIKE' IPART4='MLE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART4)THEN IF(IHV.EQ.'CAPT' .OR. IHV.EQ.'RECA')THEN IHV='CAPT' ELSE IHV='ACCE' ENDIF IHYPTY=IHV GOTO5160 ELSEIF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'CAPT' .OR. IHV.EQ.'RECA')THEN IHV='CAPT' ELSE IHV='ACCE' ENDIF IHYPTY=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2006. C ************************************************************* C ** SET PPCC PLOT LOCATION SCALE ** C ************************************************************* C IPART1='PPCC' IPART2='PLOT' IPART3='LOCA' IPART4='SCAL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHV.EQ.'BIWE')THEN IHV='BIWE' ELSE IHV='DEFA' ENDIF IPPCBW=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2004. C ************************************************************* C ** SET PPCC PLOT AXIS ORDER ** C ************************************************************* C IPART1='PPCC' IPART2='PLOT' IPART3='AXIS' IPART4='ORDE' IPART5='KS ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHARG(5).EQ.'REVE' .OR. IHARG(5).EQ.'FLIP')THEN IHV='REVE' ELSE IHV='DEFA' ENDIF IPPCAO=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2004. C ************************************************************* C ** SET PPCC PLOT DATA POINTS ** C ************************************************************* C IPART1='PPCC' IPART2='PLOT' IPART3='DATA' IPART4='POIN' IPART5='KS ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHARG(5).EQ.'DEFA' .OR. IHARG(5).EQ.'NO' .OR. 1 IHARG(5).EQ.'OFF')THEN IV=0 ELSEIF(IHARG(5).EQ.'ON' .OR. IHARG(5).EQ.'YES')THEN IV=50 ELSE IV=IARG(5) IF(IV.LT.0)IV=0 ENDIF IPPCDP=IV GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2004. C ************************************************************* C ** SET PPCC PLOT AXIS POINTS ** C ************************************************************* C IPART1='PPCC' IPART2='PLOT' IPART3='AXIS' IPART4='POIN' IPART5='AXES' IPART6='KS ' IF((IHARG(1).EQ.IPART1.OR.IHARG(6).EQ.IPART6).AND. 1 IHARG(2).EQ.IPART2.AND. 1 (IHARG(3).EQ.IPART3 .OR. IHARG(3).EQ.'AXES').AND. 1 IHARG(4).EQ.IPART4)THEN IF(NUMARG.EQ.5)THEN IF(IHARG(5).EQ.'DEFA' .OR. IHARG(5).EQ.'NO' .OR. 1 IHARG(5).EQ.'OFF')THEN IPPCAP(1)=0 ELSEIF(IHARG(5).EQ.'ON' .OR. IHARG(5).EQ.'YES')THEN IPPCAP(1)=50 ELSE IPPCAP(1)=IARG(5) ENDIF IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,25151) 25151 FORMAT('THE NUMBER OF POINTS FOR THE FIRST SHAPE ', 1 'PARAMETER OF THE PPCC PLOT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,25152)IPPCAP(1) 25152 FORMAT('HAS JUST BEEN SET TO ',I8) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C ELSEIF(NUMARG.EQ.6)THEN IF(IHARG(5).EQ.'DEFA' .OR. IHARG(5).EQ.'NO' .OR. 1 IHARG(5).EQ.'OFF')THEN IPPCAP(1)=0 ELSEIF(IHARG(5).EQ.'ON' .OR. IHARG(5).EQ.'YES')THEN IPPCAP(1)=50 ELSE IPPCAP(1)=IARG(5) ENDIF IF(IHARG(6).EQ.'DEFA' .OR. IHARG(6).EQ.'NO' .OR. 1 IHARG(6).EQ.'OFF')THEN IPPCAP(2)=0 ELSEIF(IHARG(6).EQ.'ON' .OR. IHARG(6).EQ.'YES')THEN IPPCAP(2)=50 ELSE IPPCAP(2)=IARG(6) ENDIF IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,25151) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,25152)IPPCAP(1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,25156) 25156 FORMAT('THE NUMBER OF POINTS FOR THE SECOND SHAPE ', 1 'PARAMETER OF THE PPCC PLOT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,25152)IPPCAP(2) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF ELSE IPPCAP(1)=0 IPPCAP(2)=0 IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,25158) 25158 FORMAT('THE NUMBER OF POINTS FOR BOTH SHAPE ', 1 'PARAMETERS OF THE PPCC PLOT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,25159) 25159 FORMAT('HAS JUST BEEN SET TO USE THE DEFAULT.') CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF ENDIF GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2004. C ************************************************************* C ** SET PPCC PLOT ** C ************************************************************* C IPART1='PPCC' IPART2='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(3).EQ.'BIWE')THEN IHV='BIWE' ELSEIF(IHARG(3).EQ.'WINS')THEN IHV='WINS' ELSEIF(IHARG(3).EQ.'PERB' .OR. IHARG(3).EQ.'BEND')THEN IHV='PERB' ELSE IHV='LINE' ENDIF IPPCCC=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2004. C ************************************************************* C ** SET PPCC FORMAT <3D/TRACE> ** C ************************************************************* C IPART1='PPCC' IPART2='FORM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(3).EQ.'3D' .OR. IHARG(3).EQ.'3DPL')THEN IHV='3D' ELSE IHV='TRAC' ENDIF IPPCFO=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C ************************************************************* C ** SET CENSORED PPCC PLOT ** C ** ** C ************************************************************* C IPART1='CENS' IPART2='PPCC' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV='UNIM' IF(IHARG(4).EQ.'KAPL' .OR. IHARG(4).EQ.'MEIE')THEN IHV='KAPL' ENDIF IPPCCN=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C ************************************************************* C ** SET CENSORED PROBABILITY PLOT ** C ** ** C ************************************************************* C IPART1='CENS' IPART2='PROB' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV='UNIM' IF(IHARG(4).EQ.'KAPL' .OR. IHARG(4).EQ.'MEIE')THEN IHV='KAPL' ENDIF IPPLCN=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2004. C ************************************************************* C ** SET HISTOGRAM CLASS WIDTH ** C ************************************************************* C IPART1='HIST' IPART2='CLAS' IPART3='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(4).EQ.'DEFA' .OR. IHARG(4).EQ.'SD '.OR. 1 (IHARG(4).EQ.'STAN' .AND. IHARG(5).EQ.'DEVI'))THEN IHV='DEFA' ELSEIF(IHARG(4).EQ.'NORM' .AND. IHARG(5).EQ.'CORR')THEN IHV='NCOR' ELSEIF(IHARG(4).EQ.'NORM')THEN IHV='NORM' ELSEIF((IHARG(4).EQ.'IQ ' .AND. IHARG(5).EQ.'RANG') .OR. 1 (IHARG(4).EQ.'INTE' .AND. IHARG(5).EQ.'RANG') .OR. 1 IHARG(4).EQ.'IQ ')THEN IHV='IQ ' ELSE IHV='DEFA' ENDIF IHSTCW=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2004. C ***************************************************************** C ** SET AVERAGE SHIFTED HISTOGRAM WEIGHT ** C ** SET ASH WEIGHT ** C ***************************************************************** C IPART1='AVER' IPART2='SHIF' IPART3='HIST' IPART4='WEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHARG(5).EQ.'BIWE')THEN IHV='BIWE' ELSE IHV='TRIA' ENDIF IASHWT=IHV GOTO5160 ENDIF C IPART1='ASH ' IPART2='WEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(3).EQ.'BIWE')THEN IHV='BIWE' ELSE IHV='TRIA' ENDIF IASHWT=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2005. C ************************************************************* C ** SET GRUBBS ONE SIDED ** C ************************************************************* C IPART1='GRUB' IPART2='ONE ' IPART3='SIDE' IPART4='1 ' IF(IHARG(1).EQ.IPART1.AND. 1 (IHARG(2).EQ.IPART2.OR.IHARG(2).EQ.IPART4).AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='OFF' ENDIF IGRU1S=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C ************************************************************* C ** SET EXPONENTIAL BIAS CORRECTED ** C ************************************************************* C IPART1='EXPO' IPART2='BIAS' IPART3='CORR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='OFF' ENDIF IEXPBC=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2004. C ************************************************************* C ** SET WEIBULL BIAS CORRECTED ** C ************************************************************* C IPART1='WEIB' IPART2='BIAS' IPART3='CORR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='OFF' ENDIF IWEIBC=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2005. C ************************************************************* C ** SET FRECHET BIAS CORRECTED ** C ************************************************************* C IPART1='FREC' IPART2='BIAS' IPART3='CORR' IPART4='EV2 ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='OFF' ENDIF IFREBC=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2004. C ************************************************************* C ** SET GUMBEL BIAS CORRECTED ** C ************************************************************* C IPART1='GUMB' IPART2='BIAS' IPART3='CORR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES')THEN IHV='ON' ELSEIF(IHV.EQ.'OFF' .OR. IHV.EQ.'NO' .OR. IHV.EQ.'NONE')THEN IHV='OFF' ELSE IHV='OFF' ENDIF IGUMBC=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2004. C ************************************************************* C ** SET MATRIX CORRELATION DIRECTION ** C ************************************************************* C IPART1='MATR' IPART2='CORR' IPART3='DIRE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ROW ')THEN IHV='ROW ' ELSE IHV='COLU' ENDIF ICORDI=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2004. C ************************************************************* C ** SET MATRIX COVARIANCE DIRECTION ** C ************************************************************* C IPART1='MATR' IPART2='COVA' IPART3='DIRE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ROW ')THEN IHV='ROW ' ELSE IHV='COLU' ENDIF ICOVDI=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 2004. C ************************************************************* C ** SET GUI ** C ************************************************************* C IPART1='GUI ' IPART2=' ' IF(IHARG(1).EQ.IPART1)THEN IGUIFL='OFF' IF(IHV.EQ.'ON' .OR. IHV.EQ.'YES' .OR. IHV.EQ.'TRUE')THEN IGUIFL='ON' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2004. C ************************************************************* C ** SET DEFAULT POSTSCRIPT COLOR ** C ** SET POSTSCRIPT DEFAULT COLOR ** C ** SET POSTSCRIPT COLOR DEFAULT ** C ************************************************************* C IPART1='DEFA' IPART2='POST' IPART3='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(3).EQ.'OFF' .OR. IHARG(3).EQ.'NO')THEN IHV='OFF' ELSE IHV='ON' ENDIF IPSTDC=IHV GOTO5160 ENDIF C IPART1='POST' IPART2='DEFA' IPART3='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(3).EQ.'OFF' .OR. IHARG(3).EQ.'NO')THEN IHV='OFF' ELSE IHV='ON' ENDIF IPSTDC=IHV GOTO5160 ENDIF C IPART1='POST' IPART2='COLO' IPART3='DEFA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(3).EQ.'OFF' .OR. IHARG(3).EQ.'NO')THEN IHV='OFF' ELSE IHV='ON' ENDIF IPSTDC=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2002. C **************************************************************** C ** SET BOX PLOT WIDTH ** C **************************************************************** C IPART1='BOX ' IPART2='PLOT' IPART3='WIDT' IF(IHARG(1).EQ.IPART1.AND. 1 (IHARG(2).EQ.IPART2.OR.IHARG(2).EQ.IPART3))THEN IBXPWI=IHV IF(IBXPWI.NE.'FIXE')IBXPWI='VARI' IHV=IBXPWI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2002. C **************************************************************** C ** SET 4-PLOT MLTIPLOT ** C **************************************************************** C IPART1='4 ' IPART2='PLOT' IPART3='MULT' IF(IHARG(1).EQ.IPART1.AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(2).EQ.IPART3)THEN I4PLMC=IHV IF(I4PLMC.EQ.'ON '.OR.I4PLMC.EQ.'YES')THEN I4PLMC='ON' ELSEIF(I4PLMC.EQ.'OFF '.OR.I4PLMC.EQ.'NO')THEN I4PLMC='OFF' ELSE I4PLMC='OFF' ENDIF IHV=I4PLMC GOTO5160 ENDIF C IPART1='4PLO' IPART2='MULT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN I4PLMC=IHV IF(I4PLMC.EQ.'ON '.OR.I4PLMC.EQ.'YES')THEN I4PLMC='ON' ELSEIF(I4PLMC.EQ.'OFF '.OR.I4PLMC.EQ.'NO')THEN I4PLMC='OFF' ELSE I4PLMC='OFF' ENDIF IHV=I4PLMC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2006 C **************************************************************** C ** SET 4PLOT DISTRIBUTION ** C **************************************************************** C IPART1='4PLO' IPART2='DIST' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(3).EQ.'EXPO')THEN I4PLDI='EXPO' ELSE I4PLDI='NORM' ENDIF IHV=I4PLDI GOTO5160 ENDIF C IPART1='4 ' IPART2='PLOT' IPART3='DIST' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(4).EQ.'EXPO')THEN I4PLDI='EXPO' ELSE I4PLDI='NORM' ENDIF IHV=I4PLDI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2002. C **************************************************************** C ** SET 6-PLOT MULTIPLOT ** C **************************************************************** C IPART1='6 ' IPART2='PLOT' IPART3='MULT' IF(IHARG(1).EQ.IPART1.AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(2).EQ.IPART3)THEN I6PLMC=IHV IF(I6PLMC.EQ.'ON '.OR.I6PLMC.EQ.'YES')THEN I6PLMC='ON' ELSEIF(I6PLMC.EQ.'OFF '.OR.I6PLMC.EQ.'NO')THEN I6PLMC='OFF' ELSE I6PLMC='OFF' ENDIF IHV=I6PLMC GOTO5160 ENDIF C IPART1='6PLO' IPART2='MULT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN I6PLMC=IHV IF(I6PLMC.EQ.'ON '.OR.I6PLMC.EQ.'YES')THEN I6PLMC='ON' ELSEIF(I6PLMC.EQ.'OFF '.OR.I6PLMC.EQ.'NO')THEN I6PLMC='OFF' ELSE I6PLMC='OFF' ENDIF IHV=I6PLMC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2002. C **************************************************************** C ** SET RANDOM NUMBER GENERATOR ** C **************************************************************** C IPART1='NUMB' IPART2='OF ' IPART3='CP ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN INUMCP=IARG(4) IF(INUMCP.LE.2)INUMCP=2 IV=INUMCP GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2002 C **************************************************************** C ** SET CAPTURE LINES .... ** C **************************************************************** C IPART1='CAPT' IPART2='LINE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(NUMARG.GT.2)THEN DO3010I=3,MIN(NUMARG,2+MAXCLI) ICAPLI(I-2)=IARG(I) 3010 CONTINUE ELSE DO3020I=1,MAXCLI ICAPLI(I)=25 3020 CONTINUE ENDIF IV=ICAPLI(1) GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2002 C **************************************************************** C ** SET CAPTURE NUMBER ** C **************************************************************** C IPART1='CAPT' IPART2='NUMB' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ICAPNM=IHV IF(ICAPNM.EQ.'YES'.OR.ICAPNM.EQ.'TRUE')ICAPNM='ON' IF(ICAPNM.EQ.'NO'.OR.ICAPNM.EQ.'FALS'.OR.ICAPNM.EQ.'DEFA') 1 ICAPNM='OFF' IHV=ICAPNM GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2002 C **************************************************************** C ** SET CAPTURE BOX ** C **************************************************************** C IPART1='CAPT' IPART2='BOX ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ICAPBX=IHV IF(ICAPBX.EQ.'YES'.OR.ICAPNM.EQ.'TRUE')ICAPNM='ON' IF(ICAPBX.EQ.'NO'.OR.ICAPNM.EQ.'FALS'.OR.ICAPNM.EQ.'DEFA') 1 ICAPBX='OFF' IHV=ICAPBX GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002 C **************************************************************** C ** SET QUANTILE METHOD ** C **************************************************************** C IPART1='QUAN' IPART2='METH' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IQUAME=IHARG(3) IF(IQUAME.EQ.'HERR'.OR.IQUAME.EQ.'DAVI')THEN IQUAME='HD' ELSE IQUAME='ORDE' ENDIF IHV=IQUAME GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002 C **************************************************************** C ** SET QUANTILE STANDARD ERROR METHOD ** C ** ** C **************************************************************** C IPART1='QUAN' IPART2='STAN' IPART3='ERRO' IPART4='METH' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IQUASE=IHARG(5) IF(IQUASE.EQ.'KERN'.OR.IQUASE.EQ.'DENS')THEN IQUASE='KERD' ELSE IQUASE='MJ' ENDIF IHV=IQUASE GOTO5160 ELSEIF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IQUASE=IHARG(4) IF(IQUASE.EQ.'KERN'.OR.IQUASE.EQ.'DENS')THEN IQUASE='KERD' ELSE IQUASE='MJ' ENDIF IHV=IQUASE GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002 C **************************************************************** C ** SET COVARIANCE TYPE ** C **************************************************************** C IPART1='COVA' IPART2='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ICOVTY='DEFA' IF(IHARG(3).EQ.'BIWE')ICOVTY='BIWE' IF(IHARG(3).EQ.'WINS')ICOVTY='WINS' CCCCC IF(IHARG(3).EQ.'PERC')ICOVTY='PBEN' IF(IHARG(3).EQ.'RANK')ICOVTY='RANK' IHV=ICOVTY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002 C **************************************************************** C ** SET CORRELATION TYPE ** C **************************************************************** C IPART1='CORR' IPART2='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ICORTY='DEFA' IF(IHARG(3).EQ.'WINS')ICORTY='WINS' IF(IHARG(3).EQ.'RANK')ICORTY='RANK' IF(IHARG(3).EQ.'PERC')ICORTY='PBCR' IF(IHARG(3).EQ.'BIWE')ICORTY='BIWE' IF(IHARG(3).EQ.'MIDC')ICORTY='BIWE' IF(IHARG(3).EQ.'KEND')ICORTY='KTAU' IF(IHARG(3).EQ.'TAU ')ICORTY='KTAU' IHV=ICORTY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002 C **************************************************************** C ** SET FILE NAME QUOTE ** C **************************************************************** C IPART1='FILE' IPART2='NAME' IPART3='QUOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IFILQU='OFF' IF(IHARG(4).EQ.'ON')IFILQU='ON' IF(IHARG(4).EQ.'YES')IFILQU='ON' IHV=IFILQU IFILQZ=IFILQU GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002 C **************************************************************** C ** SET BOOTSTRAP FIT METHOD ** C **************************************************************** C IPART1='BOOT' IPART2='FIT ' IPART3='METH' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IBOOME='RESI' IF(IHARG(4).EQ.'EFRO')IBOOME='RESI' IF(IHARG(4).EQ.'DATA')IBOOME='DATA' IF(IHARG(4).EQ.'WU')IBOOME='DATA' IHV=IBOOME GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002 C **************************************************************** C ** SET DISTRIBUTIONAL BOOTSTRAP ** C **************************************************************** C IPART1='DIST' IPART2='BOOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IBOOPA='NONP' IF(IHARG(3).EQ.'PARA')IBOOPA='PARA' IHV=IBOOPA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET DECIMAL POINT ** C **************************************************************** C IPART1='DECI' IPART2='POIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IDECPT=IHARG(3) IF(IHARG(3).EQ.'DEFA')IDECPT='.' IF(IHARG(3).EQ.'ON ')IDECPT='.' IF(IHARG(3).EQ.'NONE')IDECPT='.' IF(IHARG(3).EQ.'YES ')IDECPT='.' IF(IHARG(3).EQ.'NO ')IDECPT='.' IF(IHARG(3).EQ.'OFF ')IDECPT='.' IF(IHARG(3).EQ.' ')IDECPT='.' IHV=IDECPT GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET PEAKS OVER THRESHOLD METHOD ** C **************************************************************** C IPART1='POT ' IPART2='METH' IPART3='PEAK' IPART4='OVER' IPART5='THRE' IF((IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2) .OR. 1 (IHARG(1).EQ.IPART3.AND.IHARG(2).EQ.IPART4.AND. 1 IHARG(3).EQ.IPART5.AND.IHARG(4).EQ.IPART2))THEN IPOTME=IHARG(NUMARG) IF(IPOTME.EQ.'DEFA')IPOTME='DEHA' IF(IPOTME.EQ.'ON ')IPOTME='DEHA' IF(IPOTME.EQ.'NONE')IPOTME='DEHA' IF(IPOTME.EQ.'YES ')IPOTME='DEHA' IF(IPOTME.EQ.'NO ')IPOTME='DEHA' IF(IPOTME.EQ.'OFF ')IPOTME='DEHA' IF(IPOTME.EQ.' ')IPOTME='DEHA' IF(IPOTME.EQ.'CME ')THEN IHV=IPOTME ELSEIF(IPOTME.EQ.'MOME')THEN IHV=IPOTME ELSEIF(IPOTME.EQ.'MLE ')THEN IPOTME='DEHA' IHV=IPOTME ELSEIF(IPOTME.EQ.'ML ')THEN IPOTME='MLE ' IHV=IPOTME ELSEIF(IPOTME.EQ.'MAXI')THEN IPOTME='MLE ' IHV=IPOTME ELSEIF(IPOTME.EQ.'LIKE')THEN IPOTME='MLE ' IHV=IPOTME ELSEIF(IPOTME.EQ.'PPCC')THEN IPOTME='PPCC' IHV=IPOTME ELSEIF(IPOTME.EQ.'PLOT')THEN IPOTME='PPCC' IHV=IPOTME ELSEIF(IPOTME.EQ.'PROB')THEN IPOTME='PPCC' IHV=IPOTME ELSEIF(IPOTME.EQ.'KS ')THEN IPOTME='KS ' IHV=IPOTME ELSEIF(IPOTME.EQ.'KOLM')THEN IPOTME='KS ' IHV=IPOTME ELSEIF(IPOTME.EQ.'SMIR')THEN IPOTME='KS ' IHV=IPOTME ELSE IPOTME='DEHA' IHV=IPOTME ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET PEAKS OVER THRESHOLD LOAD FACTOR ** C **************************************************************** C IPART1='POT ' IPART2='PEAK' IPART3='OVER' IPART4='THRE' IPART5='LOAD' IPART6='FACT' IF( 1 (IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART5.AND. 1 IHARG(3).EQ.IPART6) .OR. 1 (IHARG(1).EQ.IPART2.AND.IHARG(2).EQ.IPART3.AND. 1 IHARG(3).EQ.IPART4.AND.IHARG(4).EQ.IPART5.AND. 1 IHARG(5).EQ.IPART6))THEN IPOTLF=IHARG(NUMARG) IF(IPOTLF.EQ.'DEFA')IPOTLF='OFF' IF(IPOTLF.EQ.'ON ')IPOTLF='ON' IF(IPOTLF.EQ.'NONE')IPOTLF='OFF' IF(IPOTLF.EQ.'YES ')IPOTLF='ON' IF(IPOTLF.EQ.'NO ')IPOTLF='OFF' IF(IPOTLF.EQ.'OFF ')IPOTLF='OFF' IF(IPOTLF.EQ.' ')IPOTLF='OFF' IF(IPOTLF.NE.'ON')IPOTLF='OFF' IHV=IPOTLF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET PEAKS OVER THRESHOLD X AXIS ** C **************************************************************** C IPART1='POT ' IPART2='PEAK' IPART3='OVER' IPART4='THRE' IPART5='X ' IPART6='AXIS' IF( 1 (IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART5.AND. 1 IHARG(3).EQ.IPART6) .OR. 1 (IHARG(1).EQ.IPART2.AND.IHARG(2).EQ.IPART3.AND. 1 IHARG(3).EQ.IPART4.AND.IHARG(4).EQ.IPART5.AND. 1 IHARG(5).EQ.IPART6))THEN IPOTAX=IHARG(NUMARG) IF(IPOTAX.EQ.'DEFA')IPOTAX='POIN' IF(IPOTAX.EQ.'ON ')IPOTAX='POIN' IF(IPOTAX.EQ.'NONE')IPOTAX='POIN' IF(IPOTAX.EQ.'YES ')IPOTAX='POIN' IF(IPOTAX.EQ.'NO ')IPOTAX='POIN' IF(IPOTAX.EQ.'OFF ')IPOTAX='POIN' IF(IPOTAX.EQ.' ')IPOTAX='POIN' IF(IPOTAX.NE.'THRE')IPOTAX='POIN' IHV=IPOTAX GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET PEAKS OVER THRESHOLD ITERATIONS ** C **************************************************************** C IPART1='POT ' IPART2='ITER' IPART3='PEAK' IPART4='OVER' IPART5='THRE' IF((IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2) .OR. 1 (IHARG(1).EQ.IPART3.AND.IHARG(2).EQ.IPART4.AND. 1 IHARG(3).EQ.IPART5.AND.IHARG(4).EQ.IPART2))THEN IF(IHARG(NUMARG).EQ.'DEFA')THEN IPOTIT=50 ELSEIF(IHARG(NUMARG).EQ.'DEFA')THEN IPOTIT=50 ELSEIF(NUMARG.EQ.3 .OR. NUMARG.EQ.4)THEN IPOTIT=50 ELSE IPOTIT=IARG(NUMARG) ENDIF IF(IPOTIT.LT.10)IPOTIT=10 IV=IPOTIT GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET PEAKS OVER THRESHOLD INITIAL POINTS ** C **************************************************************** C IPART1='POT ' IPART2='INIT' IPART3='POIN' IPART4='PEAK' IPART5='OVER' IPART6='THRE' IF((IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3) .OR. 1 (IHARG(1).EQ.IPART4.AND.IHARG(2).EQ.IPART5.AND. 1 IHARG(3).EQ.IPART6.AND.IHARG(4).EQ.IPART2.AND. 1 IHARG(5).EQ.IPART3))THEN IF(IHARG(NUMARG).EQ.'DEFA')THEN IPOTNP=25 ELSEIF(IHARG(NUMARG).EQ.'DEFA')THEN IPOTNP=25 ELSEIF(NUMARG.EQ.4 .OR. NUMARG.EQ.5)THEN IPOTNP=25 ELSE IPOTNP=IARG(NUMARG) ENDIF IF(IPOTNP.LT.5)IPOTNP=5 IV=IPOTNP GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET PEAKS OVER THRESHOLD INCREMENT ** C **************************************************************** C IPART1='POT ' IPART2='INCR' IPART3='PEAK' IPART4='OVER' IPART5='THRE' IF((IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2) .OR. 1 (IHARG(1).EQ.IPART3.AND.IHARG(2).EQ.IPART4.AND. 1 IHARG(3).EQ.IPART5.AND.IHARG(4).EQ.IPART2))THEN IF(IHARG(NUMARG).EQ.'DEFA')THEN PPOTIN=-1.0 ELSEIF(IHARG(NUMARG).EQ.'DEFA')THEN PPOTIN=-1.0 ELSE PPOTIN=ARG(NUMARG) ENDIF AV=PPOTIN GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET PEAKS OVER THRESHOLD INCREMENT ** C **************************************************************** C IPART1='POT ' IPART2='PERI' IPART3='PEAK' IPART4='OVER' IPART5='THRE' IF((IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2) .OR. 1 (IHARG(1).EQ.IPART3.AND.IHARG(2).EQ.IPART4.AND. 1 IHARG(3).EQ.IPART5.AND.IHARG(4).EQ.IPART2))THEN IF(IHARG(NUMARG).EQ.'DEFA')THEN PPOTPE=-1.0 ELSEIF(IHARG(NUMARG).EQ.'DEFA')THEN PPOTPE=-1.0 ELSE PPOTPE=ARG(NUMARG) ENDIF AV=PPOTPE GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET PEAKS OVER THRESHOLD TOLERANCE ** C **************************************************************** C IPART1='POT ' IPART2='TOLE' IPART3='PEAK' IPART4='OVER' IPART5='THRE' IF((IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2) .OR. 1 (IHARG(1).EQ.IPART3.AND.IHARG(2).EQ.IPART4.AND. 1 IHARG(3).EQ.IPART5.AND.IHARG(4).EQ.IPART2))THEN IF(IHARG(NUMARG).EQ.'DEFA')THEN PPOTTO=0.05 ELSEIF(IHARG(NUMARG).EQ.'DEFA')THEN PPOTTO=0.05 ELSE PPOTTO=ARG(NUMARG) ENDIF PPOTTO=ABS(PPOTTO) IF(PPOTTO.GT.0.2)PPOTTO=0.05 AV=PPOTTO GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005 C **************************************************************** C ** SET PEAKS OVER THRESHOLD INITIAL THRESHOLD ** C **************************************************************** C IPART1='POT ' IPART2='INIT' IPART3='THRE' IPART4='PEAK' IPART5='OVER' IPART6='THRE' IF((IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3) .OR. 1 (IHARG(1).EQ.IPART4.AND.IHARG(2).EQ.IPART5.AND. 1 IHARG(3).EQ.IPART6.AND.IHARG(4).EQ.IPART2.AND. 1 IHARG(5).EQ.IPART6))THEN IF(IHARG(NUMARG).EQ.'DEFA')THEN PPOTTH=0.0 ELSEIF(IHARG(NUMARG).EQ.'DEFA')THEN PPOTTH=0.0 ELSE PPOTTH=ARG(NUMARG) ENDIF AV=PPOTTH GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2006 C ************************************************************* C ** SET CHISQUARE LIMIT ** C ************************************************************* C IPART1='CHIS' IPART2='LIMI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(NUMARG).EQ.'DEFA')THEN PCHSLM=CPUMAX/10.0 ELSEIF(IHARG(NUMARG).EQ.'ON ')THEN PCHSLM=CPUMAX/10.0 ELSEIF(IHARG(NUMARG).EQ.'YES ')THEN PCHSLM=CPUMAX/10.0 ELSEIF(IHARG(NUMARG).EQ.'OFF ')THEN PCHSLM=CPUMAX/10.0 ELSEIF(IHARG(NUMARG).EQ.'NO ')THEN PCHSLM=CPUMAX/10.0 ELSE PCHSLM=ARG(NUMARG) ENDIF AV=PCHSLM GOTO5170 ENDIF C IPART1='CHI ' IPART2='SQUA' IPART3='LIMI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(NUMARG).EQ.'DEFA')THEN PCHSLM=CPUMAX/10.0 ELSEIF(IHARG(NUMARG).EQ.'ON ')THEN PCHSLM=CPUMAX/10.0 ELSEIF(IHARG(NUMARG).EQ.'YES ')THEN PCHSLM=CPUMAX/10.0 ELSEIF(IHARG(NUMARG).EQ.'OFF ')THEN PCHSLM=CPUMAX/10.0 ELSEIF(IHARG(NUMARG).EQ.'NO ')THEN PCHSLM=CPUMAX/10.0 ELSE PCHSLM=ARG(NUMARG) ENDIF AV=PCHSLM GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2006 C ************************************************************* C ** SET MAXWELL LOCATION ** C ************************************************************* C IPART1='MAXW' IPART2='LOCA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(NUMARG).EQ.'DEFA')THEN PMAXLO=0.0 ELSEIF(IHARG(NUMARG).EQ.'ON ')THEN PMAXLO=0.0 ELSEIF(IHARG(NUMARG).EQ.'YES ')THEN PMAXLO=0.0 ELSEIF(IHARG(NUMARG).EQ.'OFF ')THEN PMAXLO=0.0 ELSEIF(IHARG(NUMARG).EQ.'NO ')THEN PMAXLO=0.0 ELSEIF(IHARG(NUMARG).EQ.'ZERO')THEN PMAXLO=0.0 ELSEIF(IHARG(NUMARG).EQ.'MINI')THEN PMAXLO=CPUMIN ELSEIF(NUMARG.EQ.2)THEN PMAXLO=0.0 ELSE PMAXLO=ARG(NUMARG) ENDIF AV=PMAXLO GOTO5170 ENDIF C C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2002 C **************************************************************** C ** SET QWIN SYSTEM ** C **************************************************************** C IPART1='QWIN' IPART2='SYST' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IQWNSY='SYST' IF(IHARG(3).EQ.'WINE')IQWNSY='WINE' IHV=IQWNSY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2002 C **************************************************************** C ** SET GHOSTSCRIPT PRINTER ** C **************************************************************** C IPART1='GHOS' IPART2='PRIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IPRNGS='OFF' IF(IHARG(3).EQ.'ON')IPRNGS='ON' IF(IHARG(3).EQ.'YES')IPRNGS='ON' IHV=IPRNGS GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2003 C **************************************************************** C ** SET POSTSCRIPT BOUNDING BOX ** C **************************************************************** C IPART1='POST' IPART2='BOUN' IPART3='BOX ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IPSTBB='FIXE' IF(IHARG(4).EQ.'FLOA')IPSTBB='FLOA' IHV=IPSTBB GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2003 C **************************************************************** C ** SET POSTSCRIPT CONVERT ** C **************************************************************** C IPART1='POST' IPART2='CONV' IPART3='OUTP' IPART4='DEVI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IPSTDV='NULL' IF(IHARG(3).EQ.'JPEG')IPSTDV='JPEG' IF(IHARG(3).EQ.'PDF ')IPSTDV='PDF ' IF(IHARG(3).EQ.'TIFF')IPSTDV='TIFF' IF(IHARG(3).EQ.'PBM ')IPSTDV='PBM ' IF(IHARG(3).EQ.'PNG ')IPSTDV='PNG ' IF(IHARG(3).EQ.'PGM ')IPSTDV='PGM ' IF(IHARG(3).EQ.'PNM ')IPSTDV='PNM ' IF(IHARG(3).EQ.'PPM ')IPSTDV='PPM ' IHV=IPSTDV GOTO5160 ELSEIF(IHARG(1).EQ.IPART3.AND.IHARG(2).EQ.IPART4)THEN IPSTDV='NULL' IF(IHARG(3).EQ.'JPEG')IPSTDV='JPEG' IF(IHARG(3).EQ.'PDF ')IPSTDV='PDF ' IF(IHARG(3).EQ.'TIFF')IPSTDV='TIFF' IF(IHARG(3).EQ.'PBM ')IPSTDV='PBM ' IF(IHARG(3).EQ.'PNG ')IPSTDV='PNG ' IF(IHARG(3).EQ.'PGM ')IPSTDV='PGM ' IF(IHARG(3).EQ.'PNM ')IPSTDV='PNM ' IF(IHARG(3).EQ.'PPM ')IPSTDV='PPM ' IHV=IPSTDV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2005 C **************************************************************** C ** SET PARAMETER EXPANSION DIGIT ** C **************************************************************** C IPART1='PARA' IPART2='EXPA' IPART3='DIGI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(4).EQ.'DEFAU' .OR. IHARG(4).EQ.'ON' .OR. 1 IHARG(4).EQ.'OFF')THEN IEXPDI=-1 ELSE IEXPDI=IV ENDIF IV=IEXPDI GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2005 C ******************************************************** C ** SET LINE PRINTER COLUMNS ** C ******************************************************** C IPART1='LINE' IPART2='PRIN' IPART3='COLU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(4).EQ.'DEFAU' .OR. IHARG(4).EQ.'ON' .OR. 1 IHARG(4).EQ.'OFF')THEN ILPRCO=80 ELSE ILPRCO=IV ENDIF IF(ILPRCO.LT.72)ILPRCO=72 IF(ILPRCO.GT.132)ILPRCO=132 IV=ILPRCO GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 1999. C **************************************************************** C ** SET PARAMETER EXPANSION ** C **************************************************************** C IPART1='PARA' IPART2='EXPA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IEXPPA=IHV IF(IEXPPA.NE.'EXPO')IEXPPA='NUME' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 1999. C **************************************************************** C ** SET VARIABLE LABEL EXPAND ** C **************************************************************** C IPART1='VARI' IPART2='LABE' IPART3='EXPA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IVNMEX.EQ.'OFF'.OR.IVNMEX.EQ.'NO')THEN IVNMEX='OFF' ELSE IVNMEX='ON' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2000. C **************************************************************** C ** SET CROSS TABULATE PLOT DIMENSION <<1/2> ** C **************************************************************** C IPART1='CROS' IPART2='TABU' IPART3='PLOT' IPART4='DIME' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ICTBDI=IHV IF(ICTBDI.EQ.'2'.OR.ICTBDI.EQ.'TWO')THEN ICTBDI='2' ELSE ICTBDI='1' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2000. C **************************************************************** C ** SET SORT DIRECTION ** C **************************************************************** C IPART1='SORT' IPART2='DIRE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ISORDI=IHV IF(ISORDI.EQ.'DESC')THEN ISORDI='DESC' ELSE ISORDI='ASCE' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2000. C **************************************************************** C ** SET DEX CONTOUR PLOT DIRECTION ** C ** SET DEX CONTOUR PLOT MODEL ** C **************************************************************** C IPART1='DEX ' IPART2='CONT' IPART3='PLOT' IPART4='DIRE' IPART5='MODE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IF(IHARG(4).EQ.IPART4)THEN IF(IHV.EQ.'QUAD')THEN IDCPDI='QUAD' ELSE IDCPDI='LINE' ENDIF ELSEIF(IHARG(4).EQ.IPART5)THEN IF(IHV.EQ.'MINI'.OR.IHV.EQ.'MIN ')THEN IDCPFI='MINI' ELSE IDCPFI='MAXI' ENDIF ELSEIF(IHARG(4).EQ.'LINE')THEN IDCPFI='LINE' ELSEIF(IHARG(4).EQ.'QUAD')THEN IDCPFI='QUAD' ELSEIF(IHARG(4).EQ.'MIN '.OR.IHARG(4).EQ.'MINI')THEN IDCPDI='MINI' ELSEIF(IHARG(4).EQ.'MAX '.OR.IHARG(4).EQ.'MAXI')THEN IDCPDI='MAXI' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2000. C **************************************************************** C ** SET MANDEL PAULE ** C **************************************************************** C IPART1='MAND' IPART2='PAUL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IMANPA=IHV IF(IMANPA.NE.'MODI')THEN IMANPA='REGU' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2001. C **************************************************************** C ** SET LOCATION STATISTIC ** C **************************************************************** C IPART1='LOCA' IPART2='STAT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ISTALO=IHV IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'MEAN')THEN ISTALO='GEOM' ELSEIF(IHARG(3).EQ.'HARM'.AND.IHARG(4).EQ.'MEAN')THEN ISTALO='HARM' ELSEIF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'MEAN')THEN ISTALO='WINS' ELSEIF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'LOCA')THEN ISTALO='BILO' ELSEIF(IHARG(3).EQ.'HODG'.AND.IHARG(4).EQ.'LEHM')THEN ISTALO='HLEH' ENDIF IF(ISTALO.EQ.'MIN')ISTALO='MINI' IF(ISTALO.EQ.'BIWE')ISTALO='BILO' IF(ISTALO.NE.'MEAN'.AND.ISTALO.NE.'MEDI'.AND. 1 ISTALO.NE.'MIDM'.AND.ISTALO.NE.'TRIM'.AND. 1 ISTALO.NE.'MIDM'.AND.ISTALO.NE.'TRIM'.AND. 1 ISTALO.NE.'GEOM'.AND.ISTALO.NE.'HARM'.AND. 1 ISTALO.NE.'WINS'.AND.ISTALO.NE.'BILO'.AND. 1 ISTALO.NE.'HLEH'.AND. 1 ISTALO.NE.'MIDR'.AND.ISTALO.NE.'MINI')THEN ISTALO='MEAN' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2001. C **************************************************************** C ** SET SCALE STATISTIC ** C **************************************************************** C IPART1='SCAL' IPART2='STAT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ISTASC=IHV IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'SD ')THEN ISTASC='GEOM' ELSEIF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'STAN'.AND. 1 IHARG(5).EQ.'DEVI')THEN ISTASC='GEOM' ELSEIF(IHARG(3).EQ.'IQ '.AND.IHARG(4).EQ.'RANG')THEN ISTASC='IQRA' ELSEIF(IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'RANG')THEN ISTASC='IQRA' ELSEIF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'SCAL')THEN ISTASC='BISC' ELSEIF(IHARG(3).EQ.'SN'.AND.IHARG(4).EQ.'SCAL')THEN ISTASC='SNSC' ELSEIF(IHARG(3).EQ.'SN')THEN ISTASC='SNSC' ELSEIF(IHARG(3).EQ.'QN'.AND.IHARG(4).EQ.'SCAL')THEN ISTASC='QNSC' ELSEIF(IHARG(3).EQ.'QN')THEN ISTASC='QNSC' ELSEIF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'MIDV')THEN ISTASC='BIMV' ELSEIF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'SD')THEN ISTASC='WISD' ELSEIF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'STAN'.AND. 1 IHARG(5).EQ.'DEVI')THEN ISTASC='WISD' ELSEIF(IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'BEND'.AND. 1 IHARG(5).EQ.'MIDV')THEN ISTASC='PBMV' ENDIF IF(ISTASC.EQ.'AVER')ISTASC='AAD' IF(ISTASC.EQ.'MEDI')ISTASC='MAD' IF(ISTASC.EQ.'STAN')ISTASC='SD' IF(ISTASC.EQ.'BIWE')ISTASC='BISC' IF(ISTASC.NE.'AAD'.AND.ISTASC.NE.'MAD'.AND. 1 ISTASC.NE.'RANG'.AND.ISTASC.NE.'GEOM'.AND. 1 ISTASC.NE.'BIMV'.AND.ISTASC.NE.'PBMV'.AND. 1 ISTASC.NE.'WISD'.AND. 1 ISTASC.NE.'IQRA'.AND.ISTASC.NE.'BISC')THEN ISTASC='SD' ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2001. C ************************************************************** C ** SET SUPERSCRIPT HORIZONTAL SCALE ** C ************************************************************** C IPART1='SUPE' IPART2='HORI' IPART3='SCAL' IPART4='SUBS' IPART5='X ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 (IHARG(2).EQ.IPART2.OR.IHARG(2).EQ.IPART5).AND. 1 IHARG(3).EQ.IPART3)THEN PSUPXS=AV IF(PSUPXS.LE.0.0 .OR. PSUPXS.GE.20.0)PSUPXS=0.5 GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2001. C ************************************************************** C ** SET SUPERSCRIPT VERTICAL SCALE ** C ************************************************************** C IPART1='SUPE' IPART2='VERT' IPART3='SCAL' IPART4='SUBS' IPART5='Y ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 (IHARG(2).EQ.IPART2.OR.IHARG(2).EQ.IPART5).AND. 1 IHARG(3).EQ.IPART3)THEN PSUPYS=AV IF(PSUPYS.LE.0.0 .OR. PSUPYS.GE.20.0)PSUPYS=0.5 GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2001. C ************************************************************** C ** SET ORTHOGONAL DISTANCE TRUST REGION RADIUS ** C ************************************************************** C IPART1='ORTH' IPART2='DIST' IPART3='TRUS' IPART4='REGI' IPART5='RADI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN PODRTF=AV GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2001. C ************************************************************** C ** SET ORTHOGONAL DISTANCE STOP TOLERANCE ** C ************************************************************** C IPART1='ORTH' IPART2='DIST' IPART3='STOP' IPART4='TOLE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN PODRST=AV GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2001. C ************************************************************** C ** SET ORTHOGONAL DISTANCE PARAMETER TOLERANCE ** C ************************************************************** C IPART1='ORTH' IPART2='DIST' IPART3='PARA' IPART4='TOLE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN PODRPT=AV GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2001. C ************************************************************** C ** SET ORTHOGONAL DISTANCE PRINT OPTION ** C ************************************************************** C IPART1='ORTH' IPART2='DIST' IPART3='PRIN' IPART4='OPTI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IODRPO=IHV GOTO5160 ENDIF C C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX LABELS ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMLA=IHV IF(ISPMLA.NE.'XON'.AND.ISPMLA.NE.'YON'.AND. 1 ISPMLA.NE.'OFF'.AND.ISPMLA.NE.'BOX') 1 ISPMLA='ON' GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISPMLA=IHV IF(ISPMLA.NE.'XON'.AND.ISPMLA.NE.'YON'.AND. 1 ISPMLA.NE.'OFF'.AND.ISPMLA.NE.'BOX') 1 ISPMLA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITIONING PLOT LABELS ** C **************************************************************** C IPART1='COND' IPART2='PLOT' IPART3='LABE' IPART4='COND' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN ICPLLA=IHV IF(ICPLLA.NE.'XON'.AND.ICPLLA.NE.'YON'.AND. 1 ICPLLA.NE.'OFF'.AND.ICPLLA.NE.'BOX ') 1 ICPLLA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT LABELS ** C **************************************************************** C IPART1='FACT' IPART2='PLOT' IPART3='LABE' IPART4='SCAT' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN IFPLLA=IHV IF(IFPLLA.NE.'XON'.AND.IFPLLA.NE.'YON'.AND. 1 IFPLLA.NE.'OFF'.AND.IFPLLA.NE.'BOX ') 1 IFPLLA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX X AXIS ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='X ' IPART5='AXIS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN ISPMXA=IHV IF(ISPMXA.NE.'BOTT'.AND.ISPMXA.NE.'TOP '.AND.ISPMXA.NE.'ALTE') 1 ISPMXA='ON' GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='X ' IPART4='AXIS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMXA=IHV IF(ISPMXA.NE.'BOTT'.AND.ISPMXA.NE.'TOP '.AND.ISPMXA.NE.'ALTE') 1 ISPMXA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX Y AXIS ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='Y ' IPART5='AXIS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN ISPMYA=IHV IF(ISPMYA.NE.'LEFT'.AND.ISPMYA.NE.'RIGH'.AND.ISPMYA.NE.'ALTE') 1 ISPMYA='ON' GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='Y ' IPART4='AXIS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMYA=IHV IF(ISPMYA.NE.'LEFT'.AND.ISPMYA.NE.'RIGH'.AND.ISPMYA.NE.'ALTE') 1 ISPMYA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT X AXIS ** C **************************************************************** C IPART1='FACT' IPART2='PLOT' IPART3='X ' IPART4='AXIS' IPART5='SCAT' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3.AND. 1 IHARG(4).EQ.IPART4)THEN IFPLXA=IHV IF(IFPLXA.NE.'BOTT'.AND.IFPLXA.NE.'TOP '.AND.IFPLXA.NE.'ALTE') 1 IFPLXA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT Y AXIS ** C **************************************************************** C IPART1='FACT' IPART2='PLOT' IPART3='Y ' IPART4='AXIS' IPART5='SCAT' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3.AND. 1 IHARG(4).EQ.IPART4)THEN IFPLYA=IHV IF(IFPLYA.NE.'LEFT'.AND.IFPLYA.NE.'RIGH'.AND.IFPLYA.NE.'ALTE') 1 IFPLYA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITION PLOT X AXIS ** C **************************************************************** C IPART1='COND' IPART2='PLOT' IPART3='X ' IPART4='AXIS' IPART5='SUBS' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3.AND. 1 IHARG(4).EQ.IPART4)THEN ICPLXA=IHV IF(ICPLXA.NE.'BOTT'.AND.ICPLXA.NE.'TOP '.AND.ICPLXA.NE.'ALTE') 1 ICPLXA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITION PLOT Y AXIS ** C **************************************************************** C IPART1='COND' IPART2='PLOT' IPART3='Y ' IPART4='AXIS' IPART5='SUBS' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3.AND. 1 IHARG(4).EQ.IPART4)THEN ICPLYA=IHV IF(ICPLYA.NE.'LEFT'.AND.ICPLYA.NE.'RIGH'.AND.ICPLYA.NE.'ALTE') 1 ICPLYA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX CORRELATION ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='CORR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMCC=IHV IF(ISPMCC.NE.'ON'.AND.ISPMCC.NE.'OFF')ISPMCC='OFF' GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='CORR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISPMCC=IHV IF(ISPMCC.NE.'ON'.AND.ISPMCC.NE.'OFF')ISPMCC='OFF' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 1999 C ***************************************************** C ** TREAT THE SET X2LABEL SUFFIX CASE ** C ***************************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'X2LA'.AND. 1IHARG(2).EQ.'SUFF')GOTO9510 GOTO9590 C 9510 CONTINUE ISPX2S='DEFAULT' NCHSUF=7 IF(NUMARG.LE.2)GOTO9550 IF(IHARG(NUMARG).EQ.'OFF')THEN ISPX2S=' ' NCHSUF=0 GOTO9550 ENDIF IF(IHARG(NUMARG).EQ.'AUTO')GOTO9550 IF(IHARG(NUMARG).EQ.'DEFA')GOTO9550 C DO9530I=1,80 ICANS(I:I)=IANSLC(I) 9530 CONTINUE C ISTART=1 ISTOP=IWIDTH IWORD=NUMARG+1 DO9532I=ISTART,ISTOP-4 IF(IANS(I).EQ.'S '.AND.IANS(I+1).EQ.'U'.AND. 1 IANS(I+2).EQ.'F'.AND.IANS(I+3).EQ.'F')THEN ISTRT2=I+3 DO9534J=ISTRT2,ISTOP IF(ICANS(J:J).EQ.' ')THEN NCSTRI=ISTOP-J ISTRIN(1:NCSTRI)=ICANS(J+1:IWIDTH) GOTO9539 ENDIF 9534 CONTINUE NCSTRI=0 ENDIF 9532 CONTINUE 9539 CONTINUE C IF(NCSTRI.GE.1)GOTO9540 ISPX2S=' ' NCHSUF=0 GOTO9550 C 9540 CONTINUE ISPX2S=' ' NCHSUF=NCSTRI IF(NCHSUF.GT.16)NCHSUF=16 ISPX2S(1:NCHSUF)=ISTRIN(1:NCHSUF) C 9550 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9549 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9541) 9541 FORMAT('THE X2LABEL SUFFIX (FOR MATRIX, FACTOR, AND ', 1'CONDITION PLOTS) HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') IF(NCHSUF.LT.1)GOTO9549 WRITE(ICOUT,9542)ISPX2S 9542 FORMAT(A16) CALL DPWRST('XXX','BUG ') 9549 CONTINUE GOTO9000 9590 CONTINUE C CCCCC FOLLOWING SECTION ADDED NOVEMBER 1999 C ***************************************************** C ** TREAT THE SET X2LABEL PREFIX CASE ** C ***************************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'X2LA'.AND. 1IHARG(2).EQ.'PREF')GOTO9610 GOTO9690 C 9610 CONTINUE ISPX2P='DEFAULT' NCHSUF=7 IF(NUMARG.LE.2)GOTO9650 IF(IHARG(NUMARG).EQ.'OFF')THEN ISPX2P=' ' NCSUFF=0 GOTO9650 ENDIF IF(IHARG(NUMARG).EQ.'AUTO')GOTO9650 IF(IHARG(NUMARG).EQ.'DEFA')GOTO9650 C DO9630I=1,80 ICANS(I:I)=IANSLC(I) 9630 CONTINUE C ISTART=1 ISTOP=IWIDTH IWORD=NUMARG+1 DO9632I=ISTART,ISTOP-4 IF(IANS(I).EQ.'P '.AND.IANS(I+1).EQ.'R'.AND. 1 IANS(I+2).EQ.'E'.AND.IANS(I+3).EQ.'F')THEN ISTRT2=I+3 DO9634J=ISTRT2,ISTOP IF(ICANS(J:J).EQ.' ')THEN NCSTRI=ISTOP-J ISTRIN(1:NCSTRI)=ICANS(J+1:IWIDTH) GOTO9639 ENDIF 9634 CONTINUE NCSTRI=0 ENDIF 9632 CONTINUE 9639 CONTINUE C IF(NCSTRI.GE.1)GOTO9640 NCHSUF=0 ISPX2P=' ' GOTO9650 C 9640 CONTINUE ISPX2P=' ' NCHSUF=NCSTRI IF(NCHSUF.GT.16)NCHSUF=16 ISPX2P(1:NCHSUF)=ISTRIN(1:NCHSUF) C 9650 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9649 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9641) 9641 FORMAT('THE X2LABEL PREFIX (FOR MATRIX, FACTOR, AND ', 1'CONDITION PLOTS) HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') IF(NCHSUF.LT.1)GOTO9649 WRITE(ICOUT,9642)ISPX2P 9642 FORMAT(A16) CALL DPWRST('XXX','BUG ') 9649 CONTINUE GOTO9000 9690 CONTINUE C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX X2LABEL ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='X2LA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IF(IHARG(5).EQ.'PERC'.AND.IHARG(6).EQ.'CORR')THEN ISPX2L='PCOR' ELSEIF(IHARG(5).EQ.'PERC'.AND.IHARG(6).EQ.'ACCE')THEN ISPX2L='PACC' ELSEIF(IHARG(5).EQ.'NUMB'.AND.IHARG(6).EQ.'ACCE')THEN ISPX2L='NACC' ELSEIF(IHARG(5).EQ.'ACCE'.AND.IHARG(6).EQ.'TOTA'.AND. 1 IHARG(7).EQ.'PERC')THEN ISPX2L='ATP ' ELSEIF(IHARG(5).EQ.'ACCE'.AND.IHARG(6).EQ.'TOTA')THEN ISPX2L='AT ' ELSEIF(IHARG(5).EQ.'CORR')THEN ISPX2L='CORR' ELSEIF(IHARG(5).EQ.'EFFE')THEN ISPX2L='EFFE' ELSE ISPX2L='OFF' ENDIF IHV=ISPX2L GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='X2LA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(4).EQ.'PERC'.AND.IHARG(5).EQ.'CORR')THEN ISPX2L='PCOR' ELSEIF(IHARG(4).EQ.'PERC'.AND.IHARG(5).EQ.'ACCE')THEN ISPX2L='PACC' ELSEIF(IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'ACCE')THEN ISPX2L='NACC' ELSEIF(IHARG(5).EQ.'ACCE'.AND.IHARG(6).EQ.'TOTA'.AND. 1 IHARG(7).EQ.'PERC')THEN ISPX2L='ATP ' ELSEIF(IHARG(5).EQ.'ACCE'.AND.IHARG(6).EQ.'TOTA')THEN ISPX2L='AT ' ELSEIF(IHARG(4).EQ.'CORR')THEN ISPX2L='CORR' ELSEIF(IHARG(4).EQ.'EFFE')THEN ISPX2L='EFFE' ELSE ISPX2L='OFF' ENDIF IHV=ISPX2L GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT X2LABEL ** C **************************************************************** C IPART1='FACT' IPART2='SCAT' IPART3='PLOT' IPART4='X2LA' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART2).AND. 1 IHARG(2).EQ.IPART3.AND.IHARG(3).EQ.IPART4)THEN IF(IHARG(4).EQ.'PERC'.AND.IHARG(5).EQ.'CORR')THEN IFPX2L='PCOR' ELSEIF(IHARG(4).EQ.'PERC'.AND.IHARG(5).EQ.'ACCE')THEN IFPX2L='PACC' ELSEIF(IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'ACCE')THEN IFPX2L='NACC' ELSEIF(IHARG(4).EQ.'ACCE'.AND.IHARG(5).EQ.'TOTA'.AND. 1 IHARG(6).EQ.'PERC')THEN IFPX2L='ATP ' ELSEIF(IHARG(4).EQ.'ACCE'.AND.IHARG(5).EQ.'TOTA')THEN IFPX2L='AT ' ELSEIF(IHARG(4).EQ.'CORR')THEN IFPX2L='CORR' ELSEIF(IHARG(4).EQ.'EFFE')THEN IFPX2L='EFFE' ELSE IFPX2L='OFF' ENDIF IHV=IFPX2L GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITION PLOT X2LABEL ** C **************************************************************** C IPART1='COND' IPART2='SUBS' IPART3='PLOT' IPART4='X2LA' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART2).AND. 1 IHARG(2).EQ.IPART3.AND.IHARG(3).EQ.IPART4)THEN IF(IHARG(4).EQ.'PERC'.AND.IHARG(5).EQ.'CORR')THEN ICPX2L='PCOR' ELSEIF(IHARG(4).EQ.'PERC'.AND.IHARG(5).EQ.'ACCE')THEN ICPX2L='PACC' ELSEIF(IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'ACCE')THEN ICPX2L='NACC' ELSEIF(IHARG(4).EQ.'ACCE'.AND.IHARG(5).EQ.'TOTA'.AND. 1 IHARG(6).EQ.'PERC')THEN ICPX2L='ATP ' ELSEIF(IHARG(4).EQ.'ACCE'.AND.IHARG(5).EQ.'TOTA')THEN ICPX2L='AT ' ELSEIF(IHARG(4).EQ.'CORR')THEN ICPX2L='CORR' ELSEIF(IHARG(4).EQ.'EFFE')THEN ICPX2L='EFFE' ELSE ICPX2L='OFF' ENDIF IHV=ICPX2L GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT CORRELATION ** C **************************************************************** C IPART1='FACT' IPART4='SCAT' IPART2='PLOT' IPART3='CORR' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN IFPLCC=IHV IF(IFPLCC.NE.'ON'.AND.IFPLCC.NE.'OFF')IFPLCC='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITION PLOT CORRELATION ** C **************************************************************** C IPART1='COND' IPART4='SUBS' IPART2='PLOT' IPART3='CORR' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN ICPLCC=IHV IF(ICPLCC.NE.'ON'.AND.ICPLCC.NE.'OFF')ICPLCC='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX DIAGONAL ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='DIAG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMDI=IHV GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='DIAG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISPMDI=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX LOWER DIAGONAL ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='LOWE' IPART5='DIAG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN ISPMLD=IHV GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='LOWE' IPART4='DIAG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMLD=IHV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX PLOT TYPE ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMPT=IHV IF(IHARG(5).EQ.'Q'.AND.IHARG(6).EQ.'Q')THEN ISPMPT='QQPL' ELSEIF(IHARG(5).EQ.'QUAN'.AND.IHARG(6).EQ.'QUAN')THEN ISPMPT='QQPL' ELSEIF(IHARG(5).EQ.'QQ'.AND.IHARG(6).EQ.'PLOT')THEN ISPMPT='QQPL' ELSEIF(IHARG(5).EQ.'DEX'.AND.IHARG(6).EQ.'CONT')THEN ISPMPT='DEXC' ELSEIF(IHARG(5).EQ.'DEX'.AND.IHARG(6).EQ.'INTE')THEN ISPMPT='DEXI' ELSEIF(IHARG(5).EQ.'DEX'.AND.IHARG(7).EQ.'INTE')THEN ISPMPT='DEXS' ISPMST=IHARG(6) ISPMS2=IHARG2(6) ELSEIF(IHARG(5).EQ.'DEX'.AND.IHARG(8).EQ.'INTE')THEN ISPMPT='DEXS' ISPMST=IHARG(5) ISPMS2=IHARG2(6) ISPMS3=IHARG(7) ISPMS4=IHARG2(7) ELSEIF(IHARG(5).EQ.'CROS'.AND.IHARG(6).EQ.'TABU')THEN ISPMPT='CROS' ISPMST=' ' ISPMS2=' ' ISPMS3=' ' ISPMS4=' ' IF(IHARG(7).NE.' ')ISPMST=IHARG(7) IF(IHARG2(7).NE.' ')ISPMS2=IHARG2(7) IF(IHARG(8).NE.' ')ISPMS3=IHARG(8) IF(IHARG2(8).NE.' ')ISPMS4=IHARG2(8) ENDIF GOTO7090 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISPMPT=IHV IF(IHARG(4).EQ.'Q'.AND.IHARG(5).EQ.'Q')THEN ISPMPT='QQPL' ELSEIF(IHARG(4).EQ.'QUAN'.AND.IHARG(5).EQ.'QUAN')THEN ISPMPT='QQPL' ELSEIF(IHARG(4).EQ.'QQ'.AND.IHARG(5).EQ.'PLOT')THEN ISPMPT='QQPL' ELSEIF(IHARG(4).EQ.'DEX'.AND.IHARG(5).EQ.'INTE')THEN ISPMPT='DEXI' ELSEIF(IHARG(4).EQ.'DEX'.AND.IHARG(5).EQ.'CONT')THEN ISPMPT='DEXC' ELSEIF(IHARG(4).EQ.'DEX'.AND.IHARG(6).EQ.'INTE')THEN ISPMPT='DEXS' ISPMST=IHARG(5) ISPMS2=IHARG2(5) ELSEIF(IHARG(4).EQ.'DEX'.AND.IHARG(7).EQ.'INTE')THEN ISPMPT='DEXS' ISPMST=IHARG(5) ISPMS2=IHARG2(5) ISPMS3=IHARG(6) ISPMS4=IHARG2(6) ELSEIF(IHARG(4).EQ.'CROS'.AND.IHARG(5).EQ.'TABU')THEN ISPMPT='CROS' ISPMST=' ' ISPMS2=' ' ISPMS3=' ' ISPMS4=' ' IF(IHARG(6).NE.' ')ISPMST=IHARG(6) IF(IHARG2(6).NE.' ')ISPMS2=IHARG2(6) IF(IHARG(7).NE.' ')ISPMS3=IHARG(7) IF(IHARG2(7).NE.' ')ISPMS4=IHARG2(7) ENDIF GOTO7090 ELSE GOTO7099 ENDIF C 7090 CONTINUE IF(ISPMPT.NE.'QQPL'.AND.ISPMPT.NE.'BIHI'.AND. 1 ISPMPT.NE.'CORR'.AND.ISPMPT.NE.'LAG '.AND. 1 ISPMPT.NE.'SPEC'.AND.ISPMPT.NE.'YOUD'.AND. 1 ISPMPT.NE.'CROS'.AND.ISPMPT.NE.'DEXC'.AND. 1 ISPMPT.NE.'DEXI'.AND.ISPMPT.NE.'DEXS')ISPMPT='PLOT' GOTO5160 C 7099 CONTINUE C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITIONING PLOT PLOT TYPE ** C **************************************************************** C IPART1='COND' IPART4='SUBS' IPART2='PLOT' IPART3='TYPE' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN ICPLPT=IHV IF(IHARG(4).EQ.'STAT')THEN ICPLPT='STAT' ELSEIF(IHARG(4).EQ.'PERC')THEN ICPLPT='PERC' ELSEIF(IHARG(4).EQ.'BIHI')THEN ICPLPT='BIHI' ELSEIF(IHARG(4).EQ.'QUAN')THEN ICPLPT='QQPL' ELSEIF(IHARG(4).EQ.'HIST')THEN ICPLPT='HIST' ELSEIF(IHARG(4).EQ.'DENS' .OR. IHARG(4).EQ.'KERN')THEN ICPLPT='DENS' ELSEIF(IHARG(4).EQ.'AUTO')THEN ICPLPT='AUTO' ELSEIF(IHARG(4).EQ.'LAG ')THEN ICPLPT='LAG ' ELSEIF(IHARG(4).EQ.'SPEC ')THEN ICPLPT='SPEC ' ELSEIF(IHARG(4).EQ.'RUN ')THEN ICPLPT='RUNS' ELSEIF(IHARG(4).EQ.'BOX '.AND.IHARG(5).EQ.'COX '.AND. 1 IHARG(6).EQ.'LINE')THEN ICPLPT='BOXC' ELSEIF(IHARG(4).EQ.'DEX '.AND.IHARG(5).EQ.'CONT')THEN ICPLPT='DEXC' ELSEIF(IHARG(4).EQ.'YATE'.AND.IHARG(5).EQ.'CUBE')THEN ICPLPT='YACU' ELSEIF(IHARG(4).EQ.'3D '.AND.IHARG(5).EQ.'PLOT')THEN ICPLPT='3DPL' ELSEIF(IHARG(4).EQ.'CROS'.AND.IHARG(5).EQ.'TABU')THEN ICPLPT='CROS' ICPLST=' ' ICPLS2=' ' ICPLS3=' ' ICPLS4=' ' IF(IHARG(6).NE.' ')ICPLST=IHARG(6) IF(IHARG2(6).NE.' ')ICPLS2=IHARG2(6) IF(IHARG(7).NE.' ')ICPLS3=IHARG(7) IF(IHARG2(7).NE.' ')ICPLS4=IHARG2(7) ELSEIF(IHARG(4).EQ.'PROB'.AND.IHARG(5).EQ.'PLOT ')THEN ICPLPT='PROB' ICPLP1='NORM' ICPLP2=' ' ICPLP3=' ' ICPLP4=' ' ICPLP5=' ' ELSEIF(IHARG(5).EQ.'PROB'.AND.IHARG(6).EQ.'PLOT ')THEN ICPLPT='PROB' ICPLP1=IHARG(4) ICPLP2=' ' ICPLP3=' ' ICPLP4=' ' ICPLP5=' ' ELSEIF(IHARG(6).EQ.'PROB'.AND.IHARG(7).EQ.'PLOT ')THEN ICPLPT='PROB' ICPLP1=IHARG(4) ICPLP2=IHARG(5) ICPLP3=' ' ICPLP4=' ' ICPLP5=' ' ELSEIF(IHARG(7).EQ.'PROB'.AND.IHARG(8).EQ.'PLOT ')THEN ICPLPT='PROB' ICPLP1=IHARG(4) ICPLP2=IHARG(5) ICPLP3=IHARG(6) ICPLP4=' ' ICPLP5=' ' ELSEIF(IHARG(8).EQ.'PROB'.AND.IHARG(9).EQ.'PLOT ')THEN ICPLPT='PROB' ICPLP1=IHARG(4) ICPLP2=IHARG(5) ICPLP3=IHARG(6) ICPLP4=IHARG(7) ICPLP5=' ' ELSEIF(IHARG(9).EQ.'PROB'.AND.IHARG(10).EQ.'PLOT ')THEN ICPLPT='PROB' ICPLP1=IHARG(4) ICPLP2=IHARG(5) ICPLP3=IHARG(6) ICPLP4=IHARG(7) ICPLP5=IHARG(8) ELSEIF(IHARG(4).EQ.'PPCC'.AND.IHARG(5).EQ.'PLOT ')THEN ICPLPT='PPCC' ICPLC1='TUKE' ICPLC2='LAMB' ICPLC3=' ' ICPLC4=' ' ICPLC5=' ' ELSEIF(IHARG(5).EQ.'PPCC'.AND.IHARG(6).EQ.'PLOT ')THEN ICPLPT='PPCC' ICPLC1=IHARG(4) ICPLc2=' ' ICPLC3=' ' ICPLC4=' ' ICPLC5=' ' ELSEIF(IHARG(6).EQ.'PPCC'.AND.IHARG(7).EQ.'PLOT ')THEN ICPLPT='PPCC' ICPLc1=IHARG(4) ICPLC2=IHARG(5) ICPLC3=' ' ICPLC4=' ' ICPLC5=' ' ELSEIF(IHARG(7).EQ.'PPCC'.AND.IHARG(8).EQ.'PLOT ')THEN ICPLPT='PPCC' ICPLC1=IHARG(4) ICPLC2=IHARG(5) ICPLC3=IHARG(6) ICPLC4=' ' ICPLC5=' ' ELSEIF(IHARG(8).EQ.'PPCC'.AND.IHARG(9).EQ.'PLOT ')THEN ICPLPT='PPCC' ICPLC1=IHARG(4) ICPLC2=IHARG(5) ICPLC3=IHARG(6) ICPLC4=IHARG(7) ICPLC5=' ' ELSEIF(IHARG(9).EQ.'PPCC'.AND.IHARG(10).EQ.'PLOT ')THEN ICPLPT='PROB' ICPLC1=IHARG(4) ICPLC2=IHARG(5) ICPLC3=IHARG(6) ICPLC4=IHARG(7) ICPLC5=IHARG(8) ENDIF IF(ICPLPT.NE.'PERC'.AND.ICPLPT.NE.'BIHI'.AND. 1 ICPLPT.NE.'STAT'.AND.ICPLPT.NE.'RUNS'.AND. 1 ICPLPT.NE.'SPEC'.AND.ICPLPT.NE.'AUTO'.AND. 1 ICPLPT.NE.'LAG '.AND.ICPLPT.NE.'QQPL'.AND. 1 ICPLPT.NE.'CROS'.AND. 1 ICPLPT.NE.'PROB'.AND.ICPLPT.NE.'PPCC'.AND. 1 ICPLPT.NE.'YACU'.AND.ICPLPT.NE.'3DPL'.AND. 1 ICPLPT.NE.'BOXC'.AND.ICPLPT.NE.'HIST')ICPLPT='PLOT' IHV=ICPLPT GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT PLOT TYPE ** C **************************************************************** C IPART1='FACT' IPART2='PLOT' IPART3='TYPE' IPART4='SCAT' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN IFPLPT=IHV IF(IHARG(4).EQ.'STAT')THEN IFPLPT='STAT' ELSEIF(IHARG(4).EQ.'PERC')THEN IFPLPT='PERC' ELSEIF(IHARG(4).EQ.'BIHI')THEN IFPLPT='BIHI' ELSEIF(IHARG(4).EQ.'QUAN')THEN IFPLPT='QQPL' ELSEIF(IHARG(4).EQ.'HIST')THEN IFPLPT='HIST' ELSEIF(IHARG(4).EQ.'AUTO')THEN IFPLPT='AUTO' ELSEIF(IHARG(4).EQ.'LAG ')THEN IFPLPT='LAG ' ELSEIF(IHARG(4).EQ.'SPEC ')THEN IFPLPT='SPEC ' ELSEIF(IHARG(4).EQ.'RUN ')THEN IFPLPT='RUNS' ELSEIF(IHARG(4).EQ.'BOX '.AND.IHARG(5).EQ.'COX '.AND. 1 IHARG(6).EQ.'LINE')THEN IFPLPT='BOXC' ELSEIF(IHARG(4).EQ.'PROB'.AND.IHARG(5).EQ.'PLOT ')THEN IFPLPT='PROB' IFPLP1='NORM' IFPLP2=' ' IFPLP3=' ' IFPLP4=' ' IFPLP5=' ' ELSEIF(IHARG(5).EQ.'PROB'.AND.IHARG(6).EQ.'PLOT ')THEN IFPLPT='PROB' IFPLP1=IHARG(4) IFPLP2=' ' IFPLP3=' ' IFPLP4=' ' IFPLP5=' ' ELSEIF(IHARG(6).EQ.'PROB'.AND.IHARG(7).EQ.'PLOT ')THEN IFPLPT='PROB' IFPLP1=IHARG(4) IFPLP2=IHARG(5) IFPLP3=' ' IFPLP4=' ' IFPLP5=' ' ELSEIF(IHARG(7).EQ.'PROB'.AND.IHARG(8).EQ.'PLOT ')THEN IFPLPT='PROB' IFPLP1=IHARG(4) IFPLP2=IHARG(5) IFPLP3=IHARG(6) IFPLP4=' ' IFPLP5=' ' ELSEIF(IHARG(8).EQ.'PROB'.AND.IHARG(9).EQ.'PLOT ')THEN IFPLPT='PROB' IFPLP1=IHARG(4) IFPLP2=IHARG(5) IFPLP3=IHARG(6) IFPLP4=IHARG(7) IFPLP5=' ' ELSEIF(IHARG(9).EQ.'PROB'.AND.IHARG(10).EQ.'PLOT ')THEN IFPLPT='PROB' IFPLP1=IHARG(4) IFPLP2=IHARG(5) IFPLP3=IHARG(6) IFPLP4=IHARG(7) IFPLP5=IHARG(8) ELSEIF(IHARG(4).EQ.'PPCC'.AND.IHARG(5).EQ.'PLOT ')THEN IFPLPT='PPCC' IFPLC1='TUKE' IFPLC2='LAMB' IFPLC3=' ' IFPLC4=' ' IFPLC5=' ' ELSEIF(IHARG(5).EQ.'PPCC'.AND.IHARG(6).EQ.'PLOT ')THEN IFPLPT='PPCC' IFPLC1=IHARG(4) IFPLc2=' ' IFPLC3=' ' IFPLC4=' ' IFPLC5=' ' ELSEIF(IHARG(6).EQ.'PPCC'.AND.IHARG(7).EQ.'PLOT ')THEN IFPLPT='PPCC' IFPLc1=IHARG(4) IFPLC2=IHARG(5) IFPLC3=' ' IFPLC4=' ' IFPLC5=' ' ELSEIF(IHARG(7).EQ.'PPCC'.AND.IHARG(8).EQ.'PLOT ')THEN IFPLPT='PPCC' IFPLC1=IHARG(4) IFPLC2=IHARG(5) IFPLC3=IHARG(6) IFPLC4=' ' IFPLC5=' ' ELSEIF(IHARG(8).EQ.'PPCC'.AND.IHARG(9).EQ.'PLOT ')THEN IFPLPT='PPCC' IFPLC1=IHARG(4) IFPLC2=IHARG(5) IFPLC3=IHARG(6) IFPLC4=IHARG(7) IFPLC5=' ' ELSEIF(IHARG(9).EQ.'PPCC'.AND.IHARG(10).EQ.'PLOT ')THEN IFPLPT='PROB' IFPLC1=IHARG(4) IFPLC2=IHARG(5) IFPLc3=IHARG(6) IFPLC4=IHARG(7) IFPLC5=IHARG(8) ENDIF IF(IFPLPT.NE.'PERC'.AND.IFPLPT.NE.'BIHI'.AND. 1 IFPLPT.NE.'STAT'.AND.IFPLPT.NE.'RUNS'.AND. 1 IFPLPT.NE.'SPEC'.AND.IFPLPT.NE.'AUTO'.AND. 1 IFPLPT.NE.'LAG '.AND.IFPLPT.NE.'QQPL'.AND. 1 IFPLPT.NE.'PROB'.AND.IFPLPT.NE.'PPCC'.AND. 1 IFPLPT.NE.'BOXC'.AND.IFPLPT.NE.'HIST')IFPLPT='PLOT' IHV=IFPLPT GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT STATISTIC ** C **************************************************************** C IPART1='FACT' IPART2='PLOT' IPART3='STAT' IPART4='SCAT' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN IFPLST=IHV IFPLS2=IHARG2(4) IFPLS3=' ' IFPLS4=' ' IF(NUMARG.GE.5)THEN IFPLS3=IHARG(5) IFPLS4=IHARG2(5) ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITION PLOT STATISTIC ** C **************************************************************** C IPART1='COND' IPART2='PLOT' IPART3='STAT' IPART4='SUBS' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN ICPLST=IHV ICPLS2=IHARG2(4) ICPLS3=' ' ICPLS4=' ' IF(NUMARG.GE.5)THEN ICPLS3=IHARG(5) ICPLS4=IHARG2(5) ENDIF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX FIT ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMFI=IHV IF(ISPMFI.EQ.'LOWE')ISPMFI='LOES' IHV=ISPMFI GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISPMFI=IHV IF(ISPMFI.EQ.'LOWE')ISPMFI='LOES' IHV=ISPMFI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITIONING PLOT FIT ** C **************************************************************** C IPART1='COND' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ICPLFI=IHV IF(ICPLFI.EQ.'LOWE')ICPLFI='LOES' IHV=ICPLFI GOTO5160 ENDIF C IPART1='SUBS' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ICPLFI=IHV IF(ICPLFI.EQ.'LOWE')ICPLFI='LOES' IHV=ICPLFI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT FIT ** C **************************************************************** C IPART1='FACT' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IFPLFI=IHV IF(IFPLFI.EQ.'LOWE')IFPLFI='LOES' IHV=IFPLFI GOTO5160 ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IFPLFI=IHV IF(IFPLFI.EQ.'LOWE')IFPLFI='LOES' IHV=IFPLFI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX TAG ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMTA=IHV IF(ISPMTA.NE.'ON'.AND.ISPMTA.NE.'OFF')ISPMLA='ON' GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISPMTA=IHV IF(ISPMTA.NE.'ON'.AND.ISPMTA.NE.'OFF')ISPMLA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITIONING PLOT TAG ** C **************************************************************** C IPART1='COND' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ICPLTA=IHV IF(ICPLTA.NE.'ON'.AND.ICPLTA.NE.'OFF')ICPLLA='ON' GOTO5160 ENDIF C IPART1='SUBS' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ICPLTA=IHV IF(ICPLTA.NE.'ON'.AND.ICPLTA.NE.'OFF')ICPLLA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT TAG ** C **************************************************************** C IPART1='FACT' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IFPLTA=IHV IF(IFPLTA.NE.'ON'.AND.IFPLTA.NE.'OFF')IFPLTA='ON' GOTO5160 ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IFPLTA=IHV IF(IFPLTA.NE.'ON'.AND.IFPLTA.NE.'OFF')IFPLTA='ON' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET SCATTER PLOT MATRIX FRAME ** C **************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN ISPMFR=IHV IF(ISPMFR.NE.'USER'.AND.ISPMFR.NE.'CONN')ISPMFR='DEFA' GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISPMFR=IHV IF(ISPMFR.NE.'USER')ISPMFR='DEFA' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET CONDITIONING PLOT FRAME ** C **************************************************************** C IPART1='COND' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ICPLFR=IHV IF(ICPLFR.NE.'USER'.AND.ICPLFR.NE.'CONN')ICPLFR='DEFA' GOTO5160 ENDIF C IPART1='SUBS' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ICPLFR=IHV IF(ICPLFR.NE.'USER')ICPLFR='DEFA' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C **************************************************************** C ** SET FACTOR PLOT FRAME ** C **************************************************************** C IPART1='FACT' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IFPLFR=IHV IF(IFPLFR.NE.'USER'.AND.IFPLFR.NE.'CONN')IFPLFR='DEFA' GOTO5160 ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IFPLFR=IHV IF(IFPLFR.NE.'USER')IFPLFR='DEFA' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET CONDITIONING PLOT PRE-SORT ** C *************************************************************** C NOTE: CURRENTLY, THIS NOT USED SINCE ONE CAN SIMPLY USE C REGULAR PRE-SORT COMMAND C CCCCC IPART1='COND' CCCCC IPART2='PLOT' CCCCC IPART3='PRE ' CCCCC IPART4='SORT' CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. CCCCC1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN CCCCC ICPLPS=IHV CCCCC IF(ICPLPS.NE.'OFF')ICPLPS='ON' CCCCC GOTO5160 CCCCC ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 1999. C *************************************************************** C ** SET FACTOR PLOT TIC LABEL DISPLACEMENT C *************************************************************** C IPART1='FACT' IPART6='SCAT' IPART2='PLOT' IPART3='TIC ' IPART4='LABE' IPART5='DISP' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART6).AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN IF(IARGT(6).EQ.'NUMB')THEN PFPLTD=AV GOTO5170 ELSE IFPLTD=IHV IF(IFPLTD.NE.'STAG')IFPLTD='NORM' GOTO5160 ENDIF ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 1999. C *************************************************************** C ** SET CONDITI PLOT TIC LABEL DISPLACEMENT C *************************************************************** C IPART1='COND' IPART6='SUBS' IPART2='PLOT' IPART3='TIC ' IPART4='LABE' IPART5='DISP' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART6).AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN IF(IARGT(6).EQ.'NUMB')THEN PCPLTD=AV GOTO5170 ELSE ICPLTD=IHV IF(ICPLTD.NE.'STAG')ICPLTD='NORM' GOTO5160 ENDIF ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 1999. C *************************************************************** C ** SET MATRIX PLOT TIC LABEL DISPLACEMENT C *************************************************************** C IPART1='MATR' IPART2='PLOT' IPART3='TIC ' IPART4='LABE' IPART5='DISP' IF(IHARG(1).EQ.IPART1.AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN IF(IARGT(6).EQ.'NUMB')THEN PSPMTD=AV GOTO5170 ELSE ISPMTD=IHV IF(ISPMTD.NE.'STAG')ISPMTD='NORM' GOTO5160 ENDIF ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='TIC ' IPART5='LABE' IPART6='DISP' IF(IHARG(1).EQ.IPART1.AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5.AND.IHARG(6).EQ.IPART6)THEN IF(IARGT(7).EQ.'NUMB')THEN PSPMTD=AV GOTO5170 ELSE ISPMTD=IHV IF(ISPMTD.NE.'STAG')ISPMTD='NORM' GOTO5160 ENDIF ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET FACTOR PLOT RESPONSE VARIABLES ** C *************************************************************** C IPART1='FACT' IPART5='SCAT' IPART2='PLOT' IPART3='RESP' IPART4='VARI' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN PFPLRV=AV GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET CONDITION PLOT RESPONSE VARIABLES ** C *************************************************************** C IPART1='COND' IPART5='SUBS' IPART2='PLOT' IPART3='RESP' IPART4='VARI' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN PCPLRV=AV GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET CONDITION PLOT TAG VARIABLES ** C *************************************************************** C IPART1='COND' IPART5='SUBS' IPART2='PLOT' IPART3='COND' IPART4='VARI' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND. 1 (IHARG(3).EQ.IPART3.OR.IHARG(3).EQ.'TAG ').AND. 1 IHARG(4).EQ.IPART4)THEN PCPLTV=AV GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET SCATTER PLOT MATRIX LIMITS ** C ** ETC. ** C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='LIMI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN DO22509I=1,25 PSPLLL(I)=CPUMIN PSPLUL(I)=CPUMIN 22509 CONTINUE IF(NUMARG.GE.5)THEN IT1=0 DO22511I=5,NUMARG,2 IF(I+1.GT.NUMARG)GOTO22511 IF(IT1.GT.24)GOTO22511 IT1=IT1+1 PSPLLL(IT1)=ARG(I) PSPLUL(IT1)=ARG(I+1) 22511 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22513)IT1 22513 FORMAT(I8,' LIMIT PAIRS HAVE BEEN SET FOR THE SCATTER PLOT ', 1 'MATRIX') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='LIMI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(NUMARG.GE.3)THEN IT1=0 DO22519I=1,25 PSPLLL(I)=CPUMIN PSPLUL(I)=CPUMIN 22519 CONTINUE DO22521I=4,NUMARG,2 IF(I+1.GT.NUMARG)GOTO22521 IF(IT1.GT.24)GOTO22521 IT1=IT1+1 PSPLLL(IT1)=ARG(I) PSPLUL(IT1)=ARG(I+1) 22521 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22523)IT1 22523 FORMAT(I8,' LIMIT PAIRS HAVE BEEN SET FOR THE MATRIX PLOT ') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET SCATTER PLOT MATRIX LIMITS ** C ** ETC. ** C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='SUBR' IPART5='LIMI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN DO23509I=1,25 PSPLSL(I)=CPUMIN PSPLSU(I)=CPUMIN 23509 CONTINUE IF(NUMARG.GE.6)THEN IT1=0 DO23511I=6,NUMARG,2 IF(I+1.GT.NUMARG)GOTO23511 IF(IT1.GT.24)GOTO23511 IT1=IT1+1 PSPLSL(IT1)=ARG(I) PSPLSU(IT1)=ARG(I+1) 23511 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,23513)IT1 23513 FORMAT(I8,' LIMIT PAIRS HAVE BEEN SET FOR THE SCATTER PLOT ', 1 'MATRIX') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='SUBR' IPART4='LIMI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IT1=0 DO23519I=1,25 PSPLSL(I)=CPUMIN PSPLSU(I)=CPUMIN 23519 CONTINUE IF(NUMARG.GE.4)THEN DO23521I=5,NUMARG,2 IF(I+1.GT.NUMARG)GOTO23521 IF(IT1.GT.24)GOTO23521 IT1=IT1+1 PSPLSL(IT1)=ARG(I) PSPLSU(IT1)=ARG(I+1) 23521 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,23523)IT1 23523 FORMAT(I8,' SUBREGION LIMIT PAIRS HAVE BEEN SET FOR THE ', 1 'MATRIX PLOT ') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET FACTOR PLOT XLIMITS ** C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='FACT' IPART4='SCAT' IPART2='PLOT' IPART3='XLIM' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN DO22609I=1,25 PFPXLL(I)=CPUMIN PFPXUL(I)=CPUMIN 22609 CONTINUE IF(NUMARG.GE.4)THEN IT1=0 DO22611I=4,NUMARG,2 IF(I+1.GT.NUMARG)GOTO22611 IF(IT1.GT.24)GOTO22611 IT1=IT1+1 PFPXLL(IT1)=ARG(I) PFPXUL(IT1)=ARG(I+1) 22611 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22613)IT1 22613 FORMAT(I8,' XLIMIT PAIRS HAVE BEEN SET FOR THE FACTOR PLOT') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET FACTOR PLOT YLIMITS ** C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='FACT' IPART4='SCAT' IPART2='PLOT' IPART3='YLIM' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN DO22619I=1,25 PFPYLL(I)=CPUMIN PFPYUL(I)=CPUMIN 22619 CONTINUE IF(NUMARG.GE.4)THEN IT1=0 DO22621I=4,NUMARG,2 IF(I+1.GT.NUMARG)GOTO22621 IF(IT1.GT.24)GOTO22621 IT1=IT1+1 PFPYLL(IT1)=ARG(I) PFPYUL(IT1)=ARG(I+1) 22621 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22623)IT1 22623 FORMAT(I8,' YLIMIT PAIRS HAVE BEEN SET FOR THE FACTOR PLOT') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 1999. C *************************************************************** C ** SET FACTOR PLOT SUBREGION XLIMITS ** C ** ** C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='FACT' IPART4='SCAT' IPART2='PLOT' IPART3='SUBR' IPART4='XLIM' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3.AND. 1 IHARG(4).EQ.IPART4)THEN DO23609I=1,25 PFPXSL(I)=CPUMIN PFPXSU(I)=CPUMIN 23609 CONTINUE IF(NUMARG.GE.5)THEN IT1=0 DO23611I=5,NUMARG,2 IF(I+1.GT.NUMARG)GOTO23611 IF(IT1.GT.24)GOTO23611 IT1=IT1+1 PFPXSL(IT1)=ARG(I) PFPXSU(IT1)=ARG(I+1) 23611 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,23613)IT1 23613 FORMAT(I8,' SUBREGION XLIMIT PAIRS HAVE BEEN SET FOR THE ', 1 'FACTOR PLOT') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET FACTOR PLOT SUBREGION YLIMITS ** C ** ** C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='FACT' IPART4='SCAT' IPART2='PLOT' IPART3='SUBR' IPART4='YLIM' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3.AND. 1 IHARG(4).EQ.IPART4)THEN DO23619I=1,25 PFPYSL(I)=CPUMIN PFPYSU(I)=CPUMIN 23619 CONTINUE IF(NUMARG.GE.5)THEN IT1=0 DO23621I=5,NUMARG,2 IF(I+1.GT.NUMARG)GOTO23621 IF(IT1.GT.24)GOTO23621 IT1=IT1+1 PFPYSL(IT1)=ARG(I) PFPYSU(IT1)=ARG(I+1) 23621 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,23623)IT1 23623 FORMAT(I8,' SUBREGION YLIMIT PAIRS HAVE BEEN SET FOR THE ', 1 'FACTOR PLOT') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET CONDITION PLOT XLIMITS * C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='COND' IPART4='SUBS' IPART2='PLOT' IPART3='XLIM' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN DO22709I=1,25 PCPXSL(I)=CPUMIN PCPXSU(I)=CPUMIN 22709 CONTINUE IF(NUMARG.GE.4)THEN IT1=0 DO22711I=4,NUMARG,2 IF(I+1.GT.NUMARG)GOTO22711 IF(IT1.GT.24)GOTO22711 IT1=IT1+1 PCPXSL(IT1)=ARG(I) PCPXSU(IT1)=ARG(I+1) 22711 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22713)IT1 22713 FORMAT(I8,' XLIMIT PAIRS HAVE BEEN SET FOR THE CONDITION PLOT') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET CONDITION PLOT YLIMITS * C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='COND' IPART4='SUBS' IPART2='PLOT' IPART3='YLIM' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN DO22719I=1,25 PCPYLL(I)=CPUMIN PCPYUL(I)=CPUMIN 22719 CONTINUE IF(NUMARG.GE.4)THEN IT1=0 DO22721I=4,NUMARG,2 IF(I+1.GT.NUMARG)GOTO22721 IF(IT1.GT.24)GOTO22721 IT1=IT1+1 PCPYLL(IT1)=ARG(I) PCPYUL(IT1)=ARG(I+1) 22721 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22723)IT1 22723 FORMAT(I8,' YLIMIT PAIRS HAVE BEEN SET FOR THE CONDITION PLOT') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 1999. C *************************************************************** C ** SET CONDITION PLOT SUBREGION XLIMITS ** C ** ** C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='COND' IPART4='SUBS' IPART2='PLOT' IPART3='SUBR' IPART4='XLIM' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3.AND. 1 IHARG(4).EQ.IPART4)THEN DO23709I=1,25 PCPXSL(I)=CPUMIN PCPXSU(I)=CPUMIN 23709 CONTINUE IF(NUMARG.GE.5)THEN IT1=0 DO23711I=5,NUMARG,2 IF(I+1.GT.NUMARG)GOTO23711 IF(IT1.GT.24)GOTO23711 IT1=IT1+1 PCPXSL(IT1)=ARG(I) PCPXSU(IT1)=ARG(I+1) 23711 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,23713)IT1 23713 FORMAT(I8,' SUBREGION XLIMIT PAIRS HAVE BEEN SET FOR THE ', 1 'CONDITION PLOT') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *************************************************************** C ** SET CONDITION PLOT SUBREGION YLIMITS ** C ** *** C ** (CAN SPECIFY UP TO 25 PAIRS) ** C *************************************************************** C IPART1='COND' IPART4='SUBS' IPART2='PLOT' IPART3='YLIM' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3.AND. 1 IHARG(4).EQ.IPART4)THEN DO23719I=1,25 PCPYSL(I)=CPUMIN PCPYSU(I)=CPUMIN 23719 CONTINUE IF(NUMARG.GE.5)THEN IT1=0 DO23721I=5,NUMARG,2 IF(I+1.GT.NUMARG)GOTO23721 IF(IT1.GT.24)GOTO23721 IT1=IT1+1 PCPYSL(IT1)=ARG(I) PCPYSU(IT1)=ARG(I+1) 23721 CONTINUE ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,23723)IT1 23723 FORMAT(I8,' SUBREGION YLIMIT PAIRS HAVE BEEN SET FOR THE ', 1 'CONDITION PLOT') CALL DPWRST('XXX','BUG ') IFOUND='YES' GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 1997. C ******************************************** C ** SET NETSCAPE ** C ******************************************** C IPART1='NETS' IF(IHARG(1).EQ.IPART1)THEN INETSW=IHV IF(INETSW.NE.'OLD'.AND.INETSW.NE.'NEW')THEN INETSW='OLD' ENDIF IPART2=' ' GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 1997 C ********************************************* C ** TREAT THE SET BROWSER CASE ** C ********************************************* C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'BROW')GOTO6210 GOTO6290 C 6210 CONTINUE IBROWS=' ' NCBROW=0 IF(NUMARG.LE.1)GOTO6250 IF(IHARG(NUMARG).EQ.'OFF')GOTO6250 IF(IHARG(NUMARG).EQ.'AUTO')GOTO6250 IF(IHARG(NUMARG).EQ.'DEFA')GOTO6250 C DO6230I=1,80 ICANS(I:I)=IANSLC(I) 6230 CONTINUE C C NOTE: PC BROWSER PATH MAY HAVE SPACES, SO DON'T USE DPEXWO C ISTART=1 ISTOP=IWIDTH IWORD=NUMARG+1 CCCCC CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, CCCCC1ICOL1,ICOL2,ISTRIN,NCSTRI, CCCCC1IBUGS2,ISUBRO,IERROR) DO6232I=ISTART,ISTOP-4 IF(IANS(I).EQ.'B '.AND.IANS(I+1).EQ.'R'.AND. 1 IANS(I+2).EQ.'O'.AND.IANS(I+3).EQ.'W')THEN ISTRT2=I+3 DO6234J=ISTRT2,ISTOP IF(ICANS(J:J).EQ.' ')THEN NCSTRI=ISTOP-J ISTRIN(1:NCSTRI)=ICANS(J+1:IWIDTH) GOTO6239 ENDIF 6234 CONTINUE NCSTRI=0 ENDIF 6232 CONTINUE 6239 CONTINUE C IF(NCSTRI.GE.1)GOTO6240 GOTO6250 C 6240 CONTINUE NCBROW=NCSTRI IBROWS(1:NCBROW)=ISTRIN(1:NCBROW) IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6249 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6241) 6241 FORMAT('THE BROWSER FOR THE WEB HELP COMMAND HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6242)(IBROWS(I:I),I=1,NCBROW) 6242 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 6249 CONTINUE GOTO9000 C 6250 CONTINUE IBROWS=' ' NCBROW=9 IBROWS(1:NCBROW)='netscape ' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6259 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6251) 6251 FORMAT('THE BROWSER FOR THE WEB HELP COMMAND HAS BEEN SET TO ', 1'THE DEFAULT:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6252)IBROWS(1:NCBROW) 6252 FORMAT(A80) CALL DPWRST('XXX','BUG ') 6259 CONTINUE GOTO9000 6290 CONTINUE C CCCCC FOLLOWING SECTION ADDED APRIL 1997 C ********************************************* C ** TREAT THE SET DATAPLOT URL CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DATA'.AND.IHARG(2).EQ.'URL ') 1GOTO6310 GOTO6390 C 6310 CONTINUE IDPURL=' ' NCURL=0 IF(NUMARG.LE.2)GOTO6350 IF(IHARG(NUMARG).EQ.'OFF')GOTO6350 IF(IHARG(NUMARG).EQ.'AUTO')GOTO6350 IF(IHARG(NUMARG).EQ.'DEFA')GOTO6350 C DO6330I=1,80 ICANS(I:I)=IANSLC(I) 6330 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCCC IWORD=NUMARG+1 IWORD=4 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C IF(NCSTRI.GE.1)GOTO6340 GOTO6350 C 6340 CONTINUE NCURL=NCSTRI CCCCC IDPURL(1:NCURL)=ISTRIN(1:NCURL) ITEMP(1:NCURL)=ISTRIN(1:NCURL) CALL DEQUOT(ITEMP,NCURL,IDPURL,NCOUT2,IBUGS2,ISUBRO) NCURL=NCOUT2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6349 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6341) 6341 FORMAT('THE DATAPLOT URL FOR THE WEB HELP COMMAND HAS BEEN SET', 1' TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6342)(IDPURL(I:I),I=1,NCURL) 6342 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 6349 CONTINUE GOTO9000 C 6350 CONTINUE IDPURL=' ' NCURL=49 IDPURL(1:24)='http://www.itl.nist.gov/' IDPURL(25:49)='div898/software/dataplot/' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6359 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6351) 6351 FORMAT('THE DATAPLOT URL FOR THE WEB HELP COMMAND HAS BEEN SET ', 1'TO THE DEFAULT:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6352)IDPURL(1:NCURL) 6352 FORMAT(A80) CALL DPWRST('XXX','BUG ') 6359 CONTINUE GOTO9000 6390 CONTINUE C CCCCC FOLLOWING SECTION ADDED APRIL 1997 C ********************************************* C ** TREAT THE SET URL CASE ** C ********************************************* C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'URL ')GOTO6410 GOTO6490 C 6410 CONTINUE IURL=' ' NCURL=0 IF(NUMARG.LE.1)GOTO6450 IF(IHARG(NUMARG).EQ.'OFF')GOTO6450 IF(IHARG(NUMARG).EQ.'AUTO')GOTO6450 IF(IHARG(NUMARG).EQ.'DEFA')GOTO6450 C DO6430I=1,80 ICANS(I:I)=IANSLC(I) 6430 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCCC IWORD=NUMARG+1 IWOR=3 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C IF(NCSTRI.GE.1)GOTO6440 GOTO6450 C 6440 CONTINUE NCURL=NCSTRI CCCCC IURL(1:NCURL)=ISTRIN(1:NCURL) ITEMP(1:NCURL)=ISTRIN(1:NCURL) CALL DEQUOT(ITEMP,NCURL,IURL,NCOUT2,IBUGS2,ISUBRO) NCURL=NCOUT2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6449 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6441) 6441 FORMAT('THE URL FOR THE WEB COMMAND HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6442)(IURL(I:I),I=1,NCURL) 6442 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 6449 CONTINUE GOTO9000 C 6450 CONTINUE IURL=' ' NCURL=20 IURL(1:20)='http://www.nist.gov/' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6459 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6451) 6451 FORMAT('THE URL FOR THE WEB COMMAND HAS BEEN SET ', 1'TO THE DEFAULT:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6452)IURL(1:NCURL) 6452 FORMAT(A80) CALL DPWRST('XXX','BUG ') 6459 CONTINUE GOTO9000 6490 CONTINUE C CCCCC FOLLOWING SECTION ADDED MARCH 1999 C ********************************************* C ** TREAT THE SET HANDBOOK URL CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'HAND'.AND. 1IHARG(2).EQ.'URL ')GOTO9410 GOTO9490 C 9410 CONTINUE IHBURL=' ' NCHURL=0 IF(NUMARG.LE.2)GOTO9450 IF(IHARG(NUMARG).EQ.'OFF')GOTO9450 IF(IHARG(NUMARG).EQ.'AUTO')GOTO9450 IF(IHARG(NUMARG).EQ.'DEFA')GOTO9450 C DO9430I=1,80 ICANS(I:I)=IANSLC(I) 9430 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCC IWORD=NUMARG+1 IWORD=4 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C IF(NCSTRI.GE.1)GOTO9440 GOTO9450 C 9440 CONTINUE NCHURL=NCSTRI CCCCC IHBURL(1:NCHURL)=ISTRIN(1:NCHURL) ITEMP(1:NCHURL)=ISTRIN(1:NCHURL) CALL DEQUOT(ITEMP,NCHURL,IHBURL,NCOUT2,IBUGS2,ISUBRO) NCHURL=NCOUT2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9449 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9441) 9441 FORMAT('THE HANDBOOK URL FOR THE WEB COMMAND HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9442)(IHBURL(I:I),I=1,NCHURL) 9442 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 9449 CONTINUE GOTO9000 C 9450 CONTINUE IHBURL=' ' NCHURL=40 IHBURL(1:40)='http://www.itl.nist.gov/div898/handbook/' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9459 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9451) 9451 FORMAT('THE URL FOR THE WEB COMMAND HAS BEEN SET ', 1'TO THE DEFAULT:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9452)IHBURL(1:NCHURL) 9452 FORMAT(A80) CALL DPWRST('XXX','BUG ') 9459 CONTINUE GOTO9000 9490 CONTINUE C CCCCC FOLLOWING SECTION ADDED FEBRUARY 1998 C ********************************************* C ** TREAT THE SET PRINTER CASE ** C ********************************************* C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PRIN')GOTO6510 GOTO6590 C 6510 CONTINUE IPRNTR=' ' NCPRNT=0 IF(NUMARG.LE.1)GOTO6550 IF(IHARG(NUMARG).EQ.'OFF')GOTO6550 IF(IHARG(NUMARG).EQ.'AUTO')GOTO6550 IF(IHARG(NUMARG).EQ.'DEFA')GOTO6550 C DO6530I=1,80 ICANS(I:I)=IANSLC(I) 6530 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCCC NOVEMBER 2002. SET NUMARG TO WORD AFTER "SET PRINTER" AND CCCCC TURN ON FILE NAME QUOTE TEMPORARILY IFILQS=IFILQU IFILQU='ON' CCCCC IWORD=NUMARG+1 IWORD=3 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) IFILQU=IFILQS C IF(NCSTRI.GE.1)GOTO6540 GOTO6550 C 6540 CONTINUE NCPRNT=NCSTRI IPRNTR(1:NCPRNT)=ISTRIN(1:NCPRNT) IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6549 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6541) 6541 FORMAT('THE PRINTER ID HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6542)(IPRNTR(I:I),I=1,NCPRNT) 6542 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 6549 CONTINUE GOTO9000 C 6550 CONTINUE IF(IOPSY1.EQ.'UNIX')THEN IPRNTR=' ' NCPRNT=0 ELSEIF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'MS-F')THEN IPRNTR='PRN' NCPRNT=3 ELSEIF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'LAHE')THEN IPRNTR='PRN:' NCPRNT=4 ELSE IPRNTR=' ' NCPRNT=0 ENDIF IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6559 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6551) 6551 FORMAT('THE PRINTER FOR THE PP COMMAND HAS BEEN SET ', 1'TO THE DEFAULT:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6552)IPRNTR(1:NCPRNT) 6552 FORMAT(A80) CALL DPWRST('XXX','BUG ') 6559 CONTINUE GOTO9000 6590 CONTINUE C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2002 C ********************************************* C ** TREAT THE SET GHOSTVIEW PATH CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'GHOS'.AND. 1IHARG2(1).NE.'TSCR'.AND. 1IHARG(2).EQ.'PATH')GOTO6610 GOTO6690 C 6610 CONTINUE IGSVPA=' ' NCGSPA=0 IF(NUMARG.LE.2)GOTO6650 IF(IHARG(NUMARG).EQ.'OFF')GOTO6650 IF(IHARG(NUMARG).EQ.'AUTO')GOTO6650 IF(IHARG(NUMARG).EQ.'DEFA')GOTO6650 C DO6630I=1,80 ICANS(I:I)=IANSLC(I) 6630 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCCC IWORD=NUMARG+1 IWORD=4 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C IF(NCSTRI.GE.1)GOTO6640 GOTO6650 C 6640 CONTINUE NCGSPA=NCSTRI CCCCC IGSVPA(1:NCGSPA)=ISTRIN(1:NCGSPA) ITEMP(1:NCGSPA)=ISTRIN(1:NCGSPA) CALL DEQUOT(ITEMP,NCGSPA,IGSVPA,NCOUT2,IBUGS2,ISUBRO) NCGSPA=NCOUT2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6649 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6641) 6641 FORMAT('THE GHOSTVIEW PATH HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6642)(IGSVPA(I:I),I=1,NCGSPA) 6642 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 6649 CONTINUE GOTO9000 C 6650 CONTINUE CALL DPCONA(92,IBASLC) IGSVPA='C: GHOSTGUM GSVIEW ' IGSVPA(3:3)=IBASLC IGSVPA(12:12)=IBASLC IGSVPA(19:19)=IBASLC NCGSPA=19 C IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6659 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6651) 6651 FORMAT('THE GHOSTVIEW PATH HAS BEEN SET TO ', 1'THE DEFAULT:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6652)IGSVPA(1:NCGSPA) 6652 FORMAT(A80) CALL DPWRST('XXX','BUG ') 6659 CONTINUE GOTO9000 6690 CONTINUE C CCCCC FOLLOWING SECTION ADDED JANUARY 2003 C *********************************************** C ** TREAT THE SET GHOSTSCRIPT PATH CASE ** C *********************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'GHOS'.AND. 1IHARG2(1).EQ.'TSCR'.AND. 1IHARG(2).EQ.'PATH')GOTO6710 GOTO6790 C 6710 CONTINUE IGSTPA=' ' NCGHPA=0 IF(NUMARG.LE.2)GOTO6750 IF(IHARG(NUMARG).EQ.'OFF')GOTO6750 IF(IHARG(NUMARG).EQ.'AUTO')GOTO6750 IF(IHARG(NUMARG).EQ.'DEFA')GOTO6750 C DO6730I=1,80 ICANS(I:I)=IANSLC(I) 6730 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCC IWORD=NUMARG+1 IWORD=4 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C IF(NCSTRI.GE.1)GOTO6740 GOTO6750 C 6740 CONTINUE NCGHPA=NCSTRI CCCCC IGSTPA(1:NCGHPA)=ISTRIN(1:NCGHPA) ITEMP(1:NCGHPA)=ISTRIN(1:NCGHPA) CALL DEQUOT(ITEMP,NCGHPA,IGSTPA,NCOUT2,IBUGS2,ISUBRO) NCGHPA=NCOUT2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6749 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6741) 6741 FORMAT('THE GHOSTVIEW PATH HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6742)(IGSTPA(I:I),I=1,NCGHPA) 6742 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 6749 CONTINUE GOTO9000 C 6750 CONTINUE CCCCC IGSTPA='C:\GS\GS7.04\BIN\' CALL DPCONA(92,IBASLC) IGSTPA='C: GS GS7.04 BIN ' IGSTPA(3:3)=IBASLC IGSTPA(6:6)=IBASLC IGSTPA(13:13)=IBASLC IGSTPA(17:17)=IBASLC NCGHPA=17 C IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6759 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6751) 6751 FORMAT('THE GHOSTVIEW PATH HAS BEEN SET TO ', 1'THE DEFAULT:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6752)IGSTPA(1:NCGHPA) 6752 FORMAT(A80) CALL DPWRST('XXX','BUG ') 6759 CONTINUE GOTO9000 6790 CONTINUE C CCCCC FOLLOWING SECTION ADDED JANUARY 2003 C *********************************************** C ** TREAT THE SET HTML HEADER FILE CASE ** C *********************************************** C IF(NUMARG.GE.3.AND.IHARG(1).EQ.'HTML'.AND. 1IHARG(2).EQ.'HEAD'.AND.IHARG(3).EQ.'FILE')GOTO6810 GOTO6890 C 6810 CONTINUE IF(IHARG(4).EQ.'NULL'.OR. IHARG(4).EQ.'DEFA' .OR. 1 IHARG(4).EQ.'OFF ' .OR. IHARG(4).EQ.'NONE' .OR. 1 IHARG(4).EQ.'AUTO' .OR. NUMARG.LE.3)THEN IHTMHE='NULL' NCHTMH=4 IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6811) 6811 FORMAT('THE DEFAULT HTML HEADER FILE WILL BE USED') CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C IHTMHE=' ' NCHTMH=0 DO6830I=1,80 ICANS(I:I)=IANSLC(I) 6830 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCCC IWORD=NUMARG+1 IWORD=5 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C NCHTMH=MAX(NCSTRI,1) CCCCC IHTMHE(1:NCHTMH)=ISTRIN(1:NCHTMH) ITEMP(1:NCHTMH)=ISTRIN(1:NCHTMH) CALL DEQUOT(ITEMP,NCHTMH,IHTMHE,NCOUT2,IBUGS2,ISUBRO) NCHTMH=NCOUT2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6849 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6841) 6841 FORMAT('THE HTML HEADER FILE HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6842)(IHTMHE(I:I),I=1,MIN(NCHTMH,80)) 6842 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 6849 CONTINUE GOTO9000 C 6890 CONTINUE C CCCCC FOLLOWING SECTION ADDED JANUARY 2003 C *********************************************** C ** TREAT THE SET HTML FOOTER FILE CASE ** C *********************************************** C IF(NUMARG.GE.3.AND.IHARG(1).EQ.'HTML'.AND. 1IHARG(2).EQ.'FOOT'.AND.IHARG(3).EQ.'FILE')GOTO6910 GOTO6990 C 6910 CONTINUE IF(IHARG(4).EQ.'NULL'.OR. IHARG(4).EQ.'DEFA' .OR. 1 IHARG(4).EQ.'OFF ' .OR. IHARG(4).EQ.'NONE' .OR. 1 IHARG(4).EQ.'AUTO' .OR. NUMARG.LE.3)THEN IHTMFO='NULL' NCHTMF=4 IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6911) 6911 FORMAT('THE DEFAULT HTML FOOTER FILE WILL BE USED') CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C IHTMFO=' ' NCHTMF=0 DO6930I=1,80 ICANS(I:I)=IANSLC(I) 6930 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCCC IWORD=NUMARG+1 IWORD=5 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C NCHTMF=MAX(NCSTRI,1) CCCCC IHTMFO(1:NCHTMF)=ISTRIN(1:NCHTMF) ITEMP(1:NCHTMF)=ISTRIN(1:NCHTMF) CALL DEQUOT(ITEMP,NCHTMF,IHTMFO,NCOUT2,IBUGS2,ISUBRO) NCHTMF=NCOUT2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO6949 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6941) 6941 FORMAT('THE HTML FOOTER FILE HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6942)(IHTMFO(I:I),I=1,MIN(NCHTMF,80)) 6942 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 6949 CONTINUE GOTO9000 C 6990 CONTINUE C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003 C *********************************************** C ** TREAT THE SET LATEX HEADER FILE CASE ** C *********************************************** C IF(NUMARG.GE.3.AND.IHARG(1).EQ.'LATE'.AND. 1IHARG(2).EQ.'HEAD'.AND.IHARG(3).EQ.'FILE')GOTO8210 GOTO8290 C 8210 CONTINUE IF(IHARG(4).EQ.'NULL'.OR. IHARG(4).EQ.'DEFA' .OR. 1 IHARG(4).EQ.'OFF ' .OR. IHARG(4).EQ.'NONE' .OR. 1 IHARG(4).EQ.'AUTO' .OR. NUMARG.LE.3)THEN ILATHE='NULL' NCLATH=4 IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8211) 8211 FORMAT('THE DEFAULT LATEX HEADER FILE WILL BE USED') CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C ILATHE=' ' NCLATH=0 DO8230I=1,80 ICANS(I:I)=IANSLC(I) 8230 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCCC IWORD=NUMARG+1 IWORD=5 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C NCLATH=MAX(NCSTRI,1) CCCCC ILATHE(1:NCLATH)=ISTRIN(1:NCLATH) ITEMP(1:NCLATH)=ISTRIN(1:NCLATH) CALL DEQUOT(ITEMP,NCLATH,ILATHE,NCOUT2,IBUGS2,ISUBRO) NCLATH=NCOUT2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO8249 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8241) 8241 FORMAT('THE LATEX HEADER FILE HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8242)(ILATHE(I:I),I=1,MIN(NCLATH,80)) 8242 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 8249 CONTINUE GOTO9000 C 8290 CONTINUE C CCCCC FOLLOWING SECTION ADDED SPETEMBER 2003 C *********************************************** C ** TREAT THE SET LATEX FOOTER FILE CASE ** C *********************************************** C IF(NUMARG.GE.3.AND.IHARG(1).EQ.'LATE'.AND. 1IHARG(2).EQ.'FOOT'.AND.IHARG(3).EQ.'FILE')GOTO8310 GOTO8390 C 8310 CONTINUE IF(IHARG(4).EQ.'NULL'.OR. IHARG(4).EQ.'DEFA' .OR. 1 IHARG(4).EQ.'OFF ' .OR. IHARG(4).EQ.'NONE' .OR. 1 IHARG(4).EQ.'AUTO' .OR. NUMARG.LE.3)THEN ILATFO='NULL' NCLATF=4 IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8311) 8311 FORMAT('THE DEFAULT LATEX FOOTER FILE WILL BE USED') CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C ILATFO=' ' NCLATF=0 DO8330I=1,80 ICANS(I:I)=IANSLC(I) 8330 CONTINUE C ISTART=1 ISTOP=IWIDTH CCCCC IWORD=NUMARG+1 IWORD=5 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C NCLATF=MAX(NCSTRI,1) CCCCC ILATFO(1:NCLATF)=ISTRIN(1:NCLATF) ITEMP(1:NCLATF)=ISTRIN(1:NCLATF) CALL DEQUOT(ITEMP,NCLATF,ILATFO,NCOUT2,IBUGS2,ISUBRO) NCLATF=NCOUT2 IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO8349 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8341) 8341 FORMAT('THE LATEX FOOTER FILE HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8342)(ILATFO(I:I),I=1,MIN(NCLATF,80)) 8342 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 8349 CONTINUE GOTO9000 C 8390 CONTINUE C C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003 C *********************************************** C ** TREAT THE SET TABLE TITLE CASE ** C *********************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'TABL'.AND. 1IHARG(2).EQ.'TITL')GOTO7020 GOTO7059 C 7020 CONTINUE IF(IHARG(3).EQ.'NULL'.OR. IHARG(3).EQ.'DEFA' .OR. 1 IHARG(3).EQ.'OFF ' .OR. IHARG(3).EQ.'NONE' .OR. 1 IHARG(3).EQ.'AUTO' .OR. NUMARG.LE.2)THEN ITABTI=' ' NCTABT=0 IFOUND='YES' IF(IFEEDB.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7029) 7029 FORMAT('THE TABLE TITLE HAS BEEN TURNED OFF') CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C ITABTI=' ' NCTABT=0 DO7030I=1,80 ICANS(I:I)=IANSLC(I) 7030 CONTINUE C ISTART=1 ISTOP=IWIDTH IWORD=4 CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD, 1ICOL1,ICOL2,ISTRIN,NCSTRI, 1IBUGS2,ISUBRO,IERROR) C NCTABT=MAX(NCSTRI,1) ITABTI(1:NCTABT)=ISTRIN(1:NCTABT) IF(ITABTI(1:1).EQ.'"' .AND. ITABTI(NCTABT:NCTABT).EQ.'"')THEN DO7040I=2,NCTABT-1 ITABTI(I-1:I-1)=ITABTI(I:I) 7040 CONTINUE NCTABT=NCTABT-2 ENDIF IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO7049 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7041) 7041 FORMAT('THE TABLE TITLE HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7042)(ITABTI(I:I),I=1,MIN(NCTABT,80)) 7042 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 7049 CONTINUE GOTO9000 C 7059 CONTINUE C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2005. C **************************************************************** C ** SET RTF FIXED FONT ** C **************************************************************** C IPART1='RTF ' IPART2='FIXE' IPART3='FONT' IPART4=IHARG(4) IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IPART4.EQ.'LUCI')THEN IRTFFF='Lucida Console' NCRTF1=14 ELSE IRTFFF='Courier New' NCRTF1=11 ENDIF WRITE(ICOUT,7051) 7051 FORMAT('THE RTF FIXED FONT HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7052)IRTFFF(1:NCRTF1) 7052 FORMAT(40A1) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2005. C **************************************************************** C ** SET RTF PROPORTIONAL FONT ** C **************************************************************** C IPART1='RTF ' IPART2='PROP' IPART3='FONT' IPART4=IHARG(4) IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IPART4.EQ.'LUCI')THEN IRTFFP='Lucida Sans' NCRTF2=11 ELSEIF(IPART4.EQ.'ARIA')THEN IRTFFP='Arial' NCRTF2=5 ELSEIF(IPART4.EQ.'TIME')THEN IRTFFP='Times New Roman' NCRTF2=15 ELSEIF(IPART4.EQ.'BOOK')THEN IRTFFP='Bookman' NCRTF2=7 ELSEIF(IPART4.EQ.'GEOR')THEN IRTFFP='Georgia' NCRTF2=7 ELSEIF(IPART4.EQ.'TAHO')THEN IRTFFP='Tahoma' NCRTF2=6 ELSEIF(IPART4.EQ.'VERD')THEN IRTFFP='Verdana' NCRTF2=7 ELSE IRTFFP='Times New Roman' NCRTF2=15 ENDIF WRITE(ICOUT,7061) 7061 FORMAT('THE RTF PROPORTIONAL FONT HAS BEEN SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7062)IRTFFP(1:NCRTF2) 7062 FORMAT(40A1) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C C ******************************* C ** STEP 21-- ** C ** SET MACHINE CONSTANTS ** C ******************************* C CCCCC THE FOLLOWING 3 LINES WERE ADDED DECEMBER 1993 ISTEPN='21' IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SET') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IPART1='IRD ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IRD=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IPR ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPR=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='CPUM' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)CPUMIN=AV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='CPUM' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)CPUMAX=AV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='NUMB' IPART2='PC ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NUMBPC=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMC' IPART2='PW ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NUMCPW=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMB' IPART2='PW ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NUMBPW=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IFEE' IPART2='DB ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IFEEDB=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IPRI' IPART2='NT ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPRINT=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IECH' IPART2='O ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IECHO=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C C ************************************ C ** STEP 2-- ** C ** SET HOUSEKEEPING VARIABLES ** C ************************************ C IPART1='MAXW' IPART2='ID ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXWID=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IWID' IPART2='TH ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IWIDTH=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXW' IPART2='SV ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXWSV=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IWID' IPART2='SV ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IWIDSV=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ICOM' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICOM=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='ICOM' IPART2='2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICOM2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='MAXA' IPART2='RG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXARG=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMA' IPART2='RG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NUMARG=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXN' IPART2='AM ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXNAM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMN' IPART2='AM ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NUMNAM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C C .......... C IPART1='IMES' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IMESNU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='INEW' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)INEWNU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IMAI' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IMAINU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IHEL' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHELNU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IBUG' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGNU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IQUE' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IQUENU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ILOG' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ILOGNU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IREA' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IREANU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IWRI' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IWRINU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ICRE' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICRENU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ISAV' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISAVNU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ISCR' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISCRNU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IDAT' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IDATNU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IPL1' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPL1NU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IPL2' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPL2NU=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C C .......... C IPART1='IMES' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IMESNA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='INEW' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)INEWNA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IMAI' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IMAINA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IHEL' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHELNA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IBUG' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGNA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IQUE' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IQUENA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='ILOG' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ILOGNA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IREA' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IREANA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IWRI' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IWRINA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='ICRE' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICRENA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='ISAV' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISAVNA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='ISCR' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISCRNA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IDAT' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IDATNA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IPL1' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPL1NA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IPL2' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPL2NA=ISTRIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C C .......... C IPART1='IMES' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IMESST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='INEW' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)INEWST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IMAI' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IMAIST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IHEL' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHELST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IBUG' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IQUE' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IQUEST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='ILOG' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ILOGST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IREA' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IREAST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IWRI' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IWRIST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='ICRE' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICREST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='ISAV' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISAVST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='ISCR' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISCRST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IDAT' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IDATST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IPL1' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPL1ST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IPL2' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPL2ST=ISTRIN(1:12) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C CCCCC IPART1='IHAR' CCCCC IPART2='G ' CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHARG(IEL)=IHV CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IHAR' CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C CCCCC IPART1='IHAR' CCCCC IPART2='G2 ' CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHARG2(IEL)=IHV CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IHA2' CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C IPART1='IARG' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IARG(IEL)=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IARG' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C IPART1='ARG ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ARG(IEL)=AV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='ARG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5270 C IPART1='IHNA' IPART2='ME ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHNAME(IEL)=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IHNA' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C IPART1='IHNA' IPART2='M2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHNAM2(IEL)=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IHN2' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C IPART1='IUSE' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IUSE(IEL)=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IUSE' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C IPART1='IVAL' IPART2='UE ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IVALUE(IEL)=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IVAL' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C IPART1='VALU' IPART2='E ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)VALUE(IEL)=AV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='VALU' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5270 C IPART1='IN ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IN(IEL)=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C IPART1='IVST' IPART2='AR ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IVSTAR(IEL)=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IVST' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C IPART1='IVST' IPART2='OP ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IVSTOP(IEL)=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IVSP' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C C *************************** C ** STEP 3-- ** C ** SET BUG VARIABLES ** C *************************** C IPART1='IBUG' IPART2='MA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGMA=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGIN=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='LS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGLS=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='MS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGMS=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='GC ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGGC=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='TY ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGTY=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='TE ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGTE=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='PC ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGPC=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='P2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGP2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='OD ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGOD=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='O2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGO2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='SU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGSU=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='S2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGS2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='GR ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGGR=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='G2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGG2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='G3 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGG3=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='AN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGAN=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='A2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGA2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='A3 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGA3=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='PL ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGPL=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='P ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGP=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='P1 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGP1=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='P3 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGP3=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='DG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGDG=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='D2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGD2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='CO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGCO=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='EV ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGEV=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='Q ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGQ=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='RE ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGRE=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='WR ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGWR=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='SO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGSO=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='TO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGTO=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='UG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGUG=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='U2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGU2=IHV CCCCC THE FOLLOWING LINE WAS ADDED MAY 1992 (JJF) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGG4=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 (JJF) IPART1='IBUG' IPART2='G4 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGG4=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGU2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='U3 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGU3=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='U4 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGU4=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='EX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGEX=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='E2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGE2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='HE ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGHE=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='H2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGH2=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C CCCCC THE FOLOWING SECTION WAS ADDED AUGUST 1990 IPART1='IBUG' IPART2='WI ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGWI=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='LO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IBUGLO=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='ISUB' IPART2='RO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISUBRO=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISUBG4=IHV CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1990 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISUBWI=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='FOUR' IPART2='IER ' IPART3='EXPO' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1IPART3.EQ.IHARG(2))IFTEXP=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1IPART3.EQ.IHARG(2))GOTO5160 C IPART1='FOUR' IPART2='IER ' IPART3='ORDE' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1IPART3.EQ.IHARG(2))THEN IFTORD=IHV GOTO5160 ENDIF C IPART1='WRIT' IPART2='E ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IFORSW=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C C ******************************************************* C ** ADDED JAUNUARY, 1988 ** C ** SET GENERAL JUSTIFICATION [ON/OFF] ** C ** SET GENERAL REGION FILL [ON/OFF] ** C ** SET GENERAL PEN WIDTH ** C ** SET GENERAL PEN THICKNESS [ON/OFF] ** C ** SET GENERAL FONT [ON/OFF] ** C ** ADDED DECEMBER 1997 ** C ** SET GENERAL FACTOR <1/2> ** C ******************************************************* C IPART1='GENE' IPART2='RAL ' IPART3='JUST' IPART4='IFIC' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4)IJUSSW=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4)GOTO5160 C IPART1='GENE' IPART2='RAL ' IPART3='REGI' IPART4='ON ' IPART5='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)IRFLSW=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)GOTO5160 C IPART1='GENE' IPART2='RAL ' IPART3='PEN ' IPART4=' ' IPART5='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)PPENSW=AV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)GOTO5170 C C DECEMBER 1997. ADD GENERAL FACTOR <1/2> C IPART1='GENE' IPART2='RAL ' IPART3='FACT' IPART4='OR ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4)THEN IGENFA=INT(AV+0.5) IF(IGENFA.LT.1)IGENFA=1 IF(IGENFA.GT.5)IGENFA=5 GOTO5170 ENDIF C IPART1='GENE' IPART2='RAL ' IPART3='PEN ' IPART4=' ' IPART5='THIC' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)IPTHSW=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)GOTO5160 C IPART1='GENE' IPART2='RAL ' IPART3='FONT' IPART4=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3)IFNTSW=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3)GOTO5160 C C ************************************************************ C ** ADDED MAY 1988 ** C ** SET QUIC/QMS FONT OR ** C ** SET QUIC/QMS LANDSCAPE LEFT MARGIN ** C ** SET QUIC/QMS LANDSCAPE RIGHT MARGIN ** C ** SET QUIC/QMS LANDSCAPE TOP MARGIN ** C ** SET QUIC/QMS LANDSCAPE BOTTOM MARGIN ** C ** SET QUIC/QMS LANDSCAPE LEFT MARGIN ** C ** SET QUIC/QMS LANDSCAPE RIGHT MARGIN ** C ** SET QUIC/QMS LANDSCAPE TOP MARGIN ** C ** SET QUIC/QMS LANDSCAPE BOTTOM MARGIN ** C ** SET QUIC/QMS PPI ** C ************************************************************ C C *********************************** C ** CHECK FOR FONT ** C *********************************** C IPART1='QUIC' IPART2='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IQUIFN=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 IPART1='QMS ' IPART2='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IQUIFN=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 C C *********************************** C ** CHECK FOR MARGINS ** C *********************************** C IPART1='QUIC' IPART2='LAND' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQUILM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='LAND' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQUIRM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='LAND' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQUITM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='LAND' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQUIBM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='PORT' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQU2LM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='PORT' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQU2RM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='PORT' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQU2TM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='PORT' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQU2BM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='LAND' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQUILM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='LAND' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQUIRM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='LAND' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQUITM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='LAND' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQUIBM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='PORT' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQU2LM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='PORT' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQU2RM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='PORT' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQU2TM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='PORT' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IQU2BM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C C ********************************* C ** SET POINTS PER INCH (PPI) ** C ********************************* C IPART1='QUIC' IPART2='PPI ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)QUIPPI=AV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 IPART1='QMS ' IPART2='PPI ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)QUIPPI=AV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ************************************************************ C ** ADDED SEPTEMBER 1988 ** C ** SET POSTSCRI FONT OR ** C ** SET POSTSCRI LANDSCAPE LEFT MARGIN ** C ** SET POSTSCRI LANDSCAPE RIGHT MARGIN ** C ** SET POSTSCRI LANDSCAPE TOP MARGIN ** C ** SET POSTSCRI LANDSCAPE BOTTOM MARGIN ** C ** SET POSTSCRI LANDSCAPE LEFT MARGIN ** C ** SET POSTSCRI LANDSCAPE RIGHT MARGIN ** C ** SET POSTSCRI LANDSCAPE TOP MARGIN ** C ** SET POSTSCRI LANDSCAPE BOTTOM MARGIN ** C ** SET POSTSCRI PPI ** C ** SET POSTSCRIPT SPACE (ADDED OCTOBER 1991) ** C ** SET POSTSCRIPT HARDWARE FILL (JUNE 1994) ** C ************************************************************ C C *********************************** C ** CHECK FOR FONT ** C *********************************** C CCCCC THE FOLLOWING SECTION WAS HEAVILY UPDATED MAY 1989 CCCCC ADDITIONAL FONTS ADDED OCTOBER 1991 IPART1='POST' IPART2='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IPSTFN=IHV C IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'TIME'.AND.IHARG(4).EQ.'ROMA')IPSTFN='TROM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'TIME'.AND.IHARG(4).EQ.'BOLD')IPSTFN='TBOL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'TIME'.AND.IHARG(4).EQ.'ITAL')IPSTFN='TITA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'TIME'.AND.IHARG(4).EQ.'BOLD' 1.AND.IHARG(5).EQ.'ITAL')IPSTFN='TBIT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'TIME'.AND.IHARG(4).EQ.'ITAL' 1.AND.IHARG(5).EQ.'BOLD')IPSTFN='TBIT' C IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV')IPSTFN='HELV' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV'.AND.IHARG(4).EQ.'BOLD')IPSTFN='HELB' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV'.AND.IHARG(4).EQ.'OBLI')IPSTFN='HELO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV'.AND.IHARG(4).EQ.'BOLD' 1.AND.IHARG(5).EQ.'OBLI')IPSTFN='HEBO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV'.AND.IHARG(4).EQ.'OBLI' 1.AND.IHARG(5).EQ.'BOLD')IPSTFN='HEBO' C OCTOBER 1991. ADDITIONAL HELVETICA FONTS IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELN')IPSTFN='HELN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV'.AND.IHARG(4).EQ.'NARR')IPSTFN='HELN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV'.AND.IHARG(4).EQ.'NARR' 1.AND.IHARG(5).EQ.'BOLD')IPSTFN='HENB' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV'.AND.IHARG(4).EQ.'NARR' 1.AND.IHARG(5).EQ.'OBLI')IPSTFN='HENO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV'.AND.IHARG(4).EQ.'NARR' 1.AND.IHARG(5).EQ.'OBLI'.AND.IHARG(6).EQ.'BOLD')IPSTFN='HNBO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'HELV'.AND.IHARG(4).EQ.'NARR' 1.AND.IHARG(5).EQ.'BOLD'.AND.IHARG(6).EQ.'OBLI')IPSTFN='HNBO' C IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'COUR')IPSTFN='COUR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'COUR'.AND.IHARG(4).EQ.'BOLD')IPSTFN='CBOL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'COUR'.AND.IHARG(4).EQ.'OBLI')IPSTFN='COBL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'COUR'.AND.IHARG(4).EQ.'BOLD' 1.AND.IHARG(5).EQ.'OBLI')IPSTFN='CBOB' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'COUR'.AND.IHARG(4).EQ.'OBLI' 1.AND.IHARG(5).EQ.'BOLD')IPSTFN='CBOB' C C OCTOBER 1991. FOLLOWING AVANT GARDE FONTS ADDED IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AGBK')IPSTFN='AGBK' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AVAN')IPSTFN='AGBK' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AVAN'.AND.IHARG(4).EQ.'GARD')IPSTFN='AGBK' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AVAN'.AND.IHARG(4).EQ.'GARD' 1.AND.IHARG(5).EQ.'BOOK')IPSTFN='AGBK' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AGBO')IPSTFN='AGBO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AVAN'.AND.IHARG(4).EQ.'GARD' 1.AND.IHARG(5).EQ.'BOOK'.AND.IHARG(6).EQ.'OBLI')IPSTFN='AGBO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AGDE')IPSTFN='AGDE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AVAN'.AND.IHARG(4).EQ.'GARD' 1.AND.IHARG(5).EQ.'DEMI')IPSTFN='AGDE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AGDO')IPSTFN='AGDO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AVAN'.AND.IHARG(4).EQ.'GARD' 1.AND.IHARG(5).EQ.'DEMI'.AND.IHARG(6).EQ.'OBLI')IPSTFN='AGDO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'AVAN'.AND.IHARG(4).EQ.'GARD' 1.AND.IHARG(5).EQ.'OBLI'.AND.IHARG(6).EQ.'DEMI')IPSTFN='AGDO' C OCTOBER 1991. FOLLOWING BOOKMAN FONTS ADDED IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BKDE')IPSTFN='BKDE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BOOK')IPSTFN='BKDE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BOOK'.AND.IHARG(4).EQ.'DEMI')IPSTFN='BKDM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BKDI')IPSTFN='BKDI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BOOK'.AND.IHARG(4).EQ.'DEMI' 1.AND.IHARG(5).EQ.'ITAL')IPSTFN='BKDI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BOOK'.AND.IHARG(4).EQ.'ITAL' 1.AND.IHARG(5).EQ.'DEMI')IPSTFN='BKDI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BKLT')IPSTFN='BKLT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BOOK'.AND.IHARG(4).EQ.'LIGH')IPSTFN='BKLT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BKLI')IPSTFN='BKLI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BOOK'.AND.IHARG(4).EQ.'LIGH' 1.AND.IHARG(5).EQ.'ITAL')IPSTFN='BKLI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'BOOK'.AND.IHARG(4).EQ.'ITAL' 1.AND.IHARG(5).EQ.'LIGH')IPSTFN='BKLI' C OCTOBER 1991. FOLLOWING NEW CENTURY FONTS ADDED IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'NCSR')IPSTFN='NCSR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'CENT')IPSTFN='NCSR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'ROMA')IPSTFN='NCSR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'NCSB')IPSTFN='NCSB' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'BOLD')IPSTFN='NCSB' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'NCSI')IPSTFN='NCSI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'ITAL')IPSTFN='NCSI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'CSBI')IPSTFN='CSBI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'ITAL' 1.AND.IHARG(5).EQ.'BOLD')IPSTFN='CSBI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'BOLD' 1.AND.IHARG(5).EQ.'ITAL')IPSTFN='CSBI' C OCTOBER 1991. FOLLOWING PALATINO FONTS ADDED IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PALR')IPSTFN='PALR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PALA')IPSTFN='PALR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PALA'.AND.IHARG(4).EQ.'ROMA')IPSTFN='PALR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PALB')IPSTFN='PALB' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PALA'.AND.IHARG(4).EQ.'BOLD')IPSTFN='PALB' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PALI')IPSTFN='PALI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PALA'.AND.IHARG(4).EQ.'ITAL')IPSTFN='PALI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PABI')IPSTFN='PABI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PALA'.AND.IHARG(4).EQ.'ITAL' 1.AND.IHARG(5).EQ.'BOLD')IPSTFN='PABI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'PALA'.AND.IHARG(4).EQ.'BOLD' 1.AND.IHARG(5).EQ.'ITAL')IPSTFN='PABI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'ZAPH')IPSTFN='ZAPH' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.'SYMB')IPSTFN='SYMB' C IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=IPSTFN IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR MARGINS ** C *********************************** C IPART1='POST' IPART2='LAND' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IPSTLM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='LAND' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IPSTRM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='LAND' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IPSTTM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='LAND' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IPSTBM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='PORT' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IPS2LM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='PORT' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IPS2RM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='PORT' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IPS2TM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='PORT' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IPS2BM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C C ********************************* C ** SET POINTS PER INCH (PPI) ** C ********************************* C IPART1='POST' IPART2='PPI ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)PSTPPI=AV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ******************************************* C ** CHECK FOR POSTSCRIPT SPACE ** C ** ADDED OCTOBER 1991. ** C ******************************************* C IPART1='POST' IPART2='SPAC' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IPSTSP=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *************************************************** C ** CHECK FOR POSTSCRIPT HARDWARE FILL ** C ** ADDED JUNE 1994. ** C *************************************************** C IPART1='POST' IPART2='HARD' IPART3='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)IPSTFS=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)GOTO5160 C C ************************************************************ C ** ADDED MARCH 1990 ** C ** SET X11 FONT ** C ** SET X11 CAP ** C ** SET X11 JOIN ** C ** SET X11 PIXMAP ** C ** SET X11 PAUSE ** C ** SET X11 NAME ** C ** SET X11 HARDWARE FILL (ADDED JUNE 1994) ** C ** SET X11 WINDOW ID (ADDED OCTOBER 1997) ** C ************************************************************ C C ****************************************************** C ** CHECK FOR FONT ** C ** NOTE THAT FONT NAME CAN BE UP TO 80 CHARACTERS ** C ** LONG, SO THIS HANDLED SOMEWHAT DIFFERENTLY THAN ** C ** THE OTHER COMMANDS. ** C ****************************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'X11 '.AND. 1IHARG(2).EQ.'FONT')GOTO2210 GOTO2290 C 2210 CONTINUE IX11FN(1:40)=' ' IX11FN(41:80)=' ' NCTEMP=0 IF(NUMARG.LE.2)GOTO2250 IF(IHARG(NUMARG).EQ.'OFF')GOTO2250 IF(IHARG(NUMARG).EQ.'AUTO')GOTO2250 IF(IHARG(NUMARG).EQ.'DEFA')GOTO2250 C C CHECK THE POSITION OF THE WORD FONT C EXTRACT IANS FROM THE FIRST CHARACTER PAST "FONT" TO C THE LAST NON-BLANK CHARACTER C DO2230I=1,IWIDTH IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IF(IP3.GT.IWIDTH)GOTO2250 IF(IANS(I).EQ.'F'.AND.IANS(IP1).EQ.'O'.AND. 1IANS(IP2).EQ.'N'.AND.IANS(IP3).EQ.'T'.AND. 1IANS(IP4).EQ.' ')GOTO2235 2230 CONTINUE GOTO2250 C 2235 CONTINUE ISTART=IP4+1 C ISTOP=IWIDTH DO2240I=IWIDTH,ISTART,-1 ISTOP=I IF(IANS(I).NE.' ')GOTO2245 2240 CONTINUE GOTO2250 2245 CONTINUE IF(ISTART.GT.ISTOP)GOTO2250 NCTEMP=ISTOP-ISTART+1 IF(NCTEMP.GT.80)ISTOP=ISTART+79 IF(NCTEMP.GT.80)NCTEMP=80 ICOUNT=0 DO2248I=ISTART,ISTOP ICOUNT=ICOUNT+1 IX11FN(ICOUNT:ICOUNT)=IANS(I)(1:1) 2248 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2251) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2252)IX11FN CALL DPWRST('XXX','BUG ') GOTO9000 C 2250 CONTINUE IX11FN='8X13' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO2259 WRITE(ICOUT,999) CCCCC OCTOBER 1993. FOLLOWING SECZTION CHANGED TO AVOID "/" CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,2251)IX11FN WRITE(ICOUT,2251) 2251 FORMAT('THE X11 FONT HAS BEEN SET TO ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2252)IX11FN 2252 FORMAT(A80) CALL DPWRST('XXX','BUG ') 2259 CONTINUE GOTO9000 2290 CONTINUE C C *********************************** C ** CHECK FOR X11 WINDOW ID ** C *********************************** C IPART1='X11 ' IPART2='WIND' IPART3='ID ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IX11W2(1:4)=IHARG(NUMARG) IX11W2(5:8)=IHARG2(NUMARG) IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2302)IX11W2 2302 FORMAT('THE X11 WINDOW ID (FOR REPEAT GRAPH) HAS BEEN SET TO ', 1A8) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C C *********************************** C ** CHECK FOR X11 CAP ** C *********************************** C IPART1='X11 ' IPART2='CAP ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IX11CS(1:4)=IHARG(NUMARG) IX11CS(5:8)=IHARG2(NUMARG) IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2310)IX11CS 2310 FORMAT('THE X11 CAP STYLE HAS BEEN SET TO ',A8) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C C *********************************** C ** CHECK FOR X11 JOIN ** C *********************************** C IPART1='X11 ' IPART2='JOIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IX11JS(1:4)=IHARG(NUMARG) IX11JS(5:8)=IHARG2(NUMARG) IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2410)IX11JS 2410 FORMAT('THE X11 JOIN STYLE HAS BEEN SET TO ',A8) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C C *********************************** C ** CHECK FOR X11 PIXMAP FLAG ** C *********************************** C IPART1='X11 ' IPART2='PIXM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IX11PM=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR X11 HARDWARE FILL ** C *********************************** C IPART1='X11 ' IPART2='HARD' IPART3='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)IX11FS=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)GOTO5160 C C *********************************** C ** CHECK FOR X11 PAUSE FLAG ** C *********************************** C IPART1='X11 ' IPART2='PAUS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IX11PA=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C ****************************************************** C ** CHECK FOR DISPLAY NAME ** C ** NOTE THAT DISPLAY NAME CAN BE UP TO 20 CHARACTERS ** C ** LONG, SO THIS HANDLED SOMEWHAT DIFFERENTLY THAN ** C ** THE OTHER COMMANDS. ** C ****************************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'X11 '.AND. 1IHARG(2).EQ.'NAME')GOTO2510 GOTO2590 C 2510 CONTINUE IX11DN=' ' NCTEMP=0 IF(NUMARG.LE.2)GOTO2550 IF(IHARG(NUMARG).EQ.'OFF')GOTO2550 IF(IHARG(NUMARG).EQ.'AUTO')GOTO2550 IF(IHARG(NUMARG).EQ.'DEFA')GOTO2550 C C CHECK THE POSITION OF THE WORD NAME C EXTRACT IANSLC FROM THE FIRST CHARACTER PAST "NAME" TO C THE LAST NON-BLANK CHARACTER C DO2530I=1,IWIDTH IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IF(IP3.GT.IWIDTH)GOTO2550 IF(IANS(I).EQ.'N'.AND.IANS(IP1).EQ.'A'.AND. 1IANS(IP2).EQ.'M'.AND.IANS(IP3).EQ.'E'.AND. 1IANS(IP4).EQ.' ')GOTO2535 2530 CONTINUE GOTO2550 C 2535 CONTINUE ISTART=IP4+1 C DO2540I=ISTART,IWIDTH IF(IANS(I).EQ.' ')GOTO2540 ISTART=I GOTO2545 2540 CONTINUE GOTO2550 2545 CONTINUE CCCCC THE FOLLOWING LINE WAS CHANGED MAY 1992 (ALAN) CCCCC ISTOP=ISTART+19 ISTOP=ISTART+79 IF(ISTOP.GT.IWIDTH)ISTOP=IWIDTH IF(ISTART.GT.ISTOP)GOTO2550 NCTEMP=ISTOP-ISTART+1 ICOUNT=0 DO2548I=ISTART,ISTOP ICOUNT=ICOUNT+1 IX11DN(ICOUNT:ICOUNT)=IANSLC(I)(1:1) 2548 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2551) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2552)IX11DN CALL DPWRST('XXX','BUG ') GOTO9000 C 2550 CONTINUE IX11DN='DEFAULT' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO2559 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,2551)IX11DN WRITE(ICOUT,2551) CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS FIXED MAY 1992 (ALAN) CCCCC THE FOLLOWING LINE WAS FIXED OCTOBER 1993 (ALAN) C2551 FORMAT('THE X11 DISPLAY NAME HAS BEEN SET TO:'/1H ,A20) C2551 FORMAT('THE X11 DISPLAY NAME HAS BEEN SET TO:'/1H ,A80) 2551 FORMAT('THE X11 DISPLAY NAME HAS BEEN SET TO ') WRITE(ICOUT,2552)IX11DN 2552 FORMAT(A80) CALL DPWRST('XXX','BUG ') 2559 CONTINUE C 2590 CONTINUE CCCCC JUNE, 1990. THE FOLLOWING LINE WAS A TYPO. DELETE IT. CCCCC GOTO9000 C C ************************************************************ C ** ADDED MARCH 2005 ** C ** SET AQUATERM FONT ** C ** SET AQUATERM CAP ** C ** SET AQUATERM JOIN ** C ** SET AQUATERM HARDWARE FILL ** C ************************************************************ C C ****************************************************** C ** CHECK FOR FONT ** C ** NOTE THAT FONT NAME CAN BE UP TO 80 CHARACTERS ** C ** LONG, SO THIS HANDLED SOMEWHAT DIFFERENTLY THAN ** C ** THE OTHER COMMANDS. ** C ****************************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'AQUA'.AND. 1IHARG(2).EQ.'FONT')GOTO22210 GOTO22290 C 22210 CONTINUE IAQUFN(1:40)=' ' IAQUFN(41:80)=' ' NCTEMP=0 IF(NUMARG.LE.2)GOTO22250 IF(IHARG(NUMARG).EQ.'OFF')GOTO22250 IF(IHARG(NUMARG).EQ.'AUTO')GOTO22250 IF(IHARG(NUMARG).EQ.'DEFA')GOTO22250 C C CHECK THE POSITION OF THE WORD FONT C EXTRACT IANSLC FROM THE FIRST CHARACTER PAST "FONT" TO C THE LAST NON-BLANK CHARACTER C DO22230I=1,IWIDTH IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IF(IP3.GT.IWIDTH)GOTO22250 IF(IANSLC(I).EQ.'F'.AND.IANSLC(IP1).EQ.'O'.AND. 1IANSLC(IP2).EQ.'N'.AND.IANSLC(IP3).EQ.'T'.AND. 1IANSLC(IP4).EQ.' ')GOTO22235 22230 CONTINUE GOTO22250 C 22235 CONTINUE ISTART=IP4+1 C ISTOP=IWIDTH DO22240I=IWIDTH,ISTART,-1 ISTOP=I IF(IANS(I).NE.' ')GOTO22245 22240 CONTINUE GOTO22250 22245 CONTINUE IF(ISTART.GT.ISTOP)GOTO22250 NCTEMP=ISTOP-ISTART+1 IF(NCTEMP.GT.80)ISTOP=ISTART+79 IF(NCTEMP.GT.80)NCTEMP=80 ICOUNT=0 DO22248I=ISTART,ISTOP ICOUNT=ICOUNT+1 IAQUFN(ICOUNT:ICOUNT)=IANSLC(I)(1:1) 22248 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22251) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22252)IAQUFN CALL DPWRST('XXX','BUG ') GOTO9000 C 22250 CONTINUE IAQUFN='Helvetica' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO2259 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22251) 22251 FORMAT('THE AQUATERM FONT HAS BEEN SET TO ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22252)IAQUFN 22252 FORMAT(A80) CALL DPWRST('XXX','BUG ') 22259 CONTINUE GOTO9000 22290 CONTINUE C C *********************************** C ** CHECK FOR AQUATERM CAP ** C *********************************** C IPART1='AQUA' IPART2='CAP ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IAQUCS(1:4)=IHARG(NUMARG) IAQUCS(5:8)=IHARG2(NUMARG) IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22310)IAQUCS 22310 FORMAT('THE AQUATERM CAP STYLE HAS BEEN SET TO ',A8) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C C *********************************** C ** CHECK FOR AQUATERM JOIN ** C *********************************** C IPART1='AQUA' IPART2='JOIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IAQUJS(1:4)=IHARG(NUMARG) IAQUJS(5:8)=IHARG2(NUMARG) IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22410)IAQUJS 22410 FORMAT('THE AQUATERM JOIN STYLE HAS BEEN SET TO ',A8) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C C **************************************** C ** CHECK FOR AQUATERM HARDWARE FILL ** C **************************************** C IPART1='AQUA' IPART2='HARD' IPART3='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON')IHV='ON' IF(IHV.EQ.'DEFA')IHV='ON' IF(IHV.EQ.'YES')IHV='ON' IF(IHV.EQ.'TRUE')IHV='ON' IF(IHV.EQ.'OFF')IHV='OFF' IF(IHV.EQ.'NO')IHV='OFF' IF(IHV.EQ.'FALS')IHV='OFF' IAQUFS=IHV GOTO5160 ENDIF C C **************************************** C ** CHECK FOR LATEX HARDWARE FILL ** C **************************************** C IPART1='LATE' IPART2='HARD' IPART3='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'ON')IHV='ON' IF(IHV.EQ.'DEFA')IHV='ON' IF(IHV.EQ.'YES')IHV='ON' IF(IHV.EQ.'TRUE')IHV='ON' IF(IHV.EQ.'HARD')IHV='ON' IF(IHV.EQ.'OFF')IHV='OFF' IF(IHV.EQ.'NO')IHV='OFF' IF(IHV.EQ.'FALS')IHV='OFF' IF(IHV.EQ.'SOFT')IHV='OFF' ILATFS=IHV GOTO5160 ENDIF C C **************************************** C ** CHECK FOR LATEX LINE THICKNESS ** C **************************************** C IPART1='LATE' IPART2='LINE' IPART3='THIC' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHV.EQ.'HARD')IHV='ON' IF(IHV.EQ.'DEFA')IHV='HARD' IF(IHV.EQ.'YES')IHV='HARD' IF(IHV.EQ.'TRUE')IHV='HARD' IF(IHV.EQ.'HARD')IHV='HARD' IF(IHV.EQ.'SOFT')IHV='SOFT' IF(IHV.EQ.'NO')IHV='SOFT' IF(IHV.EQ.'FALS')IHV='SOFT' IF(IHV.EQ.'SOFT')IHV='SOFT' ILATLT=IHV GOTO5160 ENDIF C C **************************************** C ** CHECK FOR LATEX COLOR ** C **************************************** C IPART1='LATE' IPART2='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHV.EQ.'ON')IHV='ON' IF(IHV.EQ.'DEFA')IHV='ON' IF(IHV.EQ.'YES')IHV='ON' IF(IHV.EQ.'TRUE')IHV='ON' IF(IHV.EQ.'OFF')IHV='OFF' IF(IHV.EQ.'NO')IHV='OFF' IF(IHV.EQ.'FALS')IHV='OFF' ILATCO=IHV GOTO5160 ENDIF C C ************************************************************ C ** ADDED SEPTEMBER 1988 ** C ** SET CALCOMP COLORS ** C ** SET CALCOMP WIDTH ** C ************************************************************ C C *********************************** C ** CHECK FOR COLORS ** C *********************************** C IPART1='CALC' IPART2='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)ICALCL=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 C C *********************************** C ** CHECK FOR PEN WIDTH ** C *********************************** C IPART1='CALC' IPART2='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)PCALTH=AV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ************************************************************ C ** ADDED SEPTEMBER 1988 ** C ** SET ZETA COLORS ** C ** SET ZETA WIDTH ** C ************************************************************ C C *********************************** C ** CHECK FOR COLORS ** C *********************************** C IPART1='ZETA' IPART2='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IZETCL=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 C C *********************************** C ** CHECK FOR PEN WIDTH ** C *********************************** C IPART1='ZETA' IPART2='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)PZETTH=AV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ************************************************************ C ** ADDED JULY 1996 ** C ** SET LAHEY SWITCH ** C ** SET LAHEY GRAPHICS ** C ** SET LAHEY CLOSE ** C ** SET LAHEY PAUSE ** C ** SET LAHEY WIDTH ** C ************************************************************ C C *********************************** C ** CHECK FOR SWITCH ** C *********************************** C IPART1='LAHE' IPART2='SWIT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)ILAHSW=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR GRAPHICS ** C *********************************** C IPART1='LAHE' IPART2='GRAP' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)ILAHCL=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR CLOSE ** C *********************************** C IPART1='LAHE' IPART2='CLOS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)ILAHCL=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR PAUSE ** C *********************************** C IPART1='LAHE' IPART2='PAUS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)ILAHPA=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR PEN WIDTH ** C *********************************** C IPART1='LAHE' IPART2='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)PLAHTH=AV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ************************************************************ C ** ADDED FEBRUARY 2001 ** C ** SET LAHEY WINTERACTOR FONT ** C ** SET LAHEY WINTERACTOR COLOR ** C ** SET LAHEY WINTERACTOR HORIZONTAL ** C ** SET LAHEY WINTERACTOR VERTICAL L ** C ************************************************************ C IPART1='LAHE' IPART2='WINT' IPART3='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)IWINFN=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)GOTO5160 C IPART1='LAHE' IPART2='WINT' IPART3='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)IWINCL=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)GOTO5160 C IPART1='LAHE' IPART2='WINT' IPART3='HORI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)IWINHP=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)GOTO5150 C IPART1='LAHE' IPART2='WINT' IPART3='VERT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)IWINVP=IV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)GOTO5150 C C ************************************************************ C ** ADDED NOVEMBER 1996 ** C ** SET QUICK-WIN FOCUS ** C ** SET QUICK-WIN COLOR ** C ** SET QUICK-WIN FONT ** C ************************************************************ C C *********************************** C ** CHECK FOR FOCUS ** C *********************************** C IPART1='QWIN' IPART2='FOCU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IQWNFC=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR COLOR ** C *********************************** C IPART1='QWIN' IPART2='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IQWNCL=IHV IF(IQWNCL.EQ.'OFF')IQWNCL='VGA' IF(IQWNCL.EQ.'ON')IQWNCL='RGB' IF(IQWNCL.EQ.'SVGA')IQWNCL='RGB' IF(IQWNCL.EQ.'DIRE')IQWNCL='RGB' IF(IQWNCL.NE.'RGB'.AND.IQWNCL.NE.'VGA')IQWNCL='VGA' IF(IQWNCL.EQ.'RGB')THEN IQWNBC=1 IQWNF2=0 ENDIF GOTO5160 ENDIF C C ************************************** C ** CHECK FOR TEXT BACKGROUND COLOR ** C ************************************** C IPART1='QWIN' IPART2='TEXT' IPART3='FORE' IPART4='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IQWNF2=IV IF(IQWNCL.EQ.'VGA')THEN IF(IQWNF2.LT.0)IQWNF2=0 IF(IQWNF2.GT.15)IQWNF2=15 ELSEIF(IQWNCL.EQ.'RGB')THEN IF(IQWNF2.LT.0)IQWNF2=0 IF(IQWNF2.GT.88)IQWNF2=0 ENDIF GOTO5150 ENDIF C C ************************************** C ** CHECK FOR TEXT BACKGROUND COLOR ** C ************************************** C IPART1='QWIN' IPART2='TEXT' IPART3='BACK' IPART4='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IQWNBC=IV IF(IQWNCL.EQ.'VGA')THEN IF(IQWNBC.LT.0)IQWNBC=0 IF(IQWNBC.GT.15)IQWNBC=15 ELSEIF(IQWNCL.EQ.'RGB')THEN IF(IQWNBC.LT.0)IQWNBC=1 IF(IQWNBC.GT.88)IQWNBC=1 ENDIF GOTO5150 ENDIF C C *********************************** C ** CHECK FOR FONT NAME ** C *********************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'QWIN '.AND. 1IHARG(2).EQ.'FONT')GOTO2610 GOTO2690 C 2610 CONTINUE IQWNFZ=' ' NCTEMP=0 IF(NUMARG.LE.2)GOTO2650 IF(IHARG(NUMARG).EQ.'OFF')GOTO2650 IF(IHARG(NUMARG).EQ.'AUTO')GOTO2650 IF(IHARG(NUMARG).EQ.'DEFA')GOTO2650 C C CHECK THE POSITION OF THE WORD FONT C EXTRACT IANS FROM THE FIRST CHARACTER PAST "FONT" TO C THE LAST NON-BLANK CHARACTER C DO2630I=1,IWIDTH IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IF(IP3.GT.IWIDTH)GOTO2650 IF(IANS(I).EQ.'F'.AND.IANS(IP1).EQ.'O'.AND. 1IANS(IP2).EQ.'N'.AND.IANS(IP3).EQ.'T'.AND. 1IANS(IP4).EQ.' ')GOTO2635 2630 CONTINUE GOTO2650 C 2635 CONTINUE ISTART=IP4+1 C ISTOP=IWIDTH DO2640I=IWIDTH,ISTART,-1 ISTOP=I IF(IANS(I).NE.' ')GOTO2645 2640 CONTINUE GOTO2650 2645 CONTINUE IF(ISTART.GT.ISTOP)GOTO2650 NCTEMP=ISTOP-ISTART+1 IF(NCTEMP.GT.80)ISTOP=ISTART+79 IF(NCTEMP.GT.80)NCTEMP=80 ICOUNT=0 DO2648I=ISTART,ISTOP ICOUNT=ICOUNT+1 IQWNFZ(ICOUNT:ICOUNT)=IANS(I)(1:1) 2648 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2651) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2652)ISVGFN CALL DPWRST('XXX','BUG ') GOTO9000 C 2650 CONTINUE IQWNFZ='COURIER' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO2659 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2651) 2651 FORMAT('THE MICROSOFT QUICK-WIN FONT HAS BEEN SET TO ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2652)IQWNFZ 2652 FORMAT(A80) CALL DPWRST('XXX','BUG ') 2659 CONTINUE GOTO9000 2690 CONTINUE C C ************************************************************ C ** ADDED MARCH 2002 ** C ** SET SVG FONT ** C ** SET SVG FONT WEIGHT ** C ** SET SVG FONT STYLE ** C ** SET SVG CAP ** C ** SET SVG JOIN ** C ** SET SVG FOREGROUND COLOR ** C ** SET SVG HARDWARE FILL ** C ** SET SVG STYLE SHEET ** C ** SET SVG STYLE SHEET NAME ** C ************************************************************ C C *********************************** C ** CHECK FOR SVG FONT WEIGHT ** C *********************************** C IPART1='SVG ' IPART2='FONT' IPART3='WEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISVGFW=IHARG(NUMARG) IF(ISVGFW.NE.'NORM')ISVGFW='BOLD' IHV=ISVGFW GOTO5160 ENDIF C *********************************** C ** CHECK FOR SVG FONT STYLE ** C *********************************** C IPART1='SVG ' IPART2='FONT' IPART3='STYL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISVGST=IHARG(NUMARG) IF(ISVGST.NE.'ITAL')ISVGST='NORM' IHV=ISVGST GOTO5160 ENDIF C C ****************************************************** C ** CHECK FOR FONT NAME ** C ** NOTE THAT FONT NAME CAN BE UP TO 32 CHARACTERS ** C ** LONG, SO THIS HANDLED SOMEWHAT DIFFERENTLY THAN ** C ** THE OTHER COMMANDS. ** C ****************************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SVG '.AND. 1IHARG(2).EQ.'FONT')GOTO2210 GOTO2990 C 2910 CONTINUE ISVGFN(1:32)=' ' NCTEMP=0 IF(NUMARG.LE.2)GOTO2970 IF(IHARG(NUMARG).EQ.'OFF')GOTO2970 IF(IHARG(NUMARG).EQ.'AUTO')GOTO2970 IF(IHARG(NUMARG).EQ.'DEFA')GOTO2970 C C CHECK THE POSITION OF THE WORD FONT C EXTRACT IANS FROM THE FIRST CHARACTER PAST "FONT" TO C THE LAST NON-BLANK CHARACTER C DO2930I=1,IWIDTH IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IF(IP3.GT.IWIDTH)GOTO2970 IF(IANS(I).EQ.'F'.AND.IANS(IP1).EQ.'O'.AND. 1IANS(IP2).EQ.'N'.AND.IANS(IP3).EQ.'T'.AND. 1IANS(IP4).EQ.' ')GOTO2935 2930 CONTINUE GOTO2970 C 2935 CONTINUE ISTART=IP4+1 C ISTOP=IWIDTH DO2940I=IWIDTH,ISTART,-1 ISTOP=I IF(IANS(I).NE.' ')GOTO2945 2940 CONTINUE GOTO2970 2945 CONTINUE IF(ISTART.GT.ISTOP)GOTO2970 NCTEMP=ISTOP-ISTART+1 IF(NCTEMP.GT.32)THEN ISTOP=ISTART+31 NCTEMP=80 ENDIF ICOUNT=0 DO2948I=ISTART,ISTOP ICOUNT=ICOUNT+1 ISVGFN(ICOUNT:ICOUNT)=IANSLC(I)(1:1) 2948 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2971) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2972)ISVGFN CALL DPWRST('XXX','BUG ') GOTO9000 C 2970 CONTINUE ISVGFN='sans-serif' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO2979 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2971) 2971 FORMAT('THE SVG FONT HAS BEEN SET TO ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2972)ISVGFN 2972 FORMAT(A32) CALL DPWRST('XXX','BUG ') 2979 CONTINUE GOTO9000 2990 CONTINUE C C ************************************************** C ** CHECK FOR SVG CAP ** C ************************************************** C IPART1='SVG ' IPART2='CAP ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ISVGCA=IHARG(NUMARG) IF(ISVGCA.EQ.'OFF')ISVGCA='NONE' IF(ISVGCA.NE.'ROUN' .AND. ISVGCA.NE.'SQUA'.AND. 1 ISVGCA.NE.'NONE')ISVGCA='BUTT' IHV=ISVGCA GOTO5160 ENDIF C C *************************************************** C ** CHECK FOR SVG JOIN ** C *************************************************** C IPART1='SVG ' IPART2='JOIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN ISVGJS=IHARG(NUMARG) IF(ISVGJS.EQ.'OFF')ISVGJS='NONE' IF(ISVGJS.NE.'ROUN' .AND. ISVGJS.NE.'BEVE' .AND. 1 ISVGJS.NE.'NONE')ISVGJS='MITE' IHV=ISVGJS GOTO5160 ENDIF C C *************************************************** C ** CHECK FOR SVG FOREGROUND COLOR ** C *************************************************** C IPART1='SVG ' IPART2='FORE' IPART3='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISVGFC=IHARG(NUMARG) IHV=ISVGFC GOTO5160 ENDIF C C ******************************************************** C ** CHECK FOR SVG HARDWARE FILL ** C ******************************************************** C IPART1='SVG ' IPART2='HARD' IPART3='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN ISVGFS=IHV IF(ISVGFS.EQ.'NONE')ISVGFS='OFF' IF(ISVGFS.NE.'NONZ' .AND. ISVGFS.NE.'OFF ')ISVGFS='EVEN' IHV=ISVGFS GOTO5160 ENDIF C C ******************************************************** C ** CHECK FOR SVG STYLE SHEET ** C ******************************************************** C IPART1='SVG ' IPART2='STYL' IPART3='SHEE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(IHARG(4).EQ.'NONE'.OR.IHARG(4).EQ.'OFF ')THEN ISVGSS='NONE' ELSEIF(IHARG(4).EQ.'INTE')THEN ISVGSS='INTE' ELSEIF(IHARG(4).EQ.'EXTE')THEN IF(IHARG(5).EQ.'USE ')THEN ISVGSS='EXTU' ELSEIF(IHARG(5).EQ.'CREA')THEN ISVGSS='EXTC' ELSE ISVGSS='EXTU' ENDIF ENDIF IHV=ISVGSS GOTO5160 ENDIF C C ****************************************************** C ** CHECK FOR STYLE SHEET NAME ** C ** THIS IS A FILE NAME THAT CAN BE UP TO 80 ** C ** CHARACTERS. ** C ****************************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SVG '.AND.IHARG(2).EQ.'STYL'.AND. 1IHARG(3).EQ.'SHEE'.AND.IHARG(4).EQ.'NAME')THEN C ISVGSN=' ' NCTEMP=0 IF(NUMARG.LE.2)GOTO2750 IF(IHARG(NUMARG).EQ.'OFF')GOTO2750 IF(IHARG(NUMARG).EQ.'AUTO')GOTO2750 IF(IHARG(NUMARG).EQ.'DEFA')GOTO2750 C C CHECK THE POSITION OF THE WORD NAME C EXTRACT IANSLC FROM THE FIRST CHARACTER PAST "NAME" TO C THE LAST NON-BLANK CHARACTER C DO2730I=1,IWIDTH IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IF(IP3.GT.IWIDTH)GOTO2750 IF(IANS(I).EQ.'N'.AND.IANS(IP1).EQ.'A'.AND. 1 IANS(IP2).EQ.'M'.AND.IANS(IP3).EQ.'E'.AND. 1 IANS(IP4).EQ.' ')GOTO2735 2730 CONTINUE GOTO2750 C 2735 CONTINUE ISTART=IP4+1 C DO2740I=ISTART,IWIDTH IF(IANS(I).EQ.' ')GOTO2740 ISTART=I GOTO2745 2740 CONTINUE GOTO2750 2745 CONTINUE ISTOP=ISTART+79 IF(ISTOP.GT.IWIDTH)ISTOP=IWIDTH IF(ISTART.GT.ISTOP)GOTO2750 NCTEMP=ISTOP-ISTART+1 ICOUNT=0 DO2748I=ISTART,ISTOP ICOUNT=ICOUNT+1 ISVGSN(ICOUNT:ICOUNT)=IANSLC(I)(1:1) 2748 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2751) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2752)ISVGSN CALL DPWRST('XXX','BUG ') GOTO9000 C 2750 CONTINUE ISVGSN='dataplot.css' IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO2759 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2751) CALL DPWRST('XXX','BUG ') 2751 FORMAT('THE SVG STYLE SHEET NAME HAS BEEN SET TO ') WRITE(ICOUT,2752)ISVGSN 2752 FORMAT(A80) CALL DPWRST('XXX','BUG ') 2759 CONTINUE C ENDIF 2790 CONTINUE C C **************************** C ** STEP 4-- ** C ** SET DATA VARIABLES ** C **************************** C IPART1='MAXN' IPART2='K ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXNK=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NK ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NK=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXC' IPART2='OL ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXCOL=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMC' IPART2='OL ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NUMCOL=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXN' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXN=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='N ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)N=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXC' IPART2='HF ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXCHF=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMC' IPART2='HF ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NUMCHF=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXF' IPART2='UN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXFUN=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMF' IPART2='UN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NUMFUN=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXC' IPART2='HM ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)MAXCHM=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NPLO' IPART2='TP ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)NPLOTP=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ITRA' IPART2='NS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ITRANS=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C C OCTOBER 1991. BUG FIX: ONLY CHANGE VALUE OF "IV" IF THIS IS THE C RIGHT CASE. FOR EXAMPLE, SET HELP LINES 100 SETS TO 50 BECAUSE IV C CHANGED HERE. CHANGE FOR 2 LIST CASES AND 2 HELP CASES. C IPART1='LIST' IPART2=' ' CCCCC IF(IV.LE.0)IV=20 CCCCC IF(IV.GT.50)IV=50 CCCCC IF(NUMARG.GE.2.AND. CCCCC1 IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. CCCCC1 IHARG(2).EQ.'LINE')ILISMX=IV CCCCC IF(NUMARG.GE.2.AND. CCCCC1 IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. CCCCC1 IHARG(2).EQ.'LINE')GOTO5150 IF(NUMARG.GE.2.AND. 1 IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1 IHARG(2).EQ.'LINE')THEN IF(IV.LE.0)IV=20 CCCCC THE FOLLOWING LINE WAS CHANGED APRIL 1993 CCCCC IF(IV.GT.50)IV=50 IF(IV.GT.MAXLIS)IV=MAXLIS ILISMX=IV GOTO5150 END IF C IPART1='LIST' IPART2=' ' CCCCC IF(IV.LE.0)IV=20 CCCCC IF(IV.GT.50)IV=50 CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ILISMX=IV CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)THEN IF(IV.LE.0)IV=20 CCCCC THE FOLLOWING LINE WAS CHANGED APRIL 1993 CCCCC IF(IV.GT.50)IV=50 IF(IV.GT.MAXLIS)IV=MAXLIS ILISMX=IV GOTO5150 END IF C IPART1='HELP' IPART2=' ' CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1990 CCCCC IF(IV.LE.0)IV=24 CCCCC IF(IV.LE.0)IV=20 CCCCC IF(IV.GT.100000)IV=100000 CCCCC IF(NUMARG.GE.2.AND. CCCCC1 IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. CCCCC1 IHARG(2).EQ.'LINE')IHELMX=IV CCCCC IF(NUMARG.GE.2.AND. CCCCC1 IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. CCCCC1 IHARG(2).EQ.'LINE')GOTO5150 IF(NUMARG.GE.2.AND. 1 IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1 IHARG(2).EQ.'LINE')THEN IF(IV.LE.0)IV=20 IF(IV.GT.100000)IV=100000 IHELMX=IV GOTO5150 END IF C IPART1='HELP' IPART2=' ' CCCCC IF(IV.LE.0)IV=24 CCCCC IF(IV.GT.100000)IV=100000 CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHELMX=IV CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)THEN IF(IV.LE.0)IV=20 IF(IV.GT.100000)IV=100000 IHELMX=IV GOTO5150 END IF C IPART1='REPL' IPART2='ACE ' CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989 CCCCC IF(NUMARG.LE.1)IHV='\' IF(NUMARG.LE.1)IHV=IBASLC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IREPCH=IHV(1:1) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IO ' IPART2=' ' IF(NUMARG.LE.1)IHV='FLOA' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IOSW=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1IFEEDB.EQ.'ON')GOTO5160 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1IFEEDB.EQ.'OFF')GOTO5500 C IPART1='ICHA' IPART2='PA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICHAPA(IEL)=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C CCCCC THE FOLLOWING BOX WAS ADDED MAY 1992 C **************************** C ** STEP 5-- ** C ** SET OTHER VARIABLES ** C **************************** C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 IPART1='IPL1' IPART2='CS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)THEN IPL1CS=IHV12 IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7011)IPART1,IPART2,IPL1CS 7011 FORMAT('THE FORTRAN 12-CHARACTER VARIABLE ',A4,A4, 1' HAS JUST BEEN SET TO ',A12) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 IPART1='IPL2' IPART2='CS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)THEN IPL2CS=IHV12 IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7012)IPART1,IPART2,IPL2CS 7012 FORMAT('THE FORTRAN 12-CHARACTER VARIABLE ',A4,A4, 1' HAS JUST BEEN SET TO ',A12) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 IPART1='IPST' IPART2='BP ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPSTBP=IHV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 IPART1='IPST' IPART2='PN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IPSTPN=IV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1993 CCCCC THE FOLLOWING SECTION WAS CHANGED DECEMBER 1993 IPART1='MINM' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)THEN IF(IHARG(2).EQ.'MIN')IV=1 IF(IHARG(2).EQ.'MAX')IV=2 IF(IHARG(2).EQ.'MINI')IV=1 IF(IHARG(2).EQ.'MAXI')IV=2 IF(IHARG(2).EQ.'DEFA')IV=0 IF(IHARG(2).EQ.' ')IV=0 IF(IV.LT.1 .OR. IV.GT.2)IV=0 MINMAX=IV GOTO5150 ENDIF C CCCCC THE FOLLOWING BOX WAS ADDED MAY 1992 C **************************** C ** STEP 6-- ** C ** WRITE OUT VALUES ** C **************************** C 5130 CONTINUE IERROR='YES' WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5131) 5131 FORMAT('***** ERROR IN DPSET--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5132) 5132 FORMAT(' THE SPECIFIED FORTRAN COMMON VARIABLE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5133) 5133 FORMAT(' IN THE SET COMMAND WAS NOT FOUND.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5134)IHARG(1),IHARG2(1) 5134 FORMAT(' THE SPECIFIED FORTRAN COMMON VARIABLE WAS ', 1A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5135) 5135 FORMAT(' ILLUSTRATIVE EXAMPLE TO DEMONSTRATE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5136) 5136 FORMAT(' THE PROPER FORM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5137) 5137 FORMAT(' SUPPOSE THE ANALYST WISHES TO DUMP OUT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5138) 5138 FORMAT(' THE CURRENT VALUE OF THE FORTRAN COMMON ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5139) 5139 FORMAT(' VARIABLE MAXCOL ,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5140) 5140 FORMAT(' THIS MAY BE DONE BY ENTERING') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5141) 5141 FORMAT(' SET MAXCOL') CALL DPWRST('XXX','BUG ') GOTO9000 C 5150 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO5159 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5151)IPART1,IPART2,IV 5151 FORMAT('THE FORTRAN COMMON PARAMETER ',A4,A4, 1' HAS JUST BEEN SET TO ',I8) CALL DPWRST('XXX','BUG ') 5159 CONTINUE GOTO9000 C 5160 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO5169 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5161)IPART1,IPART2,IHV 5161 FORMAT('THE FORTRAN COMMON CHARACTER VARIABLE ',A4,A4, 1' HAS JUST BEEN SET TO ',A4) CALL DPWRST('XXX','BUG ') 5169 CONTINUE GOTO9000 C 5170 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO5179 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5171)IPART1,IPART2,AV 5171 FORMAT('THE FORTRAN COMMON SCALAR ',A4,A4, 1' HAS JUST BEEN SET TO ',E15.7) CALL DPWRST('XXX','BUG ') 5179 CONTINUE GOTO9000 C 5250 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO5259 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5251)IEL,IPART1,IPART2,IV 5251 FORMAT('ELEMENT ',I8,' OF THE FORTRAN COMMON VECTOR ',A4,A4, 1' HAS JUST BEEN SET TO ',I8) CALL DPWRST('XXX','BUG ') 5259 CONTINUE GOTO9000 C 5260 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO5269 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5261)IEL,IPART1,IPART2,IHV 5261 FORMAT('ELEMENT ',I8,' OF THE FORTRAN COMMON VECTOR ',A4,A4, 1' HAS JUST BEEN SET TO ',A4) CALL DPWRST('XXX','BUG ') 5269 CONTINUE GOTO9000 C 5270 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO5279 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5271)IEL,IPART1,IPART2,AV 5271 FORMAT('ELEMENT ',I8,' OF THE FORTRAN COMMON VECTOR ',A4,A4, 1' HAS JUST BEEN SET TO ',E15.7) CALL DPWRST('XXX','BUG ') 5279 CONTINUE GOTO9000 C 5360 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO5369 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5361)IPART1,IPART2,ISTRIN(1:12) 5361 FORMAT('THE FORTRAN COMMON CHARACTER VARIABLE ',A4,A4, 1' HAS JUST BEEN SET TO ',A12) CALL DPWRST('XXX','BUG ') 5369 CONTINUE GOTO9000 C 5370 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO5379 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5371)IPART1,IPART2,ISTRIN 5371 FORMAT('THE FORTRAN COMMON CHAR. VAR. ',A4,A4, 1' = ',A80) CALL DPWRST('XXX','BUG ') 5379 CONTINUE GOTO9000 C 5500 CONTINUE IFOUND='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IFILQU=IFILQZ RETURN END SUBROUTINE DPPROB(ILISMX,IREPCH,IOSW, 1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO, 1IBUGEX,IBUGE2,IBUGHE,IBUGH2,IBUGLO, CCCCC AUGUST 1995. ADD IFTEXP 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 THE FOLLOWING LINE WAS ADDED APRIL 1995 1IUNFOF,IUNFNR,IUNFMC, CCCCC THE FOLLOWING LINE WAS ADDED MARCH 1996 CCCCC1IRHSTG, 1IFOUND,IERROR) C C PURPOSE--PROBE AND WRITE OUT THE VALUE C OF CERTAIN FORTRAN VARIABLES IN COMMON. C NOTE--THIS CAPABILITY IS USEFUL FOR IMPLEMENTATION AND DEBUGGING. C INPUT ARGUMENTS--NONE C OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-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--82/7 C ORIGINAL VERSION--OCTOBER 1981. C UPDATED --NOVEMBER 1981. C UPDATED --MAY 1982. C UPDATED --SEPTEMBER 1987. (SET HELP LINES) C UPDATED --SEPTEMBER 1987. (SET FOURIER EXPONENT) C UPDATED --JANUARY 1988. (SET GENERAL JUSTIFICATION) C (SET GENERAL REGION FILL) C (SET GENERAL PEN WIDTH) C (SET GENERAL PEN THICKNESS) C UPDATED --MAY 1988. (SET QMS/QUIC FONT) C (SET QMS/QUIC LANDSCAPE MARGINS) C (SET QMS/QUIC PORTRAIT MARGINS) C (SET QMS/QUIC PPI) C UPDATED --AUGUST 1988 (SET POSTSCRIPT FONT) C (SET POSTSCRIPT LANDSCAPE MARGINS) C (SET POSTSCRIPT PORTRAIT MARGINS) C (SET POSTSCRIPT PPI) C (SET CALCOMP COLORS) C (SET CALCOMP WIDTH) C (SET ZETA COLORS) C (SET ZETA WIDTH) C UPDATED --DECEMBER 1988. (SET WRITE FORMAT) C UPDATED --DECEMBER 1988. (SET READ REWIND) C UPDATED --DECEMBER 1988. (SET WRITE REWIND) C UPDATED --APRIL 1992. SET POSTSCRIPT SPACE (ALAN) C UPDATED --APRIL 1992. ADD NPLOTP TO INPUT ARGS C UPDATED --MAY 1992. IPL1CS, IPL2CS C UPDATED --MAY 1992. IPSTBP, IPSTPN C UPDATED --FEBRUARY 1993. IPRITY (PRINT TYPE) C UPDATED --FEBRUARY 1993. IMANUF,IMODEL C UPDATED --FEBRUARY 1993. TCLOAD,TCMENU,TCPLFI,TCTEFI C UPDATED --FEBRUARY 1993. IPLATF C UPDATED --FEBRUARY 1993. IDMANU(.) C UPDATED --MAY 1993. MINMAX FOR EV1/EV2/WEIB DIST. C UPDATED --NOVEMBER 1993. PROBE PATH C UPDATED --JANUARY 1994. WEIB MINMAX TO DPCOS2.INC C UPDATED --JUNE 1994. X11, POSTSCRIPT HARDWARE FILL C UPDATED --APRIL 1995. IUNFOF, IUNFNR, IUNFMC C UPDATED --JULY 1995. FIT ITER., SD, ADDITIVE CONST. C UPDATED --FEBRUARY 1996. PROBE MPATH C UPDATED --MARCH 1996. IRHSTG C UPDATED --JULY 1996. LAHEY DEVICE SWITCHES C UPDATED --NOVEMBER 1996. MICROSOFT QUICK-WIN SWITCHES C UPDATED --APRIL 1997. ICCHPR, INETSW C UPDATED --APRIL 1997. ICCHWT, IBROWS, IDPURL, IURL C UPDATED --MAY 1998. IKAPSW C UPDATED --MAY 1998. ICENTY C UPDATED --JUNE 1998. IMATSC C UPDATED --JULY 1998. IQWNF2 C UPDATED --JULY 1998. IQWNBC C UPDATED --SEPTEMBER 1998. SAVE PROBE VALUE AS INTERNAL C VARIABLE OR STRING. C UPDATED --SEPTEMBER 1998. IPPTBI, IQQPBI C UPDATED --NOVEMBER 1998. IRHSTG TO DPCOST.INC C UPDATED --MARCH 1999. IHBURL C UPDATED --JULY 1999. IAUTCP C UPDATED --SEPTEMBER 1999. ISPMLA C UPDATED --SEPTEMBER 1999. ISPMDI C UPDATED --SEPTEMBER 1999. ISPMFI C UPDATED --SEPTEMBER 1999. ISPMLD C UPDATED --SEPTEMBER 1999. ISPMTA C UPDATED --SEPTEMBER 1999. ISPMFR C UPDATED --SEPTEMBER 1999. ISPMPT C UPDATED --SEPTEMBER 1999. ICPLLA C UPDATED --SEPTEMBER 1999. ICPLFI C UPDATED --SEPTEMBER 1999. ICPLTA C UPDATED --SEPTEMBER 1999. ICPLFR C UPDATED --SEPTEMBER 1999. ICPLPT C UPDATED --SEPTEMBER 1999. ICPLPS C UPDATED --SEPTEMBER 1999. FACTOR PLOT VARIABLES C UPDATED --JANUARY 2000. ICTBDI C UPDATED --JANUARY 2000. ISORDI C UPDATED --FEBRUARY 2000. IDCPDI, IDCPFI C UPDATED --OCTOBER 2000. IMANPA C UPDATED --JANUARY 2001. FX1MIN, ETC. C UPDATED --JANUARY 2001. GX1MIN, ETC. C UPDATED --JANUARY 2001. DX1MIN, ETC. C UPDATED --MARCH 2001. ISTALO, ISTASC C UPDATED --MARCH 2001. PSUPXS, PSUPXS C UPDATED --APRIL 2001. PROBE ORTHOGNAL DISTANCE C TRUST REGION RADIUS C UPDATED --APRIL 2001. PROBE ORTHOGNAL DISTANCE C STOP TOLERANCE C UPDATED --APRIL 2001. PROBE ORTHOGNAL DISTANCE C PARAMETER TOLERANCE C UPDATED --APRIL 2001. PROBE ORTHOGNAL DISTANCE C PRINT OPTION C UPDATED --MARCH 2002. SVG COMMANDS C (PROBE SVG COORDINATE SYSTEM) C (PROBE SVG FONT NAME) C (PROBE SVG FONT WEIGHT) C (PROBE SVG FONT STYLE) C (PROBE SVG CAP) C (PROBE SVG JOIN) C (PROBE SVG FOREGROUND COLOR) C (PROBE SVG HARDWARE FILL) C (PROBE SVG STYLE SHEET) C (PROBE SVG STYLE SHEET NAME) C UPDATED --MARCH 2002. PROBE BOX PLOT WIDTH C C UPDATED --MARCH 2002. PROBE 4-PLOT MULTIPLOT C UPDATED --MARCH 2002. PROBE 6-PLOT MULTIPLOT C UPDATED --MAY 2002. PROBE RANDOM NUMBER GENERATOR C UPDATED --JUNE 2002. PROBE: C IDMAN(1), IDMAN(2), IDMAN(3) C IDMO1(1), IDMO1(2), IDMO1(3) C IDMO2(1), IDMO2(2), IDMO2(3) C IDMO3(1), IDMO3(2), IDMO3(3) C UPDATED --JUNE 2002. IDMAN(1/2/3) SETS PROBEVAL C TO A CODE (FROM 1 TO 19) C UPDATED --JUNE 2002. SWITCHES THAT RETURN ON/OFF, C OPEN/CLOSE SET PROBEVAL TO C 1 (ON) OR 0 (OFF) C UPDATED --JUNE 2002. PROBE NUMBER OF CP C UPDATED --JULY 2002. PROBE QUANTILE METHOD C UPDATED --JULY 2002. PROBE QUANTILE STANDARD ERROR C UPDATED --JULY 2002. PROBE COVARIANCE TYPE C UPDATED --JULY 2002. PROBE CORRELATION TYPE C UPDATED --JULY 2002. PROBE FILE NAME QUOTE C UPDATED --JULY 2002. PROBE BOOTSTRAP FIT METHOD C UPDATED --JANAUARY 2003. PROBE POSTSCRIPT BOUND BOX C UPDATED --FEBRUARY 2003. PROBE AUTOCORRELATION LAG C ZERO C UPDATED --MARCH 2003. PROBE PARALLEL COORDINATES C STANDARDIZE C UPDATED --MARCH 2003. PROBE BOOTSTRAP GROUPS C UPDATED --SEPTEMBER 2003. PROBE TABLE BORDER C UPDATED --SEPTEMBER 2003. PROBE TABLE SPACING C UPDATED --JANUARY 2004. PROBE READ VARIABLE LABEL C UPDATED --JANUARY 2004. PROBE CONVERT CHARACTER C UPDATED --JANUARY 2004. PROBE READ DELIMITER C UPDATED --JANUARY 2004. PROBE READ MISSING VALUE C UPDATED --MARCH 2004. PROBE GEOMETRIC DEFINITION C UPDATED --MARCH 2004. PROBE PPCC PLOT C UPDATED --MARCH 2004. PROBE HYPERGEOMETRIC MAXI LIKE C UPDATED --MAY 2004. PROBE PPCC FORMAT C UPDATED --JUNE 2004. PROBE DEFAULT POSTSCRIPT COLOR C UPDATED --JUNE 2004. PROBE ASYMMETRIC LAPLACE C DEFINITION C UPDATED --JUNE 2004. PROBE GENERALIZED PARETO C DEFINITION C UPDATED --JULY 2004. PROBE GOMPERTZ-MAKEHAM C DEFINITION C UPDATED --SEPTEMBER 2004. PROBE BESSEL I FUNCTION C DEFINITION C UPDATED --SEPTEMBER 2004. PROBE BESSEL K FUNCTION C DEFINITION C UPDATED --SEPTEMBER 2004. PROBE PROBABILITY PLOT DATA C POINTS C UPDATED --SEPTEMBER 2004. PROBE PPCC PLOT DATA POINTS C UPDATED --SEPTEMBER 2004. PROBE PPCC PLOT AXIS POINTS C UPDATED --SEPTEMBER 2004. PROBE PPCC PLOT AXIS ORDER C UPDATED --SEPTEMBER 2004. PROBE HISTOGRAM CLASS WIDTH C UPDATED --SEPTEMBER 2004. PROBE ASH WEIGHTING C UPDATED --OCTOBER 2004. PROBE READ PAD MISSING COLU C UPDATED --OCTOBER 2004. PROBE READ SUBSET C UPDATED --OCTOBER 2004. PROBE CENSORED PROB PLOT C UPDATED --OCTOBER 2004. PROBE CENSORED PPCC PLOT C UPDATED --OCTOBER 2004. PROBE MAXIMUM LIKELIHOOD C QUANTILES C C UPDATED --OCTOBER 2004. PROBE EXPONENTIAL BIAS CORRECTED C UPDATED --NOVEMBER 2004. PROBE WEIBULL BIAS CORRECTED C UPDATED --NOVEMBER 2004. PROBE MATRIX CORRELATION DIRECTION C UPDATED --NOVEMBER 2004. PROBE MATRIX COVARIANCE DIRECTION C UPDATED --DECEMBER 2004. PROBE GUI C UPDATED --DECEMBER 2004. PROBE MAXIMUM LIKELIHOOD C RELIABILITY C UPDATED --DECEMBER 2004. PROBE MAXIMUM LIKELIHOOD C RELIABILITY C UPDATED --FEBRAURY 2005. PROBE DISTRIBUTIONAL BOOTSTRAP C UPDATED --FEBRAURY 2005. PROBE PARAMETER EXPAND DIGIT C UPDATED --FEBRAURY 2005. PROBE RTF FIXED FONT C UPDATED --FEBRAURY 2005. PROBE RTF PROPORTIONAL FONT C UPDATED --MARCH 2005. PROBE LINE PRINTER COLUNMNS C UPDATED --MARCH 2005. PROBE AQUA CAP STYLE C UPDATED --MARCH 2005. PROBE AQUA JOIN STYLE C UPDATED --MARCH 2005. PROBE AQUA FONT NAME C UPDATED --MARCH 2005. PROBE AQUA HARDWARE FILL C UPDATED --APRIL 2005. PROBE DECIMAL POINT C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C METHOD C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C DISTRIBUTION C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C INITIAL POINTS C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C INITIAL THRESHOLD C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C ITERATIONS C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C INCREMENT C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C PERIOD C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C TOLERANCE C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C LOAD FACTOR C UPDATED --APRIL 2005. PROBE PEAKS OVER THRESHOLD C X AXIS C UPDATED --MAY 2005. PROBE FRECHET BIAS CORRECTED C UPDATED --MAY 2005. PROBE GRUBBS ONE SIDED C UPDATED --JULY 2005. PROBE LOG GAMMA DEFINITION C UPDATED --JULY 2005. PROBE SKEW NORMAL DEFINITION C UPDATED --OCTOBER 2005. PROBE GENERALIZED PARETO C MLE STARTING VALUES C UPDATED --FEBRUARY 2006. PROBE IBUGLO C UPDATED --FEBRUARY 2006. PROBE LATEX COLOR C UPDATED --FEBRUARY 2006. PROBE LATEX FILL C UPDATED --FEBRUARY 2006. PROBE LATEX LINE THICK C UPDATED --FEBRUARY 2006. PROBE GENERALIZED TUKEY LAMB C UPDATED --MARCH 2006. PROBE TEMPORARY FILE C UPDATED --MAY 2006. PROBE PPCC PLOT LOCA SCALE C UPDATED --MAY 2006. PROBE BETA GEOMETRIC C DEFINITION C UPDATED --JUNE 2006. PROBE FORTRAN FORMAT C CONTROL C UPDATED --JUNE 2006. PROBE MANDEL PAULE C UPDATED --JUNE 2006. PROBE MODIFIED MANDEL PAULE C UPDATED --JUNE 2006. PROBE VANGEL RUHKIN C UPDATED --JUNE 2006. PROBE BOB C UPDATED --JUNE 2006. PROBE SCHILLER EBERHARDT C UPDATED --JUNE 2006. PROBE METHOD OF MEANS C UPDATED --JUNE 2006. PROBE GRAYBILL DEAL C UPDATED --JUNE 2006. PROBE GRAND MEAN C UPDATED --JUNE 2006. PROBE GENERALIZED CONF INTE C UPDATED --JUNE 2006. PROBE DERSIMONIAN LAIRD C UPDATED --JUNE 2006. PROBE FAIRWEATHER C UPDATED --JUNE 2006. PROBE BAYESIAN CONSENSUS C PROCEDURE C UPDATED --JULY 2006. PROBE GEETA DEFINITION C UPDATED --JULY 2006. PROBE CHISQUARE LIMIT C UPDATED --AUGUST 2006. PROBE CONSUL DEFINITION C UPDATED --OCTOBER 2006. PROBE 4PLOT DISTRIBUTION C UPDATED --OCTOBER 2006. PROBE MAXWELL LOCATION C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C CHARACTER*4 IOSW C CHARACTER*4 IBUGUG CHARACTER*4 IBUGU2 CHARACTER*4 IBUGU3 CHARACTER*4 IBUGU4 C CHARACTER*4 IBUGEX CHARACTER*4 IBUGE2 CHARACTER*4 IBUGHE CHARACTER*4 IBUGH2 CHARACTER*4 IBUGLO C CHARACTER*4 IFTEXP CCCCC AUGUST 1995. ADD FOLLOWING LINE CHARACTER*4 IFTORD CCCCC MARCH 1996. ADD FOLLOWING LINE CCCCC NOVEMBER 1998. MOVE TO DPCOST.INC CCCCC CHARACTER*4 IRHSTG C CHARACTER*4 IFORSW CHARACTER*4 IREPCH C CHARACTER*80 ICREAF CHARACTER*80 ICWRIF C CHARACTER*4 IREARW CHARACTER*4 IWRIRW C CHARACTER*4 ISUBRO C CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993 CHARACTER*4 IPRITY CCCCC THE FOLLOWING LINE WAS ADDED JULY 1995 CCCCC CHARACTER*4 IFITAC C CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 ICASPR CHARACTER*4 IPART1 CHARACTER*4 IPART2 CHARACTER*4 IPART3 CHARACTER*4 IPART4 CHARACTER*4 IPART5 CHARACTER*4 IPART6 CHARACTER*4 IHV CHARACTER*4 IHV2 C CHARACTER*80 ISTRIN C CHARACTER*80 IPROBS CHARACTER*80 NEWNAM C CHARACTER*4 ISUBN0 C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOMC.INC' INCLUDE 'DPCODB.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCOPC.INC' INCLUDE 'DPCODG.INC' INCLUDE 'DPCOSU.INC' CCCCC THE FOLLOWING LINE (FOR WEIBULL MINMAX) WAS ADDED JANUARY 1994 INCLUDE 'DPCOS2.INC' INCLUDE 'DPCODA.INC' INCLUDE 'DPCOTR.INC' INCLUDE 'DPCOF2.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCODV.INC' CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993 INCLUDE 'DPCOGR.INC' CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1997 INCLUDE 'DPCOHO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IFOUND='NO' IERROR='NO' C APROBE=0.0 IPROBS=' ' ICASPR=' ' ISTRIN(01:40)=' ' ISTRIN(41:80)=' ' C IF(NUMARG.LE.0)GOTO5410 C C ********************************************* C ** STEP 12-- ** C ** TREAT THE PROBE READ FORMAT CASE ** C ********************************************* C CCCCC FOLLOWING SECTION ADDED JANUARY 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE READ DELIMITER ** C *************************************** C IPART1='READ' IPART2='DELI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IREADL GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE READ SUBSET ** C *************************************** C IPART1='READ' IPART2='SUBS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IREASB GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE READ MISSING VALUE ** C *************************************** C IPART1='READ' IPART2='MISS' IPART3='VALU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN AV=PREAMV GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE READ PAD MISSING COLUMN ** C *************************************** C IPART1='READ' IPART2='PAD ' IPART3='MISS' IPART4='COLU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IREAPD GOTO5160 ENDIF C C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'READ'.AND. 1 IHARG(2).NE.'REWI')GOTO1210 GOTO1290 C 1210 CONTINUE IF(NCREAF.GE.1)GOTO1240 IF(NCREAF.LE.0)GOTO1250 C 1240 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1249 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1241) 1241 FORMAT('THE (FORTRAN-LIKE) READ FORMAT IS CURRENTLY SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1242)(ICREAF(I:I),I=1,NCREAF) 1242 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 1249 CONTINUE IPROBS(1:NCREAF)=ICREAF(1:NCREAF) NCPROB=NCREAF GOTO8100 C 1250 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1259 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1251) 1251 FORMAT('THE (FORTRAN-LIKE) READ FORMAT IS CURRENTLY NULL.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1252) 1252 FORMAT('THUS SUBSEQUENT READS WILL BE FREE-FORMAT.') CALL DPWRST('XXX','BUG ') GOTO9000 1259 CONTINUE C 1290 CONTINUE C C ********************************************* C ** STEP 13-- ** C ** TREAT THE PROBE WRITE FORMAT CASE ** C ********************************************* C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'WRIT')GOTO1310 GOTO1390 C 1310 CONTINUE IF(NCWRIF.GE.1)GOTO1340 IF(NCWRIF.LE.0)GOTO1350 C 1340 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1349 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1341) 1341 FORMAT('THE (FORTRAN-LIKE) WRITE FORMAT IS CURRENTLY SET TO') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1342)(ICWRIF(I:I),I=1,NCWRIF) 1342 FORMAT(80A1) CALL DPWRST('XXX','BUG ') 1349 CONTINUE IPROBS(1:NCWRIF)=ICREAF(1:NCWRIF) NCPROB=NCWRIF GOTO8100 C 1350 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1359 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1351) 1351 FORMAT('THE (FORTRAN-LIKE) WRITE FORMAT IS CURRENTLY NULL.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1352) 1352 FORMAT('THUS SUBSEQUENT WRITES WILL BE FREE-FORMAT.') CALL DPWRST('XXX','BUG ') GOTO9000 1359 CONTINUE C 1390 CONTINUE C C ********************************************* C ** STEP 14-- ** C ** TREAT THE PROBE READ REWIND CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'READ'.AND. 1IHARG(2).EQ.'REWI')GOTO1410 GOTO1490 C 1410 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1429 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1421)IREARW 1421 FORMAT('THE READ REWIND SWITCH IS CURRENTLY ', 1A4) CALL DPWRST('XXX','BUG ') IF(IREARW.EQ.'ON')WRITE(ICOUT,1423) 1423 FORMAT('THUS SUBSEQUENT READS WILL HAVE AN AUTOMATIC') IF(IREARW.EQ.'ON')CALL DPWRST('XXX','BUG ') IF(IREARW.EQ.'OFF')WRITE(ICOUT,1424) 1424 FORMAT('THUS SUBSEQUENT READS WILL HAVE NO AUTOMATIC') IF(IREARW.EQ.'OFF')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1425) 1425 FORMAT('REWIND BEFORE THE READ OCCURS.') CALL DPWRST('XXX','BUG ') 1429 CONTINUE IPROBS(1:4)=IREARW(1:4) NCPROB=4 IF(IPROBS(1:2).EQ.'ON')NCPROB=2 IF(IPROBS(1:3).EQ.'OFF')NCPROB=3 GOTO8100 C 1490 CONTINUE C C ********************************************* C ** STEP 15-- ** C ** TREAT THE PROBE WRITE REWIND CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'WRIT'.AND. 1IHARG(2).EQ.'REWI')GOTO1510 GOTO1590 C 1510 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1529 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1521)IWRIRW 1521 FORMAT('THE WRITE REWIND SWITCH IS CURRENTLY ', 1A4) CALL DPWRST('XXX','BUG ') IF(IWRIRW.EQ.'ON')WRITE(ICOUT,1523) 1523 FORMAT('THUS SUBSEQUENT WRITES WILL HAVE AN AUTOMATIC') IF(IWRIRW.EQ.'ON')CALL DPWRST('XXX','BUG ') IF(IWRIRW.EQ.'OFF')WRITE(ICOUT,1524) 1524 FORMAT('THUS SUBSEQUENT WRITES WILL HAVE NO AUTOMATIC') IF(IWRIRW.EQ.'OFF')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1525) 1525 FORMAT('REWIND BEFORE THE WRITE OCCURS.') CALL DPWRST('XXX','BUG ') 1529 CONTINUE IPROBS(1:4)=IWRIRW(1:4) NCPROB=4 IF(IPROBS(1:2).EQ.'ON')NCPROB=2 IF(IPROBS(1:3).EQ.'OFF')NCPROB=3 GOTO8100 C 1590 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 C ********************************************* C ** STEP 16-- ** C ** TREAT THE SET PRINTER TYPE CASE ** C ********************************************* C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'PRIN'.AND. 1IHARG(2).EQ.'TYPE')GOTO1610 GOTO1690 C 1610 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO1639 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1621)IPRITY 1621 FORMAT('THE PRINTER TYPE SWITCH IS CURRENTLY ', 1A4) CALL DPWRST('XXX','BUG ') IF(IPRITY.EQ.'ASCI')WRITE(ICOUT,1623) 1623 FORMAT('THUS DATAPLOT CURRENTLY CONSIDERS THE PRINTER ', 1'TO BE ASCII') IF(IPRITY.EQ.'ASCI')CALL DPWRST('XXX','BUG ') IF(IPRITY.EQ.'POST')WRITE(ICOUT,1624) 1624 FORMAT('THUS DATAPLOT CURRENTLY CONSIDERS THE PRINTER ', 1'TO BE POSTSCRIPT') IF(IPRITY.EQ.'POST')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1625) 1625 FORMAT('TO CHANGE THE DATAPLOT INTERNAL SETTING,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1626) 1626 FORMAT(' USE THE SET PRINTER TYPE COMMAND.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1627) 1627 FORMAT('TO CHANGE YOUR PRINTER,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1628) 1628 FORMAT(' DO SO MANUALLY , OR') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1629) 1629 FORMAT(' SEND THE PROPER COMMAND STRING TO THE PRINTER') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1630) 1630 FORMAT(' VIA THE SYSTEM OR DOS COMMAND.') CALL DPWRST('XXX','BUG ') 1639 CONTINUE IPROBS(1:4)=IPRITY(1:4) NCPROB=4 GOTO8100 C 1690 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1993 C *********************************** C ** CHECK FOR PROBE PATH ** C *********************************** C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATH')THEN IF(NCPATH.GE.1)THEN IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1716) 1716 FORMAT('THE CURRENT PATH FOR THE DATAPLOT DIRECTORY = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1717)PATH 1717 FORMAT(A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1718)NCPATH 1718 FORMAT('THE NUMBER OF CHARACTERS IN THE PATH NAME = ',I8) CALL DPWRST('XXX','BUG ') IPROBS(1:NCPATH)=PATH(1:NCPATH) NCPROB=NCPATH GOTO8100 ELSE IF(NCPATH.LE.0)THEN IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1726) 1726 FORMAT('THE CURRENT PATH FOR THE DATAPLOT DIRECTORY = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1727) 1727 FORMAT('EMPTY (= NO PATH)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1728)NCPATH 1728 FORMAT('THE NUMBER OF CHARACTERS IN THE PATH NAME = ',I8) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF ENDIF C C ********************************************* C ** STEP 18-- ** C ** DEFINE SOME VARIABLES ** C ** FOR THE GENERAL CASE ** C ********************************************* C IV=IARG(NUMARG) AV=ARG(NUMARG) IHV=IHARG(NUMARG) IHV2=IHARG2(NUMARG) C CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1995. C ****************************************** C ** SET FIT ITERATIONS (#) ** C ****************************************** C IPART1='FIT' IPART2='ITER' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IV=IFITIT GOTO5150 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1995. C ****************************************** C ** SET FIT STANDARD DEVIATION (#) ** C ****************************************** C IPART1='FIT ' IPART2='STAN' IPART3='DEVI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(3).EQ.IPART3)THEN AV=FITSD GOTO5170 ENDIF ENDIF C IPART1='FIT ' IPART2='SD' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN AV=FITSD GOTO5170 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1995. C ****************************************** C ** SET FIT ADDITIVE CONSTANT (ON/OFF) ** C ****************************************** C IPART1='FIT ' IPART2='ADDI' IPART3='CONS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(IHARG(3).EQ.IPART3)THEN IHV=IFITAC GOTO5160 ENDIF ENDIF C IPART1='FIT ' IPART2='CONS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IFITAC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 1995. C ******************************* C ** STEP 20.A-- ** C ** PROBE UNFORMATTED COLUMNS** C ******************************* C IPART1='UNFO' IPART2='COLU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IV=IUNFMC IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 C CCCCC FOLLOWING SECTION ADDED APRIL 1995. C ******************************* C ** STEP 20.A-- ** C ** PROBE UNFORMATTED RECORDS** C ******************************* C IPART1='UNFO' IPART2='COLU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IV=IUNFNR IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 C CCCCC FOLLOWING SECTION ADDED APRIL 1995. C ******************************* C ** STEP 20.A-- ** C ** PROBE UNFORMATTED OFFSET ** C ******************************* C IPART1='UNFO' IPART2='COLU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IV=IUNFOF IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1996 C **************************************** C ** CHECK FOR PROBE MENU PATH ** C **************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MENU' 1.AND.IHARG(2).EQ.'PATH')THEN IF(NCMPAT.GE.1)THEN IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1816) 1816 FORMAT('THE CURRENT PATH FOR THE DATAPLOT MENU = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1817)MPATH 1817 FORMAT(A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1818)NCMPAT 1818 FORMAT('THE NUMBER OF CHARACTERS IN THE MENU PATH ', 1 'NAME = ') CALL DPWRST('XXX','BUG ') IPROBS(1:NCMPAT)=MPATH(1:NCMPAT) NCPROB=NCMPAT GOTO8100 ELSE IF(NCMPAT.LE.0)THEN IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1826) 1826 FORMAT('THE CURRENT PATH FOR THE DATAPLOT MENU = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1827) 1827 FORMAT('EMPTY (= NO PATH)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1828)NCMPAT 1828 FORMAT('THE NUMBER OF CHARACTERS IN THE MENU PATH ', 1 'NAME = ') CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 1996. C ******************************* C ** STEP 20.A-- ** C ** PROBE RELATIVE HISTOGRAM ** C ******************************* C IPART1='RELA' IPART2='HIST' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=IRHSTG IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C CCCCC FOLLOWING SECTION ADDED APRIL 1997. C ******************************* C ** STEP 20.A-- ** C ** PROBE CONTROL CHART WEIGHT* C ******************************* C IPART1='CONT' IPART2='CHAR' IPART3='WEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IHV=ICCHPR GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 1998. C ******************************* C ** STEP 20.A-- ** C ** PROBE KAPLAN MEIER ** C ******************************* C IPART1='KAPL' IPART2='MEIE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IKAPSW GOTO5160 ENDIF IF(IHARG(1).EQ.IPART1)THEN IHV=IKAPSW GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1998. C ******************************* C ** STEP 20.A-- ** C ** PROBE PERCENT POINT PLOT ** C ******************************* C IPART1='PERC' IPART2='POIN' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPPTBI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1998. C *********************************** C ** STEP 20.A-- ** C ** PROBE QUANTILE-QUANTILE PLOT ** C *********************************** C IPART1='QUAN' IPART2='QUAN' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IQQPBI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 1999. C *********************************** C ** STEP 20.A-- ** C ** PROBE AUTOCORRELATION BAND ** C *********************************** C IPART1='AUTO' IPART2='BAND' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND.(IHARG(2).EQ.IPART2.OR. 1 IHARG(2).EQ.IPART3))THEN IHV=IAUTCP GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2003. C *************************************** C ** STEP 20.A-- ** C ** PROBE AUTOCORRELATION LAG ZERO ** C *************************************** C IPART1='AUTO' IPART2='LAG' IPART3='ZERO' IPART4='0' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 (IHARG(3).EQ.IPART3.OR.IHARG(3).EQ.IPART4))THEN IHV=IAUTL0 GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2003. C *************************************** C ** STEP 20.A-- ** C ** PROBE PARALLEL COORDINATES STAND ** C *************************************** C IPART1='PARA' IPART2='COOR' IPART3='STAN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPCCST GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2003. C *************************************** C ** STEP 20.A-- ** C ** PROBE BOOTSTRAP GROUPS ** C *************************************** C IPART1='BOOT' IPART2='GROU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IBOOGR GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2003. C *************************************** C ** STEP 20.A-- ** C ** PROBE MULTIVARIATE NORMAL ** C *************************************** C IPART1='MULT' IPART2='NORM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IMVNTY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003. C *************************************** C ** STEP 20.A-- ** C ** PROBE TABLE BORDER ** C *************************************** C IPART1='TABL' IPART2='BORD' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ITABBR GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003. C *************************************** C ** STEP 20.A-- ** C ** PROBE TABLE SPACING ** C *************************************** C IPART1='TABL' IPART2='SPAC' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IV=ITABSP GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003. C *************************************** C ** STEP 20.A-- ** C ** PROBE TABLE WIDTH ** C *************************************** C IPART1='TABL' IPART2='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IV=ITABWD GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003. C *************************************** C ** STEP 20.A-- ** C ** PROBE TABLE HEIGHT ** C *************************************** C IPART1='TABL' IPART2='HEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IV=ITABHT GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2003. C *************************************** C ** STEP 20.A-- ** C ** PROBE TABLE TITLE ** C *************************************** C IPART1='TABL' IPART2='TITL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IF(NCTABT.GT.0)THEN WRITE(ICOUT,7230) 7230 FORMAT('THE CURRENT TABLE TITLE IS:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7232)(ITABTI(I:I),I=1,MIN(80,NCTABT)) 7232 FORMAT(A80) CALL DPWRST('XXX','BUG ') GOTO9000 ELSE WRITE(ICOUT,7234) 7234 FORMAT('THE CURRENT TABLE TITLE IS CURRENTLY UNDEFINED.') CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2005. C *************************************** C ** STEP 20.A-- ** C ** PROBE RTF FIXED FONT ** C *************************************** C IPART1='RTF ' IPART2='FIXE' IPART3='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(NCRTF1.GT.0)THEN WRITE(ICOUT,7240) 7240 FORMAT('THE CURRENT RTF FIXED FONT IS:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7242)(IRTFFF(I:I),I=1,MIN(40,NCRTF1)) 7242 FORMAT(A40) CALL DPWRST('XXX','BUG ') GOTO9000 ELSE WRITE(ICOUT,7244) 7244 FORMAT('THE CURRENT RTF FIXED FONT IS CURRENTLY UNDEFINED.') CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2005. C *************************************** C ** STEP 20.A-- ** C ** PROBE RTF PROPORTIONAL FONT ** C *************************************** C IPART1='RTF ' IPART2='PROP' IPART3='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IF(NCRTF2.GT.0)THEN WRITE(ICOUT,7250) 7250 FORMAT('THE CURRENT RTF PROPORTIONAL FONT IS:') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7252)(IRTFFP(I:I),I=1,MIN(40,NCRTF2)) 7252 FORMAT(A40) CALL DPWRST('XXX','BUG ') GOTO9000 ELSE WRITE(ICOUT,7254) 7254 FORMAT('THE CURRENT RTF PROPORTIONAL FONT IS CURRENTLY ', 1 'UNDEFINED.') CALL DPWRST('XXX','BUG ') ENDIF GOTO9000 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE READ VARIABLE LABEL ** C *************************************** C IPART1='READ' IPART2='VARI' IPART3='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IVARLA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE CONVERT CHARACTER ** C *************************************** C IPART1='CONV' IPART2='CHAR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IGRPAU GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE GEOMETRIC DEFINITION ** C *************************************** C IPART1='GEOM' IPART2='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IGEODF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2006. C *************************************** C ** STEP 20.A-- ** C ** PROBE BETA GEOMETRIC DEFINITION ** C *************************************** C IPART1='BETA' IPART2='GEOM' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IBGEDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2006. C *************************************** C ** STEP 20.A-- ** C ** PROBE GEETA DEFINITION ** C *************************************** C IPART1='GEET' IPART2='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IGETDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2006. C *************************************** C ** STEP 20.A-- ** C ** PROBE CONSUL DEFINITION ** C *************************************** C IPART1='CONS' IPART2='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ICONDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2006. C *************************************** C ** STEP 20.A-- ** C ** PROBE FORTRAN FORMAT CONTROL ** C *************************************** C IPART1='FORT' IPART2='FORM' IPART3='CONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFORFM GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2006. C ********************************************* C ** STEP 20.A-- ** C ** THE FOLLOWING SECTION IS FOR THE ** C ** MEAN COMMAND. YOU CAN TURN EACH ** C ** OF THE METHODS ON INDIVIDUALLY. ** C ** PROBE MANDEL PAULE ** C ** PROBE MODIFIED MANDEL PAULE ** C ** PROBE VANGEL RUHKIN ** C ** PROBE BOB ** C ** PROBE SCHILLER EBERHARDT ** C ** PROBE METHOD OF MEANS ** C ** PROBE GRAYBILL DEAL ** C ** PROBE GRAND MEAN ** C ** PROBE GENERALIZED CONFIDENCE INTERVALS ** C ** PROBE DERSIMONIAN LAIRD ** C ** PROBE FAIRWEATHER ** C ********************************************* C IPART1='MAND' IPART2='PAUL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IMMPCM GOTO5160 ENDIF C IPART1='MODI' IPART2='MAND' IPART3='PAUL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IMPACM GOTO5160 ENDIF C IPART1='VANG' IPART2='RUHK' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IVRUCM GOTO5160 ENDIF IPART1='RUHK' IPART2='VANG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IVRUCM GOTO5160 ENDIF IPART1='MAXI' IPART2='LIKE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IVRUCM GOTO5160 ENDIF C IPART1='BOB ' IF(IHARG(1).EQ.IPART1)THEN IHV=IBOBCM GOTO5160 ENDIF C IPART1='SCHI' IPART2='EBER' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ISCECM GOTO5160 ENDIF C IPART1='MEAN' IPART2='OF ' IPART3='MEAN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IMOMCM GOTO5160 ENDIF C IPART1='GRAY' IPART2='DEAL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IGRDCM GOTO5160 ENDIF C IPART1='GRAN' IPART2='MEAN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IGMECM GOTO5160 ENDIF C IPART1='GENE' IPART2='CONF' IPART3='INTE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IGCICM GOTO5160 ENDIF C IPART1='DERS' IPART2='LAIR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IDSLCM GOTO5160 ENDIF C IPART1='FAIR' IF(IHARG(1).EQ.IPART1)THEN IHV=IFAICM GOTO5160 ENDIF C IPART1='BAYE' IPART2='CONS' IPART3='PROC' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IBCPCM GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2004. C *********************************************** C ** STEP 20.A-- ** C ** PROBE HYPERGEOMETRIC MAXIMUM LIKELIHOOD ** C *********************************************** C IPART1='HYPE' IPART2='MAXI' IPART3='LIKE' IPART4='MLE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IHYPTY GOTO5160 ELSEIF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART4)THEN IHV=IHYPTY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2004. C **************************************************** C ** STEP 20.A-- ** C ** PROBE PPCC PLOT DATA POINTS ** C **************************************************** C IPART1='PPCC' IPART2='PLOT' IPART3='DATA' IPART4='POIN' IPART5='KS ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IV=IPPCDP GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2004. C **************************************************** C ** STEP 20.A-- ** C ** PROBE PPCC PLOT AXIS POINTS ** C **************************************************** C IPART1='PPCC' IPART2='PLOT' IPART3='AXIS' IPART4='POIN' IPART5='AXES' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 (IHARG(3).EQ.IPART3 .OR. IHARG(3).EQ.IPART5).AND. 1 IHARG(4).EQ.IPART4)THEN IV=IPPCAP(1) GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE PPCC PLOT AXIS ORDER ** C *************************************** C IPART1='PPCC' IPART2='PLOT' IPART3='AXIS' IPART4='ORDE' IPART5='KS ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART5).AND. 1 IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IPPCAO GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE CENSORED PPCC PLOT ** C *************************************** C IPART1='CENS' IPART2='PPCC' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPPCCN GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE PPCC PLOT ** C *************************************** C IPART1='PPCC' IPART2='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IPPCCC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE PPCC FORMAT ** C *************************************** C IPART1='PPCC' IPART2='FORM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IPPCFO GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE DEFAULT POSTSCRIPT COLOR ** C ** PROBE POSTSCRIPT DEFAULT COLOR ** C ** PROBE POSTSCRIPT COLOR DEFAULT ** C *************************************** C IPART1='DEFA' IPART2='POST' IPART3='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPSTDC GOTO5160 ENDIF C IPART1='POST' IPART2='DEFA' IPART3='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPSTDC GOTO5160 ENDIF C IPART1='POST' IPART2='COLO' IPART3='DEFA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPSTDC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2004. C ***************************************************** C ** STEP 20.A-- ** C ** PROBE ASYMMETRIC DOUBLE EXPONENTIAL DEFINITION ** C ***************************************************** C IPART1='ASYM' IPART2='DOUB' IPART3='EXPO' IPART4='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IADEDF GOTO5160 ENDIF C IPART1='ASYM' IPART2='LAPL' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IADEDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2004. C ****************************************************** C ** STEP 20.A-- ** C ** PROBE GENERALZIED PARETO DEFINITION ** C ****************************************************** C IPART1='GENE' IPART2='PARE' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IGEPDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2005. C ****************************************************** C ** STEP 20.A-- ** C ** PROBE GENERALZIED PARETO MLE STARTING VALUES ** C ****************************************************** C IPART1='GENE' IPART2='PARE' IPART3='MLE ' IPART4='STAR' IPART5='VALU' IPART6='ML ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 (IHARG(3).EQ.IPART3.OR.IHARG(3).EQ.IPART6).AND. 1 IHARG(4).EQ.IPART4.AND.IHARG(5).EQ.IPART5)THEN IHV=IGEPSV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2005. C ****************************************************** C ** STEP 20.A-- ** C ** PROBE LOG GAMMA DEFINITION ** C ****************************************************** C IPART1='LOG ' IPART2='GAMM' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ILGADF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2005. C ****************************************************** C ** STEP 20.A-- ** C ** PROBE SKEW NORMAL DEFINITION ** C ****************************************************** C IPART1='SKEW' IPART2='NORM' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ISKNDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2006. C ****************************************************** C ** STEP 20.A-- ** C ** PROBE GENERALIZED TUKEY LAMBDA DEFINITION ** C ****************************************************** C IPART1='GENE' IPART2='TUKE' IPART3='LAMB' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IGLDDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2006. C ****************************************************** C ** STEP 20.A-- ** C ** PROBE TEMPORARY FILE DEFINITION ** C ****************************************************** C IPART1='TEMP' IPART2='FILE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ITMPFI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2006. C ****************************************************** C ** STEP 20.A-- ** C ** PROBE PPCC PLOT LOCATION SCALE ** C ****************************************************** C IPART1='PPCC' IPART2='PLOT' IPART3='LOCA' IPART4='SCALE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IPPCBW GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2004. C **************************************************** C ** STEP 20.A-- ** C ** PROBE GOMPERTZ-MAKEHAM DEFINITION ** C **************************************************** C IPART1='GOMP' IPART2='MAKE' IPART3='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IMAKDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2004. C **************************************************** C ** STEP 20.A-- ** C ** PROBE BESSEL I-FUNCTION DEFINITION ** C **************************************************** C IPART1='BESS' IPART2='I ' IPART3='FUNC' IPART4='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IBEIDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2004. C **************************************************** C ** STEP 20.A-- ** C ** PROBE BESSEL K-FUNCTION DEFINITION ** C **************************************************** C IPART1='BESS' IPART2='K ' IPART3='FUNC' IPART4='DEFI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IBEKDF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED AUGUST 2004. C **************************************************** C ** STEP 20.A-- ** C ** PROBE PROBABILITY PLOT DATA POINTS ** C **************************************************** C IPART1='PROB' IPART2='PLOT' IPART3='DATA' IPART4='POIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IV=IPPLDP GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C **************************************************** C ** STEP 20.A-- ** C ** PROBE CENSORED PROBABILITY PLOT ** C **************************************************** C IPART1='CENS' IPART2='PROB' IPART3='PLOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPPLCN GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2004. C *************************************** C ** STEP 20.A-- ** C ** PROBE HISTOGRAM CLASS WIDTH ** C *************************************** C IPART1='HIST' IPART2='CLAS' IPART3='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IHSTCW GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2004. C ************************************************* C ** STEP 20.A-- ** C ** PROBE ASH WEIGHTING ** C ** PROBE AVERAGE SHIFTED HISTOGRAM WEIGHTING ** C ************************************************* C IPART1='ASH ' IPART2='WEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IASHWT GOTO5160 ENDIF C IPART1='AVER' IPART2='SHIF' IPART3='HIST' IPART4='WEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IASHWT GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C ************************************************* C ** STEP 20.A-- ** C ** PROBE MAXIMUM LIKELIHOOD QUANTILES ** C ************************************************* C IPART1='MAXI' IPART2='LIKE' IPART3='QUAN' IPART4='PERC' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 (IHARG(3).EQ.IPART3.OR.IHARG(3).EQ.IPART4))THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55161)IQUAVR 55161 FORMAT('THE MAXIMUM LIKEHOOD PERCENTILES VARIABLE HAS ', 1 'BEEN SET TO ',A8) CALL DPWRST('XXX','BUG ') IPROBS=' ' IPROBS(1:8)=IQUAVR(1:8) NCPROB=8 GOTO8100 ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 2004. C ************************************************* C ** STEP 20.A-- ** C ** PROBE MAXIMUM LIKELIHOOD RELIABILITY ** C ************************************************* C IPART1='MAXI' IPART2='LIKE' IPART3='RELI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55163)IRELVR 55163 FORMAT('THE MAXIMUM LIKEHOOD RELIABILITY VARIABLE HAS ', 1 'BEEN SET TO ',A8) CALL DPWRST('XXX','BUG ') IPROBS=' ' IPROBS(1:8)=IRELVR(1:8) NCPROB=8 GOTO8100 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2004. C ************************************************* C ** STEP 20.A-- ** C ** PROBE EXPONENTIAL BIAS CORRECTED ** C ************************************************* C IPART1='EXPO' IPART2='BIAS' IPART3='CORR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IEXPBC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2004. C ************************************************* C ** STEP 20.A-- ** C ** PROBE WEIBULL BIAS CORRECTED ** C ************************************************* C IPART1='WEIB' IPART2='BIAS' IPART3='CORR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IWEIBC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2005. C ************************************************* C ** STEP 20.A-- ** C ** PROBE GRUBBS ONE SIDED ** C ************************************************* C IPART1='GRUB' IPART2='ONE ' IPART3='SIDE' IPART4='1 ' IF(IHARG(1).EQ.IPART1.AND. 1 (IHARG(2).EQ.IPART2.OR.IHARG(2).EQ.IPART4).AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IGRU1S GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2005. C ************************************************* C ** STEP 20.A-- ** C ** PROBE FRECHET BIAS CORRECTED ** C ************************************************* C IPART1='FREC' IPART2='BIAS' IPART3='CORR' IPART4='EV2 ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 IHARG(2).EQ.IPART2.AND.IHARG(3).EQ.IPART3)THEN IHV=IFREBC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2004. C ************************************************* C ** STEP 20.A-- ** C ** PROBE GUMBEL BIAS CORRECTED ** C ************************************************* C IPART1='GUMB' IPART2='BIAS' IPART3='CORR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IGUMBC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2004. C ************************************************* C ** STEP 20.A-- ** C ** PROBE MATRIX CORRELATION DIRECTION ** C ************************************************* C IPART1='MATR' IPART2='CORR' IPART3='DIRE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICORDI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2004. C ************************************************* C ** STEP 20.A-- ** C ** PROBE MATRIX COVARIANCE DIRECTION ** C ************************************************* C IPART1='MATR' IPART2='COVA' IPART3='DIRE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICOVDI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 2004. C ************************************************* C ** STEP 20.A-- ** C ** PROBE MATRIX COVARIANCE DIRECTION ** C ************************************************* C IPART1='GUI ' IF(IHARG(1).EQ.IPART1)THEN IHV=IGUIFL GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2002. C *********************************** C ** STEP 20.A-- ** C ** PROBE BOX PLOT WIDTH ** C *********************************** C IPART1='BOX ' IPART2='PLOT' IPART3='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IBXPWI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2002. C *********************************** C ** STEP 20.A-- ** C ** PROBE 4-PLOT MULTIPLOT ** C *********************************** C IPART1='4 ' IPART2='PLOT' IPART3='MULT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=I4PLMC GOTO5160 ENDIF C IPART1='4PLO' IPART2='MULT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=I4PLMC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2002. C *********************************** C ** STEP 20.A-- ** C ** PROBE 6-PLOT MULTIPLOT ** C *********************************** C IPART1='6 ' IPART2='PLOT' IPART3='MULT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=I6PLMC GOTO5160 ENDIF C IPART1='6PLO' IPART2='MULT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=I6PLMC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 2002. C *********************************** C ** STEP 20.A-- ** C ** PROBE RANDOM NUMBER GENERATOR** C *********************************** C IPART1='RAND' IPART2='NUMB' IPART3='GENE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IRANAL GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 2002. C *********************************** C ** STEP 20.A-- ** C ** PROBE NUMBER OF CP ** C *********************************** C IPART1='NUMB' IPART2='OF ' IPART3='CP ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IV=INUMCP GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002. C *********************************** C ** STEP 20.A-- ** C ** PROBE QUANTILE METHOD ** C *********************************** C IPART1='QUAN' IPART2='METH' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IQUAME GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002. C ************************************************** C ** STEP 20.A-- ** C ** PROBE QUANTILE STANDARD ERROR METHOD ** C ************************************************** C IPART1='QUAN' IPART2='STAN' IPART3='ERRO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IQUASE GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002. C ************************************************** C ** STEP 20.A-- ** C ** PROBE COVARIANCE TYPE ** C ************************************************** C IPART1='COVA' IPART2='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ICOVTY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002. C ************************************************** C ** STEP 20.A-- ** C ** PROBE CORRELATION TYPE ** C ************************************************** C IPART1='CORR' IPART2='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ICORTY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002. C ************************************************** C ** STEP 20.A-- ** C ** PROBE FILE NAME QUOTE ** C ************************************************** C IPART1='FILE' IPART2='NAME' IPART2='QUOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFILQU GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2002. C ************************************************** C ** STEP 20.A-- ** C ** PROBE BOOTSTRAP FIT METHOD ** C ************************************************** C IPART1='BOOT' IPART2='FIT ' IPART2='METH' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IBOOME GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE BOOTSTRAP DISTRIBUTIONAL BOOTSTRAP ** C ************************************************** C IPART1='DIST' IPART2='BOOT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IBOOPA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE DECIMAL POINT ** C ************************************************** C IPART1='DECI' IPART2='POIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IDECPT GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2006. C ************************************************** C ** STEP 20.A-- ** C ** PROBE 4PLOT DISTRIBUTION ** C ************************************************** C IPART1='4PLO' IPART2='DIST' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=I4PLDI GOTO5160 ENDIF C IPART1='4 ' IPART2='PLOT' IPART3='DIST' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=I4PLDI GOTO5160 ENDIF C C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD METHOD ** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='METH' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IPOTME GOTO5160 ENDIF C IPART1='POT ' IPART2='METH' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IPOTME GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD LOAD FACTOR ** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='LOAD' IPART5='FACT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN IHV=IPOTLF GOTO5160 ENDIF C IPART1='POT ' IPART2='LOAD' IPART3='FACT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPOTLF GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD X AXIS ** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='X ' IPART5='AXIS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN IHV=IPOTAX GOTO5160 ENDIF C IPART1='POT ' IPART2='X ' IPART3='AXIS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPOTAX GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD DISTRIBUTION ** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='DIST' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IPOTDI GOTO5160 ENDIF C IPART1='POT ' IPART2='METH' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IPOTDI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD INITIAL POINTS ** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='INIT' IPART5='POIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN IV=IPOTNP GOTO5150 ENDIF C IPART1='POT ' IPART2='INIT' IPART3='POIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IV=IPOTNP GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD ITERATIONS ** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='ITER' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IV=IPOTIT GOTO5150 ENDIF C IPART1='POT ' IPART2='IITE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IV=IPOTIT GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD INITIAL THRESHOLD** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='INIT' IPART5='THRE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN AV=PPOTTH GOTO5170 ENDIF C IPART1='POT ' IPART2='INIT' IPART3='THRE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN AV=PPOTTH GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD INCREMENT ** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='INCR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN AV=PPOTIN GOTO5170 ENDIF C IPART1='POT ' IPART2='INCR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN AV=PPOTIN GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD INCREMENT ** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='PERI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN AV=PPOTPE GOTO5170 ENDIF C IPART1='POT ' IPART2='INCR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN AV=PPOTPE GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2005. C ************************************************** C ** STEP 20.A-- ** C ** PROBE PEAKS OVER THRESHOLD TOLERANCE ** C ************************************************** C IPART1='PEAK' IPART2='OVER' IPART3='THRE' IPART4='TOLE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN AV=PPOTTO GOTO5170 ENDIF C IPART1='POT ' IPART2='INCR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN AV=PPOTTO GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED JULY 2006. C ************************************************** C ** STEP 20.A-- ** C ** PROBE CHISQUARE LIMIT ** C ************************************************** C IPART1='CHIS' IPART2='LIMI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN AV=PCHSLM GOTO5170 ENDIF C IPART1='CHI ' IPART2='SQUA' IPART3='LIMI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN AV=PCHSLM GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2006. C ************************************************** C ** STEP 20.A-- ** C ** PROBE MAXWELL LOCATION ** C ************************************************** C IPART1='MAXW' IPART2='LOCA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN AV=PMAXLO GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2002. C ************************************************** C ** STEP 20.A-- ** C ** PROBE QWIN SYSTEM ** C ************************************************** C IPART1='QWIN' IPART2='SYST' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IQWNSY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2002. C ************************************************** C ** STEP 20.A-- ** C ** PROBE GHOSTSCRIPT PRINTER ** C ************************************************** C IPART1='GHOS' IPART2='PRIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IPRNGS GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2003. C ************************************************** C ** STEP 20.A-- ** C ** PROBE POSTSCRIPT BOUNDING BOX ** C ************************************************** C IPART1='POST' IPART2='BOUN' IPART3='BOX ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IPSTBB GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2003. C ************************************************** C ** STEP 20.A-- ** C ** PROBE POSTSCRIPT CONVERT ** C ************************************************** C IPART1='POST' IPART2='BOUN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IPSTDV GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2001. C *********************************** C ** STEP 20.A-- ** C ** PROBE LOCATION STATISTIC ** C *********************************** C IPART1='LOCA' IPART2='STAT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ISTALO GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2001. C *********************************** C ** STEP 20.A-- ** C ** PROBE SCALE STATISTIC ** C *********************************** C IPART1='SCAL' IPART2='STAT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ISTASC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2001. C *********************************** C ** STEP 20.A-- ** C ** PROBE SUPERSCRIPT HORI SCALE ** C *********************************** C IPART1='SUPE' IPART2='HORI' IPART3='SCAL' IPART4='SUBS' IPART5='X ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 (IHARG(2).EQ.IPART2.OR.IHARG(2).EQ.IPART5).AND. 1 IHARG(3).EQ.IPART3)THEN AV=PSUPXS GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2001. C *********************************** C ** STEP 20.A-- ** C ** PROBE SUPERSCRIPT VERT SCALE ** C *********************************** C IPART1='SUPE' IPART2='VERT' IPART3='SCAL' IPART4='SUBS' IPART5='Y ' IF((IHARG(1).EQ.IPART1.OR.IHARG(1).EQ.IPART4).AND. 1 (IHARG(2).EQ.IPART2.OR.IHARG(2).EQ.IPART5).AND. 1 IHARG(3).EQ.IPART3)THEN AV=PSUPYS GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2001. C *************************************************** C ** STEP 20.A-- ** C ** PROBE ORTHOGNAL DISTANCE TRUST REGION RADIUS ** C *************************************************** C IPART1='ORTH' IPART2='DIST' IPART3='TRUS' IPART4='REGI' IPART5='RADI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN AV=PODRTF GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2001. C *************************************************** C ** STEP 20.A-- ** C ** PROBE ORTHOGNAL DISTANCE STOP TOLERANCE ** C *************************************************** C IPART1='ORTH' IPART2='DIST' IPART3='STOP' IPART4='TOLE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN AV=PODRST GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2001. C *************************************************** C ** STEP 20.A-- ** C ** PROBE ORTHOGNAL DISTANCE PARAMETER TOLERANCE ** C *************************************************** C IPART1='ORTH' IPART2='DIST' IPART3='PARA' IPART4='TOLE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN AV=PODRPT GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 2001. C *************************************************** C ** STEP 20.A-- ** C ** PROBE ORTHOGNAL DISTANCE PRINT OPTION ** C *************************************************** C IPART1='ORTH' IPART2='DIST' IPART3='PRIN' IPART4='OPTI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IODRPO GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2005 C *********************************** C ** STEP 20.A-- ** C ** PROBE PARAMETER EXPAND DIGIT ** C *********************************** C IPART1='PARA' IPART2='EXPA' IPART3='DIGI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IV=IEXPDI GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED MARCH 2005 C *********************************** C ** STEP 20.A-- ** C ** PROBE LINE PRINTER COLUMNS ** C *********************************** C IPART1='LINE' IPART2='PRIN' IPART3='COLU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IV=ILPRCO GOTO5150 ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 1999. C *********************************** C ** STEP 20.A-- ** C ** PROBE PARAMETER EXPAND ** C *********************************** C IPART1='PARA' IPART2='EXPA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IEXPPA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED DECEMBER 1999. C *********************************** C ** STEP 20.A-- ** C ** PROBE VARIABLE LABEL EXPAND ** C *********************************** C IPART1='VARI' IPART2='LABE' IPART3='EXPA' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IVNMEX GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2000. C ****************************************** C ** STEP 20.A-- ** C ** PROBE CROSS TABULATE PLOT DIMENSION ** C ****************************************** C IPART1='CROS' IPART2='TABU' IPART3='PLOT' IPART3='DIME' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=ICTBDI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JANUARY 2000. C ****************************************** C ** STEP 20.A-- ** C ** PROBE SORT DIRECTION ** C ****************************************** C IPART1='SORT' IPART2='DIRE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ISORDI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED OCTOBER 2000. C ****************************************** C ** STEP 20.A-- ** C ** PROBE MANDEL PAULE ** C ****************************************** C IPART1='MAND' IPART2='PAUL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ISORDI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2000. C ****************************************** C ** STEP 20.A-- ** C ** PROBE DEX CONTOUR PLOT DIRECTION ** C ****************************************** C IPART1='DEX ' IPART2='CONT' IPART3='PLOT' IPART4='DIRE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IDCPDI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2000. C ****************************************** C ** STEP 20.A-- ** C ** PROBE DEX CONTOUR PLOT MODEL ** C ****************************************** C IPART1='DEX ' IPART2='CONT' IPART3='PLOT' IPART4='MODE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=IDCPFI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C ***************************************** C ** STEP 20.A-- ** C ** PROBE SCATTER PLOT MATRIX LABELS ** C ***************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=ISPMLA GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ISPMLA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C ***************************************** C ** STEP 20.A-- ** C ** PROBE CONDITIONING PLOT LABELS ** C ***************************************** C IPART1='COND' IPART2='PLOT' IPART3='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLLA GOTO5160 ENDIF C IPART1='SUBS' IPART2='PLOT' IPART3='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLLA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C ***************************************** C ** STEP 20.A-- ** C ** PROBE FACTOR PLOT LABELS ** C ***************************************** C IPART1='FACT' IPART2='PLOT' IPART3='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLLA GOTO5160 ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='LABE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLLA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C ***************************************** C ** STEP 20.A-- ** C ** PROBE SCATTER PLOT MATRIX DIAGONAL ** C ***************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='DIAG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=ISPMDI GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='DIAG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ISPMDI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C ***************************************** C ** STEP 20.A-- ** C ** PROBE SCATTER PLOT MATRIX FIT ** C ***************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=ISPMFI GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ISPMFI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C ***************************************** C ** STEP 20.A-- ** C ** PROBE CONDITIONING PLOT FIT ** C ***************************************** C IPART1='COND' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLFI GOTO5160 ENDIF C IPART1='SUBS' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLFI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C ***************************************** C ** STEP 20.A-- ** C ** PROBE FACTOR PLOT FIT ** C ***************************************** C IPART1='FACT' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLFI GOTO5160 ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='FIT ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLFI GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE SCATTER PLOT MATRIX LOWER DIAGONAL ** C *********************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='LOWE' IPART5='DIAG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4.AND. 1 IHARG(5).EQ.IPART5)THEN IHV=ISPMLD GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='LOWE' IPART4='DIAG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=ISPMLD GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE CONDITIONING PLOT LOWER DIAGONAL ** C *********************************************** C CCCCC IPART1='COND' CCCCC IPART2='PLOT' CCCCC IPART3='LOWE' CCCCC IPART4='DIAG' CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. CCCCC1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN CCCCC IHV=ICPLLD CCCCC GOTO5160 CCCCC ENDIF C CCCCC IPART1='SUBS' CCCCC IPART2='PLOT' CCCCC IPART3='LOWE' CCCCC IPART4='DIAG' CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. CCCCC1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN CCCCC IHV=ICPLLD CCCCC GOTO5160 CCCCC ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE SCATTER PLOT MATRIX TAG ** C *********************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=ISPMTA GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ISPMTA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE CONDITIONING PLOT TAG ** C *********************************************** C IPART1='COND' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLTA GOTO5160 ENDIF C IPART1='SUBS' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLTA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE FACTOR PLOT TAG ** C *********************************************** C IPART1='FACT' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLTA GOTO5160 ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='TAG ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLTA GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE SCATTER PLOT MATRIX PLOT TYPE ** C *********************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=ISPMPT GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ISPMPT GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE CONDITIONING PLOT PLOT TYPE ** C *********************************************** C IPART1='COND' IPART2='PLOT' IPART3='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLPT GOTO5160 ENDIF C IPART1='SUBS' IPART2='PLOT' IPART3='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLPT GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE FACTOR PLOT PLOT TYPE ** C *********************************************** C IPART1='FACT' IPART2='PLOT' IPART3='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLPT GOTO5160 ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLPT GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE SCATTER PLOT MATRIX FRAME ** C *********************************************** C IPART1='SCAT' IPART2='PLOT' IPART3='MATR' IPART4='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IHV=ISPMFR GOTO5160 ENDIF C IPART1='MATR' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ISPMFR GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE CONDITIONING PLOT FRAME ** C *********************************************** C IPART1='COND' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLFR GOTO5160 ENDIF C IPART1='SUBS' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=ICPLFR GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE FACTOR PLOT FRAME ** C *********************************************** C IPART1='FACT' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLFR GOTO5160 ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='FRAM' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)THEN IHV=IFPLFR GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE CONDITIONING PLOT PRE-SORT ** C *********************************************** C CCCCC IPART1='COND' CCCCC IPART2='PLOT' CCCCC IPART3='PRE ' CCCCC IPART4='SORT' CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. CCCCC1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN CCCCC IHV=ICPLPS CCCCC GOTO5160 CCCCC ENDIF C CCCCC IPART1='SUBS' CCCCC IPART2='PLOT' CCCCC IPART3='PRE ' CCCCC IPART4='SORT' CCCCC IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. CCCCC1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN CCCCC IHV=ICPLPS CCCCC GOTO5160 CCCCC ENDIF C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 1999. C *********************************************** C ** STEP 20.A-- ** C ** PROBE FACTOR PLOT RESPONSE VARIABLES* C *********************************************** C IPART1='FACT' IPART2='PLOT' IPART3='RESP' IPART4='VARI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN AV=PFPLRV GOTO5170 ENDIF C IPART1='SCAT' IPART2='PLOT' IPART3='RESP' IPART4='VARI' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN AV=PFPLRV GOTO5170 ENDIF C CCCCC FOLLOWING SECTION ADDED MAY 1998. C ******************************* C ** STEP 20.A-- ** C ** PROBE CENSORING TYPE ** C ******************************* C IPART1='CENS' IPART2='TYPE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ICENTY GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED JUNE 1998. C ******************************* C ** STEP 20.A-- ** C ** PROBE MATRIX SCALE ** C ******************************* C IPART1='MATR' IPART2='SCAL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IMATSC GOTO5160 ENDIF C CCCCC FOLLOWING SECTION ADDED APRIL 1997. C ******************************* C ** STEP 20.A-- ** C ** PROBE CONTROL CHART ** C ******************************* C IPART1='CONT' IPART2='CHAR' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=ICCHPR IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C CCCCC FOLLOWING SECTION ADDED APRIL 1997. C ******************************* C ** STEP 20.A-- ** C ** PROBE NETSCAPE ** C ******************************* C IPART1='NETS' IF(IHARG(1).EQ.IPART1)IHV=INETSW IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C CCCCC THE FOLLOWING SECTION WAS ADDED APRIL 1997 C **************************************** C ** CHECK FOR PROBE DATAPLOT URL ** C **************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DATA' 1.AND.IHARG(2).EQ.'URL ')THEN DO2202I=80,1,-1 NCURL=I IF(IDPURL(I:I).NE.' ')GOTO2203 2202 CONTINUE 2203 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1816) 2216 FORMAT('THE CURRENT DATAPLOT URL FOR THE WEB HELP COMMAND = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2217)IDPURL(1:NCURL) 2217 FORMAT(A80) CALL DPWRST('XXX','BUG ') IPROBS(1:NCURL)=IDPURL(1:NCURL) NCPROB=NCURL GOTO8100 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED APRIL 1997 C **************************************** C ** CHECK FOR PROBE BROWSER ** C **************************************** C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'BROW')THEN DO2302I=80,1,-1 NCBROW=I IF(IBROWS(I:I).NE.' ')GOTO2303 2302 CONTINUE 2303 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1816) 2316 FORMAT('THE CURRENT BROWSER FOR THE WEB HELP COMMAND = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2317)IBROWS(1:NCBROW) 2317 FORMAT(A80) CALL DPWRST('XXX','BUG ') IPROBS(1:NCBROW)=IBROWS(1:NCBROW) NCPROB=NCBROW GOTO8100 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED APRIL 1997 C **************************************** C ** CHECK FOR PROBE URL ** C **************************************** C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'URL ')THEN DO2402I=80,1,-1 NCURL=I IF(IURL(I:I).NE.' ')GOTO2403 2402 CONTINUE 2403 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2416) 2416 FORMAT('THE CURRENT URL FOR THE WEB COMMAND = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2417)IURL(1:NCURL) 2417 FORMAT(A80) CALL DPWRST('XXX','BUG ') IPROBS(1:NCURL)=IURL(1:NCURL) NCPROB=NCURL GOTO8100 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED MARCH 1999 C **************************************** C ** CHECK FOR PROBE HANDBOOK URL ** C **************************************** C IF(NUMARG.GE.2.AND.IHARG(1).EQ.'HAND'.AND.IHARG(2).EQ.'URL ')THEN DO2452I=80,1,-1 NCHURL=I IF(IHBURL(I:I).NE.' ')GOTO2453 2452 CONTINUE 2453 CONTINUE IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2466) 2466 FORMAT('THE CURRENT HANDBOOK URL FOR THE WEB COMMAND = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2467)IHBURL(1:NCHURL) 2467 FORMAT(A80) CALL DPWRST('XXX','BUG ') IPROBS(1:NCHURL)=IHBURL(1:NCHURL) NCPROB=NCHURL GOTO8100 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1998 C **************************************** C ** CHECK FOR PROBE PRINTER ** C **************************************** C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PRIN')THEN IFOUND='YES' IF(IFEEDB.EQ.'OFF')GOTO9000 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2516) 2516 FORMAT('THE CURRENT PRINTER (FOR THE PP COMMAND) = ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2517)IPRNTR(1:NCPRNT) 2517 FORMAT(A40) CALL DPWRST('XXX','BUG ') IPROBS(1:NCPRNT)=IPRNTR(1:NCPRNT) NCPROB=NCPRNT GOTO8100 ENDIF C C ******************************* C ** STEP 21-- ** C ** PROBE MACHINE CONSTANTS ** C ******************************* C IPART1='IRD ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IRD IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IPR ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IPR IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='CPUM' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=CPUMIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='CPUM' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=CPUMAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='NUMB' IPART2='PC ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NUMBPC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMC' IPART2='PW ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NUMCPW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMB' IPART2='PW ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NUMBPW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IFEE' IPART2='DB ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IFEEDB IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IPRI' IPART2='NT ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IPRINT IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IECH' IPART2='O ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IECHO IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C C ************************************ C ** STEP 2-- ** C ** PROBE HOUSEKEEPING VARIABLES ** C ************************************ C CCCCC JUNE 2002. CHECK FOR OPERATING SYSTEM C IPART1='IOPS' IPART2='Y1 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)THEN IHV=IOPSY1 APROBE=0.0 IF(IHV.EQ.'UNIX')APROBE=1.0 IF(IHV.EQ.'PC-D')APROBE=2.0 IF(IHV.EQ.'VMS ')APROBE=3.0 CALL DPADDP('PROB','EVAL',APROBE,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGUG,IERROR) GOTO5160 ENDIF C CCCCC JUNE 2002. CHECK FOR COMPILER C IPART1='ICOM' IPART2='PI ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)THEN IHV=ICOMPI APROBE=0.0 IF(IHV.EQ.'f77 ')APROBE=1.0 IF(IHV.EQ.'MS-F')APROBE=2.0 IF(IHV.EQ.'LAHE')APROBE=3.0 CALL DPADDP('PROB','EVAL',APROBE,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGUG,IERROR) GOTO5160 ENDIF C IPART1='MAXW' IPART2='ID ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXWID IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IWID' IPART2='TH ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IWIDTH IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXW' IPART2='SV ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXWSV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IWID' IPART2='SV ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IWIDSV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ICOM' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=ICOM IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='ICOM' IPART2='2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=ICOM2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='MAXA' IPART2='RG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXARG IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMA' IPART2='RG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NUMARG IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXN' IPART2='AM ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXNAM IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMN' IPART2='AM ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NUMNAM IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C C .......... C IPART1='IMES' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IMESNU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='INEW' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=INEWNU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IMAI' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IMAINU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IHEL' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IHELNU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IBUG' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IBUGNU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IQUE' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IQUENU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ILOG' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=ILOGNU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IREA' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IREANU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IWRI' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IWRINU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ICRE' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=ICRENU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ISAV' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=ISAVNU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ISCR' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=ISCRNU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IDAT' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IDATNU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IPL1' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IPL1NU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IPL2' IPART2='NU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IPL2NU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C C .......... C IPART1='IMES' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IMESNA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='INEW' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=INEWNA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IMAI' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IMAINA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IHEL' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IHELNA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IBUG' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IBUGNA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IQUE' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IQUENA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='ILOG' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=ILOGNA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IREA' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IREANA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IWRI' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IWRINA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='ICRE' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=ICRENA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='ISAV' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=ISAVNA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='ISCR' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=ISCRNA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IDAT' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IDATNA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IPL1' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IPL1NA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C IPART1='IPL2' IPART2='NA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN=IPL2NA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5370 C C .......... C IPART1='IMES' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IMESST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='INEW' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=INEWST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IMAI' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IMAIST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IHEL' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IHELST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IBUG' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IBUGST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IQUE' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IQUEST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='ILOG' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=ILOGST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IREA' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IREAST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IWRI' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IWRIST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='ICRE' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=ICREST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='ISAV' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=ISAVST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='ISCR' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=ISCRST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IDAT' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IDATST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IPL1' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IPL1ST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IPL2' IPART2='ST ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ISTRIN(1:12)=IPL2ST IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5360 C IPART1='IHAR' IPART2='G ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IHARG(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IHAR' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C IPART1='IHAR' IPART2='G2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IHARG2(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IHA2' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C IPART1='IARG' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IARG(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IARG' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C IPART1='ARG ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=ARG(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='ARG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5270 C IPART1='IHNA' IPART2='ME ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IHNAME(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IHNA' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C IPART1='IHNA' IPART2='M2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IHNAM2(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IHN2' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C IPART1='IUSE' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IUSE(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IUSE' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5260 C IPART1='IVAL' IPART2='UE ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IVALUE(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IVAL' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C IPART1='IVAL' IPART2='U2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IVALU2(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IVA2' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C IPART1='VALU' IPART2='E ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=VALUE(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='VALU' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5270 C IPART1='IN ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IN(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C IPART1='IVST' IPART2='AR ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IVSTAR(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IVST' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C IPART1='IVST' IPART2='OP ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IEL=IARG(2) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IVSTOP(IEL) IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)ICASPR='IVSP' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5250 C C *************************** C ** STEP 3-- ** C ** PROBE BUG VARIABLES ** C *************************** C IPART1='IBUG' IPART2='MA ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGMA IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='LS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGLS IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='MS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGMS IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='GC ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGGC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='TY ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGTY IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='TE ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGTE IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='PC ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGPC IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='P2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGP2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='OD ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGOD IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='O2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGO2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='SU ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGSU IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='S2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGS2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='GR ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGGR IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='G2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGG2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='G3 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGG3 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='AN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGAN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='A2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGA2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='A3 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGA3 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='PL ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGPL IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='P ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGP IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='P1 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGP1 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='P3 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGP3 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='DG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGDG IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='D2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGD2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='CO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGCO IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='EV ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGEV IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='Q ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGQ IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='RE ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGRE IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='WR ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGWR IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='SO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGSO IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='TO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGTO IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='UG ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGUG IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='U2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGU2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='U3 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGU3 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='U4 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGU4 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='EX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGEX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='E2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGE2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='HE ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGHE IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='H2 ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGH2 IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IBUG' IPART2='LO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IBUGLO IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='ISUB' IPART2='RO ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=ISUBRO IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='ITRA' IPART2='NS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=ITRANS IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IFTE' IPART2='XP ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IFTEXP IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='FOUR' IPART2='IER ' IPART3='EXPO' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1IHARG(2).EQ.IPART3)IHV=IFTEXP IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1IHARG(2).EQ.IPART3)GOTO5160 C IPART1='IFTO' IPART2='RD ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IFTORD IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='FOUR' IPART2='IER ' IPART3='ORDE' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1IHARG(2).EQ.IPART3)IHV=IFTORD IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2.AND. 1IHARG(2).EQ.IPART3)GOTO5160 C IPART1='WRIT' IPART2='E ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IFORSW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IFOR' IPART2='SW ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IFORSW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='GENE' IPART2='RAL ' IPART3='JUST' IPART4='IFIC' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4)IHV=IJUSSW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4)GOTO5160 C IPART1='GENE' IPART2='RAL ' IPART3='REGI' IPART4='ON ' IPART5='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)IHV=IRFLSW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)GOTO5160 C IPART1='GENE' IPART2='RAL ' IPART3='PEN ' IPART4=' ' IPART5='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)AV=PPENSW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)GOTO5170 C IPART1='GENE' IPART2='RAL ' IPART3='PEN ' IPART4=' ' IPART5='THIC' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)IHV=IPTHSW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3.AND.IHARG2(2).EQ.IPART4 1.AND.IHARG(3).EQ.IPART5)GOTO5160 C IPART1='GENE' IPART2='RAL ' IPART3='FONT' IPART4=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3)IHV=IJUSSW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2 1.AND.IHARG(2).EQ.IPART3)GOTO5160 C C ************************************************************ C ** ADDED MAY 1988 ** C ** SET QUIC/QMS FONT OR ** C ** SET QUIC/QMS LANDSCAPE LEFT MARGIN ** C ** SET QUIC/QMS LANDSCAPE RIGHT MARGIN ** C ** SET QUIC/QMS LANDSCAPE TOP MARGIN ** C ** SET QUIC/QMS LANDSCAPE BOTTOM MARGIN ** C ** SET QUIC/QMS LANDSCAPE LEFT MARGIN ** C ** SET QUIC/QMS LANDSCAPE RIGHT MARGIN ** C ** SET QUIC/QMS LANDSCAPE TOP MARGIN ** C ** SET QUIC/QMS LANDSCAPE BOTTOM MARGIN ** C ** SET QUIC/QMS DOT ** C ************************************************************ C C *********************************** C ** CHECK FOR FONT ** C *********************************** C IPART1='QUIC' IPART2='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IV=IQUIFN IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 IPART1='QMS ' IPART2='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IV=IQUIFN IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 C C *********************************** C ** CHECK FOR MARGINS ** C *********************************** C IPART1='QUIC' IPART2='LAND' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQUILM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='LAND' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQUIRM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='LAND' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQUITM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='LAND' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQUIBM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='PORT' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQU2LM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='PORT' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQU2RM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='PORT' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQU2TM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QUIC' IPART2='PORT' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQU2BM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='LAND' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQUILM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='LAND' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQUIRM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='LAND' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQUITM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='LAND' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQUIBM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='PORT' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQU2LM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='PORT' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQU2RM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='PORT' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQU2TM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='QMS' IPART2='PORT' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IQU2BM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C C ********************************* C ** SET DOTS/INCH ** C ********************************* C IPART1='QUIC' IPART2='PPI ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)AV=QUIPPI IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 IPART1='QMS ' IPART2='PPI ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)AV=QUIPPI IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ************************************************************ C ** ADDED MAY 1988 ** C ** SET POSTSCRI FONT OR ** C ** SET POSTSCRI LANDSCAPE LEFT MARGIN ** C ** SET POSTSCRI LANDSCAPE RIGHT MARGIN ** C ** SET POSTSCRI LANDSCAPE TOP MARGIN ** C ** SET POSTSCRI LANDSCAPE BOTTOM MARGIN ** C ** SET POSTSCRI LANDSCAPE LEFT MARGIN ** C ** SET POSTSCRI LANDSCAPE RIGHT MARGIN ** C ** SET POSTSCRI LANDSCAPE TOP MARGIN ** C ** SET POSTSCRI LANDSCAPE BOTTOM MARGIN ** C ** SET POSTSCRI DOT ** C ** SET POSTSCRI SPACE ADDED OCTOBER 1991 ** C ** SET POSTSCRI HARDWARE FILL ADDED JUNE 1994 ** C ************************************************************ C C *********************************** C ** CHECK FOR FONT ** C *********************************** C IPART1='POST' IPART2='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=IPSTFN IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR MARGINS ** C *********************************** C IPART1='POST' IPART2='LAND' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IPSTLM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='LAND' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IPSTRM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='LAND' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IPSTTM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='LAND' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IPSTBM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='PORT' IPART3='LEFT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IPS2LM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='PORT' IPART3='RIGH' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IPS2RM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='PORT' IPART3='TOP ' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IPS2TM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C IPART1='POST' IPART2='PORT' IPART3='BOTT' IPART4='MARG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)IV=IPS2BM IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2 1.AND.IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)GOTO5150 C C C ********************************* C ** SET DOTS/INCH ** C ********************************* C IPART1='POST' IPART2='PPI ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)AV=PSTPPI IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ******************************************* C ** CHECK FOR POSTSCRIPT SPACE ** C ** ADDED OCTOBER 1991. ** C ******************************************* C IPART1='POST' IPART2='SPAC' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=IPSTSP IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *************************************************** C ** CHECK FOR POSTSCRIPT HARDWARE FILL ** C ** ADDED JUNE 1994. ** C *************************************************** C IPART1='POST' IPART2='HARD' IPART3='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)IHV=IPSTFS IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3)GOTO5160 C C ************************************************************ C ** ADDED SEPTEMBER 1988 ** C ** SET CALCOMP COLORS ** C ** SET CALCOMP WIDTH ** C ************************************************************ C C *********************************** C ** CHECK FOR COLORS ** C *********************************** C IPART1='CALC' IPART2='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IV=ICALCL IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 C C *********************************** C ** CHECK FOR PEN WIDTH ** C *********************************** C IPART1='CALC' IPART2='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)AV=PCALTH IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ************************************************************ C ** ADDED JULY 1996 ** C ** SET LAHEY SWITCH ** C ** SET LAHEY GRAPHICS ** C ** SET LAHEY CLOSE ** C ** SET LAHEY PAUSE ** C ** SET LAHEY WIDTH ** C ************************************************************ C C *********************************** C ** CHECK FOR SWITCH ** C *********************************** C IPART1='LAHE' IPART2='SWIT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=ILAHSW IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR GRAPHICS ** C *********************************** C IPART1='LAHE' IPART2='GRAP' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=ILAHGR IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR CLOSE ** C *********************************** C IPART1='LAHE' IPART2='CLOS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=ILAHCL IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C C *********************************** C ** CHECK FOR PAUSE ** C *********************************** C IPART1='LAHE' IPART2='PAUS' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=ILAHPA IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR PEN WIDTH ** C *********************************** C IPART1='LAHE' IPART2='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)AV=PLAHTH IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ************************************************************ C ** ADDED NOVEMBER 1996 ** C ** SET QUICK-WIN FOCUS ** C ** SET QUICK-WIN COLOR ** C ** SET QUICK-WIN FONT ** C ************************************************************ C C *********************************** C ** CHECK FOR FOCUS ** C *********************************** C IPART1='QWIN' IPART2='FOCU' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=IQWNFC IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C *********************************** C ** CHECK FOR COLOR ** C *********************************** C IPART1='QWIN' IPART2='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=IQWNCL IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C ******************************************************** C ** CHECK FOR QWIN TEXT FOREGROUND COLOR ** C ******************************************************** C IPART1='QWIN' IPART2='TEXT' IPART3='FORE' IPART4='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IV=IQWNF2 GOTO5150 ENDIF C C ******************************************************** C ** CHECK FOR QWIN TEXT BACKGROUND COLOR ** C ******************************************************** C IPART1='QWIN' IPART2='TEXT' IPART3='BACK' IPART4='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1 IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IV=IQWNBC GOTO5150 ENDIF C C *********************************** C ** CHECK FOR FONT NAME ** C *********************************** C IPART1='QWIN' IPART2='FONT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IHV=IQWNFZ IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5160 C C ************************************************************ C ** ADDED SEPTEMBER 1988 ** C ** SET ZETA COLORS ** C ** SET ZETA WIDTH ** C ************************************************************ C C *********************************** C ** CHECK FOR COLORS ** C *********************************** C IPART1='ZETA' IPART2='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)IV=IZETCL IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5150 C C *********************************** C ** CHECK FOR PEN WIDTH ** C *********************************** C IPART1='CALC' IPART2='WIDT' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)AV=PCALTH IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)GOTO5170 C C ************************************************************** C ** ADDED MARCH 2002 ** C ** PROBE SVG FONT ** C ** PROBE SVG FONT WEIGHT ** C ** PROBE SVG FONT STYLE ** C ** PROBE SVG CAP ** C ** PROBE SVG JOIN ** C ** PROBE SVG FOREGROUND COLOR ** C ** PROBE SVG HARDWARE FILL ** C ** PROBE SVG STYLE SHEET ** C ** PROBE SVG STYLE SHEET NAME ** C ************************************************************** C C *********************************** C ** CHECK FOR SVG FONT WEIGHT ** C *********************************** C IPART1='SVG ' IPART2='FONT' IPART3='WEIG' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IHV=ISVGFW GOTO5160 ENDIF C C *********************************** C ** CHECK FOR SVG FONT STYLE ** C *********************************** C IPART1='SVG ' IPART2='FONT' IPART3='STYL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IHV=ISVGST GOTO5160 ENDIF C C *********************************** C ** CHECK FOR SVG FONT NAME ** C *********************************** C IPART1='SVG ' IPART2='FONT' IPART3='NAME' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2761)IPART1,IPART2,IPART3 2761 FORMAT('THE FORTRAN COMMON CHARACTER ',A4,A4,A4, 1 ' HAS THE SETTING ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2763)ISVGFN 2763 FORMAT(A80) CALL DPWRST('XXX','BUG ') IPROBS=' ' IPROBS(1:32)=ISVGFN(1:32) NCPROB=32 GOTO8100 ENDIF C C *********************************** C ** CHECK FOR SVG CAP ** C *********************************** C IPART1='SVG ' IPART2='CAP ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ISVGCA GOTO5160 ENDIF C C *********************************** C ** CHECK FOR SVG JOIN ** C *********************************** C IPART1='SVG ' IPART3='JOIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ISVGJS GOTO5160 ENDIF C C *********************************** C ** CHECK FOR SVG FOREGROUND COLOR* C *********************************** C IPART1='SVG ' IPART2='FORE' IPART3='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IHV=ISVGFC GOTO5160 ENDIF C C *********************************** C ** CHECK FOR SVG HARDWARE FILL ** C *********************************** C IPART1='SVG ' IPART2='HARD' IPART3='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IHV=ISVGFS GOTO5160 ENDIF C C *********************************** C ** CHECK FOR SVG STYLE SHEET ** C *********************************** C IPART1='SVG ' IPART2='STYL' IPART3='SHEE' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IHV=ISVGSS GOTO5160 ENDIF C C *********************************** C ** CHECK FOR SVG STYLE SHEET NAME* C *********************************** C IPART1='SVG ' IPART2='STYL' IPART3='SHEE' IPART4='NAME' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3.AND.IHARG(4).EQ.IPART4)THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2771)IPART1,IPART2,IPART3,IPART4 2771 FORMAT('THE FORTRAN COMMON CHARACTER ',A4,A4,A4,A4, 1 ' HAS THE SETTING ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2773)ISVGSN 2773 FORMAT(A80) CALL DPWRST('XXX','BUG ') IPROBS=' ' IPROBS(1:80)=ISVGSN(1:80) NCPROB=32 GOTO8100 ENDIF C C **************************************** C ** CHECK FOR AQUATERM FONT NAME ** C **************************************** C IPART1='AQUA' IPART2='FONT' IPART3='NAME' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,22761)IPART1,IPART2,IPART3 22761 FORMAT('THE FORTRAN COMMON CHARACTER ',A4,A4,A4, 1 ' HAS THE SETTING ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2763)IAQUFN CALL DPWRST('XXX','BUG ') IPROBS=' ' IPROBS(1:32)=IAQUFN(1:32) NCPROB=32 GOTO8100 ENDIF C C *********************************** C ** CHECK FOR AQUATERM CAP ** C *********************************** C IPART1='AQUA' IPART2='CAP ' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IAQUCS(1:4) GOTO5160 ENDIF C C *********************************** C ** CHECK FOR AQUATERM JOIN ** C *********************************** C IPART1='AQUA' IPART3='JOIN' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=IAQUJS(1:4) GOTO5160 ENDIF C C **************************************** C ** CHECK FOR AQUATERM HARDWARE FILL ** C **************************************** C IPART1='AQUA' IPART2='HARD' IPART3='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IHV=IAQUFS GOTO5160 ENDIF C C **************************************** C ** CHECK FOR LATEX HARDWARE FILL ** C **************************************** C IPART1='LATE' IPART2='HARD' IPART3='FILL' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IHV=ILATFS GOTO5160 ENDIF C C **************************************** C ** CHECK FOR LATEX LINE THICKNESS ** C **************************************** C IPART1='LATE' IPART2='LINE' IPART3='THIC' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2.AND. 1IHARG(3).EQ.IPART3)THEN IHV=ILATLT GOTO5160 ENDIF C C **************************************** C ** CHECK FOR LATEX COLOR ** C **************************************** C IPART1='LATE' IPART2='COLO' IF(IHARG(1).EQ.IPART1.AND.IHARG(2).EQ.IPART2)THEN IHV=ILATCO GOTO5160 ENDIF C C CCCCC PLOT CONTROL PROBE ADDED JANUARY 2001. FOR NOW, CCCCC JUST IFX1MIN, IGX1MIN, DX1MIN, ETC. C ************************************ C ** STEP 4A-- ** C ** PROBE PLOT CONTROL VARIABLES ** C ************************************ C IPART1='FX1M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=FX1MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='FX1M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=FX1MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='FX2M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=FX2MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='FX2M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=FX2MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='FY1M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=FY1MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='FY1M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=FY1MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='FY2M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=FY2MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='FY2M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=FY2MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='GX1M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=GX1MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='GX1M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=GX1MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='GX2M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=GX2MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='GX2M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=GX2MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='GY1M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=GY1MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='GY1M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=GY1MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='GY2M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=GY2MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='GY2M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=GY2MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='DX1M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=DX1MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='DX1M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=DX1MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='DX2M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=DX2MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='DX2M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=DX2MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='DY1M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=DY1MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='DY1M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=DY1MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='DY2M' IPART2='IN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=DY2MIN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C IPART1='DY2M' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)AV=DY2MAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5170 C C **************************** C ** STEP 4-- ** C ** PROBE DATA VARIABLES ** C **************************** C IPART1='MAXN' IPART2='K ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXNK IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NK ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NK IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXC' IPART2='OL ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXCOL IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMC' IPART2='OL ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NUMCOL IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXN' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='N ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=N IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXC' IPART2='HF ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXCHF IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMC' IPART2='HF ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NUMCHF IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXF' IPART2='UN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXFUN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NUMF' IPART2='UN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NUMFUN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='MAXC' IPART2='HM ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MAXCHM IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='NPLO' IPART2='TP ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=NPLOTP IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='ILIS' IPART2='MX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=ILISMX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='LIST' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=ILISMX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='IHEL' IPART2='MX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IHELMX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='HELP' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IHELMX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C IPART1='REPL' IPART2='ACE ' IHV=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV(1:1)=IREPCH IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C IPART1='IO ' IPART2=' ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IOSW IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C CCCCC THE FOLLOWING BOX WAS ADDED MAY 1992 C **************************** C ** STEP 5-- ** C ** PROBE OTHER VARIABLES ** C **************************** C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 IPART1='IPL1' IPART2='CS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7011)IPART1,IPART2,IPL1CS 7011 FORMAT('THE FORTRAN 12-CHARACTER VARIABLE ',A4,A4, 1' HAS THE SETTING ',A12) CALL DPWRST('XXX','BUG ') IPROBS(1:12)=IPL1CS(1:12) NCPROB=12 GOTO8100 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 IPART1='IPL2' IPART2='CS ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7012)IPART1,IPART2,IPL2CS 7012 FORMAT('THE FORTRAN 12-CHARACTER VARIABLE ',A4,A4, 1' HAS THE SETTING ',A12) CALL DPWRST('XXX','BUG ') IPROBS(1:12)=IPL2CS(1:12) NCPROB=12 GOTO8100 ENDIF C C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 IPART1='IPST' IPART2='BP ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IHV=IPSTBP IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5160 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1992 IPART1='IPST' IPART2='PN ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=IPSTPN IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 IF(IHARG(1).EQ.'IMAN'.AND.IHARG2(1).EQ.'UF ')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7021)IMANUF 7021 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE IMANUF ', 1' HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IMANUF(1:4) NCPROB=4 GOTO8100 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 IF(IHARG(1).EQ.'IMOD'.AND.IHARG2(1).EQ.'EL ')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7022)IMODEL 7022 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE IMODEL ', 1' HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IMODEL(1:4) NCPROB=4 GOTO8100 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 IF(IHARG(1).EQ.'TCLO'.AND.IHARG2(1).EQ.'AD ')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7023)TCLOAD 7023 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE TCLOAD ', 1' HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 IF(IHARG(1).EQ.'TCME'.AND.IHARG2(1).EQ.'NU ')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7024)TCMENU 7024 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE TCMENU ', 1' HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 IF(IHARG(1).EQ.'TCPL'.AND.IHARG2(1).EQ.'FI ')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7025)TCPLFI 7025 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE TCPLFI ', 1' HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 IF(IHARG(1).EQ.'TCTE'.AND.IHARG2(1).EQ.'FI ')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7026)TCTEFI 7026 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE TCTEFI ', 1' HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 IF(IHARG(1).EQ.'IPLA'.AND.IHARG2(1).EQ.'TF ')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7027)IPLATF 7027 FORMAT('THE FORTRAN 10-CHARACTER VARIABLE IPLATF ', 1' HAS THE SETTING ',A10) CALL DPWRST('XXX','BUG ') IPROBS(1:10)=IPLATF(1:10) NCPROB=10 GOTO8100 ENDIF CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993 CCCCC JUNE 2002. UPDATE FOR: CCCCC IDMANU(1), IDMODE(1), IDMOD2(1), IDMOD3(1) CCCCC IDMANU(2), IDMODE(2), IDMOD2(2), IDMOD3(2) CCCCC IDMANU(3), IDMODE(3), IDMOD2(3), IDMOD3(3) CCCCC (TRUNCATE TO IDMAN(1), IDMOD(1), IDMO2(1), IDMO3(1), CCCCC ETC.) C IF(IHARG(1).EQ.'IDMA'.AND.IHARG2(1).EQ.'NU ')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO7031I=1,3 WRITE(ICOUT,7032)I,IDMANU(I) 7032 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMANU(',I1,') HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') 7031 CONTINUE IPROBS(1:4)=IDMANU(1)(1:4) NCPROB=4 GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMA'.AND.IHARG2(1).EQ.'N(1)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7042)IDMANU(1) 7042 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMANU(1) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMANU(1)(1:4) NCPROB=4 APROBE=-1.0 IF(IDMANU(1).EQ.'X11')APROBE=1.0 IF(IDMANU(1).EQ.'QWIN')APROBE=2.0 IF(IDMANU(1).EQ.'REGI')APROBE=3.0 IF(IDMANU(1).EQ.'TEKT')APROBE=4.0 IF(IDMANU(1).EQ.'OPGL')APROBE=5.0 IF(IDMANU(1).EQ.'QUAR')APROBE=6.0 IF(IDMANU(1).EQ.'MACI')APROBE=6.0 IF(IDMANU(1).EQ.'POST')APROBE=7.0 IF(IDMANU(1).EQ.'PS ')APROBE=7.0 IF(IDMANU(1).EQ.'HP')APROBE=8.0 IF(IDMANU(1).EQ.'HPGL')APROBE=8.0 IF(IDMANU(1).EQ.'GENE')APROBE=9.0 IF(IDMANU(1).EQ.'GD')APROBE=10.0 IF(IDMANU(1).EQ.'QUIC')APROBE=11.0 IF(IDMANU(1).EQ.'CALC')APROBE=12.0 IF(IDMANU(1).EQ.'ZETA')APROBE=13.0 IF(IDMANU(1).EQ.'GKS')APROBE=14.0 IF(IDMANU(1).EQ.'LAHE')APROBE=15.0 IF(IDMANU(1).EQ.'PRIN')APROBE=16.0 IF(IDMANU(1).EQ.'LATE')APROBE=17.0 IF(IDMANU(1).EQ.'SVG')APROBE=18.0 IF(IDMANU(1).EQ.'DISC')APROBE=19.0 CALL DPADDP('PROB','EVAL',APROBE,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGUG,IERROR) GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMA'.AND.IHARG2(1).EQ.'N(2)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7044)IDMANU(2) 7044 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMANU(2) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMANU(2)(1:4) NCPROB=4 APROBE=-1.0 IF(IDMANU(2).EQ.'X11')APROBE=1.0 IF(IDMANU(2).EQ.'QWIN')APROBE=2.0 IF(IDMANU(2).EQ.'REGI')APROBE=3.0 IF(IDMANU(2).EQ.'TEKT')APROBE=4.0 IF(IDMANU(2).EQ.'OPGL')APROBE=5.0 IF(IDMANU(2).EQ.'QUAR')APROBE=6.0 IF(IDMANU(2).EQ.'MACI')APROBE=6.0 IF(IDMANU(2).EQ.'POST')APROBE=7.0 IF(IDMANU(2).EQ.'PS ')APROBE=7.0 IF(IDMANU(2).EQ.'HP')APROBE=8.0 IF(IDMANU(2).EQ.'GENE')APROBE=9.0 IF(IDMANU(2).EQ.'GD')APROBE=10.0 IF(IDMANU(2).EQ.'QUIC')APROBE=11.0 IF(IDMANU(2).EQ.'CALC')APROBE=12.0 IF(IDMANU(2).EQ.'ZETA')APROBE=13.0 IF(IDMANU(2).EQ.'GKS')APROBE=14.0 IF(IDMANU(2).EQ.'LAHE')APROBE=15.0 IF(IDMANU(2).EQ.'PRIN')APROBE=16.0 IF(IDMANU(2).EQ.'LATE')APROBE=17.0 IF(IDMANU(2).EQ.'SVG')APROBE=18.0 IF(IDMANU(2).EQ.'DISC')APROBE=19.0 CALL DPADDP('PROB','EVAL',APROBE,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGUG,IERROR) GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMA'.AND.IHARG2(1).EQ.'N(3)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7046)IDMANU(3) 7046 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMANU(3) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMANU(3)(1:4) NCPROB=4 APROBE=-1.0 IF(IDMANU(3).EQ.'X11')APROBE=1.0 IF(IDMANU(3).EQ.'QWIN')APROBE=2.0 IF(IDMANU(3).EQ.'REGI')APROBE=3.0 IF(IDMANU(3).EQ.'TEKT')APROBE=4.0 IF(IDMANU(3).EQ.'OPGL')APROBE=5.0 IF(IDMANU(3).EQ.'QUAR')APROBE=6.0 IF(IDMANU(3).EQ.'MACI')APROBE=6.0 IF(IDMANU(3).EQ.'POST')APROBE=7.0 IF(IDMANU(3).EQ.'PS ')APROBE=7.0 IF(IDMANU(3).EQ.'HP')APROBE=8.0 IF(IDMANU(3).EQ.'GENE')APROBE=9.0 IF(IDMANU(3).EQ.'GD')APROBE=10.0 IF(IDMANU(3).EQ.'QUIC')APROBE=11.0 IF(IDMANU(3).EQ.'CALC')APROBE=12.0 IF(IDMANU(3).EQ.'ZETA')APROBE=13.0 IF(IDMANU(3).EQ.'GKS')APROBE=14.0 IF(IDMANU(3).EQ.'LAHE')APROBE=15.0 IF(IDMANU(3).EQ.'PRIN')APROBE=16.0 IF(IDMANU(3).EQ.'LATE')APROBE=17.0 IF(IDMANU(3).EQ.'SVG')APROBE=18.0 IF(IDMANU(3).EQ.'DISC')APROBE=19.0 CALL DPADDP('PROB','EVAL',APROBE,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGUG,IERROR) GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMO'.AND.IHARG2(1).EQ.'D(1)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7052)IDMODE(1) 7052 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMODE(1) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMODE(1)(1:4) NCPROB=4 GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMO'.AND.IHARG2(1).EQ.'D(2)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7054)IDMODE(2) 7054 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMODE(2) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMODE(2)(1:4) NCPROB=4 GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMO'.AND.IHARG2(1).EQ.'D(3)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7056)IDMODE(3) 7056 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMODE(3) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMODE(3)(1:4) NCPROB=4 GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMO'.AND.IHARG2(1).EQ.'2(1)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7062)IDMOD2(1) 7062 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMOD2(1) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMOD2(1)(1:4) NCPROB=4 GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMO'.AND.IHARG2(1).EQ.'2(2)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7064)IDMOD2(2) 7064 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMOD2(2) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMOD2(2)(1:4) NCPROB=4 GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMO'.AND.IHARG2(1).EQ.'2(3)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7066)IDMOD2(3) 7066 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMOD2(3) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMOD2(3)(1:4) NCPROB=4 GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMO'.AND.IHARG2(1).EQ.'3(1)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7072)IDMOD3(1) 7072 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMOD3(1) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMOD3(1)(1:4) NCPROB=4 GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMO'.AND.IHARG2(1).EQ.'3(2)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7074)IDMOD3(2) 7074 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMOD3(2) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMOD3(2)(1:4) NCPROB=4 GOTO8100 ENDIF C IF(IHARG(1).EQ.'IDMO'.AND.IHARG2(1).EQ.'3(3)')THEN IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7076)IDMOD3(3) 7076 FORMAT('THE FORTRAN 4-CHARACTER VARIABLE ', 1' IDMOD3(3) HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IDMOD3(3)(1:4) NCPROB=4 GOTO8100 ENDIF C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1993 IPART1='MINM' IPART2='AX ' IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)IV=MINMAX IF(IHARG(1).EQ.IPART1.AND.IHARG2(1).EQ.IPART2)GOTO5150 C CCCCC THE FOLLOWING BOX WAS ADDED MAY 1992 C **************************** C ** STEP 6-- ** C ** WRITE OUT VALUES ** C **************************** C C 5130 CONTINUE IERROR='YES' WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5131) 5131 FORMAT('***** ERROR IN DPPROB--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5132) 5132 FORMAT(' THE SPECIFIED FORTRAN COMMON VARIABLE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5133) 5133 FORMAT(' IN THE PROBE COMMAND WAS NOT FOUND.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5134)IHARG(1),IHARG2(1) 5134 FORMAT(' THE SPECIFIED FORTRAN COMMON VARIABLE WAS ', 1A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5135) 5135 FORMAT(' ILLUSTRATIVE EXAMPLE TO DEMONSTRATE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5136) 5136 FORMAT(' THE PROPER FORM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5137) 5137 FORMAT(' SUPPOSE THE ANALYST WISHES TO DUMP OUT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5138) 5138 FORMAT(' THE CURRENT VALUE OF THE FORTRAN COMMON ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5139) 5139 FORMAT(' VARIABLE MAXCOL ,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5140) 5140 FORMAT(' THIS MAY BE DONE BY ENTERING') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5141) 5141 FORMAT(' PROBE MAXCOL') CALL DPWRST('XXX','BUG ') GOTO9000 C 5150 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5151)IPART1,IPART2,IV 5151 FORMAT('THE FORTRAN COMMON SCALAR ',A4,A4, 1' HAS THE VALUE ',I8) CALL DPWRST('XXX','BUG ') APROBE=REAL(IV+0.5) GOTO8000 C 5160 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5161)IPART1,IPART2,IHV 5161 FORMAT('THE FORTRAN COMMON CHARACTER ',A4,A4, 1' HAS THE SETTING ',A4,2X,A4) CALL DPWRST('XXX','BUG ') IPROBS=' ' IPROBS(1:4)=IHV(1:4) NCPROB=4 GOTO8100 C 5170 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5171)IPART1,IPART2,AV 5171 FORMAT('THE FORTRAN COMMON SCALAR ',A4,A4, 1' HAS THE VALUE ',E15.7) CALL DPWRST('XXX','BUG ') APROBE=AV GOTO8000 C 5250 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5251)IEL,IPART1,IPART2,IV 5251 FORMAT('ELEMENT ',I8,' OF THE FORTRAN COMMON VARIABLE ',A4,A4, 1' HAS THE VALUE ',I8) CALL DPWRST('XXX','BUG ') APROBE=REAL(IV+0.5) GOTO8000 C 5260 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5261)IEL,IPART1,IPART2,IHV 5261 FORMAT('ELEMENT ',I8,' OF THE FORTRAN COMMON VARIABLE ',A4,A4, 1' HAS THE SETTING ',A4) CALL DPWRST('XXX','BUG ') IPROBS(1:4)=IHV(1:4) NCPROB=4 GOTO8100 C 5270 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5271)IEL,IPART1,IPART2,AV 5271 FORMAT('ELEMENT ',I8,' OF THE FORTRAN COMMON VARIABLE ',A4,A4, 1' HAS THE VALUE ',E15.7) CALL DPWRST('XXX','BUG ') APROBE=AV GOTO8000 C 5360 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5361)IPART1,IPART2,ISTRIN(1:12) 5361 FORMAT('THE FORTRAN COMMON CHARACTER VARIABLE ',A4,A4, 1' HAS THE SETTING ',A12) CALL DPWRST('XXX','BUG ') IPROBS(1:12)=ISTRIN(1:12) NCPROB=12 GOTO8100 C 5370 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5371)IPART1,IPART2,ISTRIN 5371 FORMAT('THE FORTRAN COMMON CHAR. VAR. ',A4,A4, 1' = ',A80) CALL DPWRST('XXX','BUG ') IPROBS(1:80)=ISTRIN(1:80) NCPROB=80 GOTO8100 C 5410 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5411)NUMNAM 5411 FORMAT('NUMNAM = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5412) 5412 FORMAT('I,IHNAME(I),IHNAME2(I),IUSE(I),IN(I),', 1'IVALUE(I),IVALU2(I),VALUE(I)') CALL DPWRST('XXX','BUG ') DO5413I=1,NUMNAM WRITE(ICOUT,5414)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I), 1IVALUE(I),IVALU2(I),VALUE(I) 5414 FORMAT(I8,2X,A4,2X,A4,2X,A4,I8,I8,I8,E15.7) CALL DPWRST('XXX','BUG ') 5413 CONTINUE GOTO9000 C C ******************** C ** STEP 80-- ** C ** UPDATE APROBE ** C ******************** C 8000 CONTINUE CALL DPADDP('PROB','EVAL',APROBE,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGUG,IERROR) GOTO9000 C C ******************** C ** STEP 81-- ** C ** UPDATE IPROBS ** C ******************** C 8100 CONTINUE NJUNK=NCPROB DO8110J=NJUNK,1,-1 NCPROB=J IF(IPROBS(J:J).NE.' ')GOTO8112 8110 CONTINUE 8112 CONTINUE C DO5110I=1,NCPROB IFUNC3(I)(1:4)=' ' IFUNC3(I)(1:1)=IPROBS(I:I) 5110 CONTINUE CALL UPDATF('PROB','ESTR',IFUNC3,NCPROB,'CHAD','NO ', 1 IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP, 1 NUMNAM,MAXNAM,IANS,IWIDTH,ILISTL,NEWNAM,MAXN3, 1 IFUNC,NUMCHF,MAXCHF,IBUGUG,ILOCN,IFOUND,IERROR) C CCCCC JUNE 2002. IF PROBS IS OR , THEN CCCCC SET APROBE TO 1/0. C IF(IPROBS(1:3).EQ.'OFF' .OR. IPROBS(1:6).EQ.'CLOSED' .OR. 1 IPROBS(1:2).EQ.'NO')THEN APROBE=0.0 CALL DPADDP('PROB','EVAL',APROBE,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGUG,IERROR) ELSEIF(IPROBS(1:2).EQ.'ON' .OR. IPROBS(1:4).EQ.'OPEN' .OR. 1 IPROBS(1:3).EQ.'YES')THEN APROBE=1.0 CALL DPADDP('PROB','EVAL',APROBE,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGUG,IERROR) ENDIF GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE RETURN END SUBROUTINE INITPC(IBUGIN) C C PURPOSE--THIS IS SUBROUTING INITPC. C (THE PC AT THE END OF INITPC STANDS FOR PLOT CO C THIS SUBROUTINE INITIALIZES PLOT CONTROL VARIABLES AND PARAMETERS C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82.6 C ORIGINAL VERSION--SEPTEMBER 1980. C UPDATED --MARCH 1981. C UPDATED --APRIL 1981. C UPDATED --JUNE 1981. C UPDATED --AUGUST 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --OCTOBER 1981. C UPDATED --NOVEMBER 1981. C UPDATED --MAY 1982. C UPDATED --DECEMBER 1987. FINAL CURSOR POS. FOR TEK TO QMS (ALAN) C UPDATED --SEPTEMBER 1988. (MOVE 3-D EYE, ETC. TO INIT3D) C UPDATED --JANUARY 1989. (NON-SOLID REGION FILL INFINITE LOOP) C UPDATED --FEBRUARY 1989. Z AXIS (FOR 3-D) SETTINGS C UPDATED --FEBRUARY 1989. SOFT-CODING (ALAN) C UPDATED --APRIL 1989. SOFT-CODED BACKSLASH FOR UNIX C UPDATED --APRIL 1989. ANIMATION SWITCH C UPDATED --APRIL 1989. BOX COLOR FROM BLUE TO WHITE C UPDATED --JULY 1989. CHANGE Y & ZLABEL DISPLACEMENT C UPDATED --AUGUST 1990. WINDOW MANAGER C UPDATED --AUGUST 1990. MENU SELECTOR C UPDATED --JUNE 1992. DEFAULT BACKGROUND TO WHITE C UPDATED --AUGUST 1992. BOX SHADOW HEIGHT & WIDTH C UPDATED --AUGUST 1992. BOX DEFAULTS C UPDATED --OCTOBER 1992. ADD CHARACTER STATEMENTS C UPDATED --OCTOBER 1993. ADD REGION BASE INTERPOLATE C UPDATED --MARCH 1994. ADD REGION BASE POLYGON C UPDATED --DECEMBER 1994. EXACT CHARACTER MAPPING C UPDATED --NOVEMBER 1997. NEW SETTINGS C UPDATED --FEBRUARY 1998. ILINPO, ICHAPO C UPDATED --SEPTEMBER 1998. AMPSCH, AMPSCW C UPDATED --OCTOBER 1999. I..LJU, P..LOF C UPDATED --NOVEMBER 1999. I..LDI, P..LAN C UPDATED --NOVEMBER 1999. SUBREGIONS C UPDATED --DECEMBER 1999. LEGEND UNITS C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGIN C CHARACTER*4 IDEFGC C CCCCC THE FOLLOWING 4 LINES WERE ADDED OCTOBER 1992 C CHARACTER*4 IDEFWM CHARACTER*4 IWINMA CHARACTER*4 IDEFMS CHARACTER*4 IMENSE C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOMC.INC' INCLUDE 'DPCOPC.INC' INCLUDE 'DPCODG.INC' INCLUDE 'DPCOST.INC' CCCCC THE FOLLOWING LINE WAS INSERTED APRIL 1989 INCLUDE 'DPCONP.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGIN.EQ.'OFF')GOTO99 WRITE(ICOUT,90) 90 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,95) 95 FORMAT('***** AT THE BEGINNING OF INITPC--') CALL DPWRST('XXX','BUG ') 99 CONTINUE C C *********************** C ** DEFINE DEFAULTS ** C *********************** C C THE FOLLOWING CHANGE WAS MADE AT THE SUGGESTION C OF MIKE STOLNICKI C CCCCC IDEFGC='RED' CCCCC AUGUST 1992. DEFAULT BACKGROUND IS WHITE, SET TO BLACK CCCCC IDEFGC='WHIT' IDEFGC='BLAC' C IDEFPA='SOLI' IDEFFO='TEKT' IDEFCA='UPPE' IDEFJU='LEFT' IDEFDI='HORI' IDEFAU='RADI' IDEFFI='OFF' IDEFCO=IDEFGC CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1994 CCCCC IDCMAP = DEFAULT CHARACTER MAPPING DECEMBER 1994 IDCMAP='RANK' CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1999 IDEFUZ='SCRE' C IDEFDP=(-1) C PDEFHE=2.0 CCCCC PDEFWI=1.5 PDEFWI=1.0 CCCCC PDEFVG=1.0 PDEFVG=0.75 CCCCC PDEFHG=0.75 PDEFHG=0.25 ADEFAN=0.0 PDEFTH=0.1 PDEFLE=1.0 C FEBRUARY, 1988: INITIALIZE CHARACTER OFFSET PDEFOF=0.0 C CCCCC PDEFDS=3.5 PDEFDS=3.0 C CCCCC THE FOLLOWING LINE WAS FIXED TO CURE INVISIBLE TEK 4115 BOXES APRIL 1989 CCCCC IDEFXC='BLUE' CCCCC AUGUST 1992. DEFAULT BACKGROUND IS WHITE, SET TO BLACK CCCCC IDEFXC='WHIT' IDEFXC='BLAC' PDEFGA=1.0 CCCCC TEKTRONIX CHARACTER CUTOFFS ARE 2.75 2.2 1.65 C PDEFL2=1.0 PDEFL3=1.0 PDEFGA=1.0 PDEFG2=1.0 PDEFG3=1.0 C IDEFCR='ON' IDEFLF='ON' CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989 IDEFSY=IBASLC IDEFSP='PROP' PDEFMR=50.0 C CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1992 CCCCC FOR BOX SHADOW HEIGHT & WIDTH AUGUST 1992 PDEFSH=0.8 PDEFSW=0.6 C C **************************** C ** TREAT THE ARROW CASE ** C **************************** C C MAXARR=100 MAXARR=MAXAR NUMARR=0 C DO100I=1,MAXARR IARRPA(I)=IDEFPA IARRCO(I)=IDEFCO IARHFI(I)=IDEFFI PARRTH(I)=PDEFTH PARHLE(I)=PDEFWI PARHWI(I)=PDEFWI 100 CONTINUE C DO200I=1,MAXARR PARRXC(I,1)=CPUMIN PARRXC(I,2)=CPUMIN PARRYC(I,1)=CPUMIN PARRYC(I,2)=CPUMIN 200 CONTINUE C C *************************************************** C ** TREAT THE BACKGROUND AND MARGIN COLORS CASE ** C *************************************************** C CCCCC THE FOLLOWING LINE WAS FIXED JUNE 1992 (JJF) CCCCC TO ACCOMODATE TURBO C FRONT END WHITE BACKGROUND JUNE 1992 (JJF) CCCCC IDEFBK='BLUE' IDEFBK='WHIT' IBACCO=IDEFBK C CCCCC AUGUST 1992. MAKE MARGIN SAME COLOR AS BACKGROUND CCCCC IDEFMC='BLUE' CCCCC IDEFMC='BLUE' IDEFMC='WHIT' IMARCO=IDEFMC C CCCCC THE FOLLOWING ANIMATION CHUNCK WAS ADDED APRIL 1989 C ************************************************** C ** TREAT THE ANIMATION SWITCH CASE ** C ************************************************** C IANISW='OFF' C C ************************** C ** TREAT THE BOX CASE ** C ************************** C C MAXBOX=100 MAXBOX=MAXBX NUMBOX=0 C DO500I=1,MAXBOX IBOBFI(I)=IDEFFI IBOBCO(I)=IDEFCO IBOPPA(I)=IDEFPA CCCCC AUGUST 1992. FOLLOWING LINE MODIFIED CCCCC IBOPCO(I)=IDEFCO IBOBPA(I)=IDEFPA CCCCC AUGUST 1992. FOLLOWING LINE MODIFIED CCCCC IBOFPA(I)=IDEFPA IBOFPA(I)=IDEFFI IBOFCO(I)=IDEFXC PBOPTH(I)=PDEFTH PBOPGA(I)=PDEFGA PBOFTH(I)=PDEFTH CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1992 CCCCC FOR BOX SHADOW HEIGHT & WIDTH AUGUST 1992 PBOSHE(I)=PDEFSH PBOSWI(I)=PDEFSW 500 CONTINUE C DO600I=1,MAXBOX PBOXXC(I,1)=CPUMIN PBOXXC(I,2)=CPUMIN PBOXYC(I,1)=CPUMIN PBOXYC(I,2)=CPUMIN 600 CONTINUE C C ********************************* C ** TREAT THE CHARACTERS CASE ** C ********************************* C C MAXCHA=100 MAXCHA=MAXCH2 CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1994 CCCCC ICHMAP = CHARACTER MAPPING DECEMBER 1994 ICHMAP=IDCMAP C DO700I=1,MAXCHA ICHAPA(I)=' ' CCCCC ADD FOLLOWING LINE FEBRUARY 1998. ICHAPO(I)=' ' ICHAFO(I)=IDEFFO ICHACA(I)=IDEFCA ICHAJU(I)='CECE' ICHADI(I)=IDEFDI ICHAFI(I)=IDEFFI ICHACO(I)=IDEFCO PCHAHE(I)=PDEFHE PCHAWI(I)=PDEFWI PCHAVG(I)=PDEFVG PCHAHG(I)=PDEFHG PCHATH(I)=PDEFTH ACHAAN(I)=ADEFAN PCHAHO(I)=PDEFOF PCHAVO(I)=PDEFOF 700 CONTINUE C C ********************************* C ** TREAT THE CROSS-HAIR CASE ** C ********************************* C C **************************** C ** TREAT THE FRAME CASE ** C **************************** C IX1FSW='ON' IX2FSW='ON' IY1FSW='ON' IY2FSW='ON' C IX1FPA=IDEFPA IX2FPA=IDEFPA IY1FPA=IDEFPA IY2FPA=IDEFPA C IX1FCO=IDEFCO IX2FCO=IDEFCO IY1FCO=IDEFCO IY2FCO=IDEFCO C PFRATH=PDEFTH C C ***************************** C ** TREAT THE LIMITS CASE ** C ***************************** C PXMIN=15.0 PYMIN=20.0 PXMAX=85.0 PYMAX=90.0 C PWXMIN=0.0 PWYMIN=0.0 PWXMAX=100.0 PWYMAX=100.0 C IX1MIN='FLOA' IX1MAX='FLOA' IY1MIN='FLOA' IY1MAX='FLOA' IZ1MIN='FLOA' IZ1MAX='FLOA' C IX2MIN='FLOA' IX2MAX='FLOA' IY2MIN='FLOA' IY2MAX='FLOA' IZ2MIN='FLOA' IZ2MAX='FLOA' C PDXMIN=CPUMIN PDXMAX=CPUMAX PDYMIN=CPUMIN PDYMAX=CPUMAX PDZMIN=CPUMIN PDZMAX=CPUMAX C PGXMIN=CPUMIN PGXMAX=CPUMAX PGYMIN=CPUMIN PGYMAX=CPUMAX PGZMIN=CPUMIN PGZMAX=CPUMAX C GX1MIN=CPUMIN GX1MAX=CPUMAX GY1MIN=CPUMIN GY1MAX=CPUMAX GZ1MIN=CPUMIN GZ1MAX=CPUMAX C GX2MIN=CPUMIN GX2MAX=CPUMAX GY2MIN=CPUMIN GY2MAX=CPUMAX GZ2MIN=CPUMIN GZ2MAX=CPUMAX C DX1MIN=CPUMIN DX1MAX=CPUMAX DY1MIN=CPUMIN DY1MAX=CPUMAX DZ1MIN=CPUMIN DZ1MAX=CPUMAX C DX2MIN=CPUMIN DX2MAX=CPUMAX DY2MIN=CPUMIN DY2MAX=CPUMAX DZ2MIN=CPUMIN DZ2MAX=CPUMAX C FX1MIN=CPUMIN FX1MAX=CPUMAX FY1MIN=CPUMIN FY1MAX=CPUMAX FZ1MIN=CPUMIN FZ1MAX=CPUMAX C FX2MIN=CPUMIN FX2MAX=CPUMAX FY2MIN=CPUMIN FY2MAX=CPUMAX FZ2MIN=CPUMIN FZ2MAX=CPUMAX C CCCCC NOVEMBER 1997. ADD FOLLOWING LINE FX1MNZ=CPUMIN FX1MXZ=CPUMAX FY1MNZ=CPUMIN FY1MXZ=CPUMAX FX2MNZ=CPUMIN FX2MXZ=CPUMAX FY2MNZ=CPUMIN FY2MXZ=CPUMAX C C *************************** C ** TREAT THE GRID CASE ** C *************************** C IVGRSW='OFF' IHGRSW='OFF' C C TH FOLLOWING CHANGES WERE MADE AT THE SUGGESTION C OF MIKE STOLNICKI C CCCCC IVGRPA=IDEFPA IVGRPA='DOT' CCCCC IHGRPA=IDEFPA IHGRPA='DOT' C IVGRCO=IDEFCO IHGRCO=IDEFCO C PVGRTH=PDEFTH PHGRTH=PDEFTH C C **************************** C ** TREAT THE LABEL CASE ** C **************************** C C DO1710J=1,130 DO1710J=1,MAXCH IX1LTE(I)=' ' IX2LTE(I)=' ' IX3LTE(I)=' ' IY1LTE(I)=' ' IY2LTE(I)=' ' IZ1LTE(I)=' ' IZ2LTE(I)=' ' 1710 CONTINUE C NCX1LA=0 IX1LFO=IDEFFO IX1LCA=IDEFCA IX1LFI=IDEFFI IX1LCO=IDEFCO IX1LJU='CEBO' IX1LDI='HORI' PX1LHE=PDEFHE PX1LWI=PDEFWI PX1LVG=PDEFVG PX1LHG=PDEFHG PX1LTH=PDEFTH CCCCC PX1LDS=2.0*PDEFDS PX1LDS=2.0+2.0*PDEFDS PX1LOF=0.0 PX1LAN=0.0 C NCX2LA=0 IX2LFO=IDEFFO IX2LCA=IDEFCA IX2LFI=IDEFFI IX2LCO=IDEFCO IX2LJU='CEBO' IX2LDI='HORI' PX2LHE=PDEFHE PX2LWI=PDEFWI PX2LVG=PDEFVG PX2LHG=PDEFHG PX2LTH=PDEFTH CCCCC PX2LDS=3.0*PDEFDS PX2LDS=2.0+3.0*PDEFDS PX2LOF=0.0 PX2LAN=0.0 C NCX3LA=0 IX3LFO=IDEFFO IX3LCA=IDEFCA IX3LFI=IDEFFI IX3LCO=IDEFCO IX3LJU='CEBO' IX3LDI='HORI' PX3LHE=PDEFHE PX3LWI=PDEFWI PX3LVG=PDEFVG PX3LHG=PDEFHG PX3LTH=PDEFTH CCCCC PX3LDS=4.0*PDEFDS PX3LDS=2.0+4.0*PDEFDS PX3LOF=0.0 PX3LAN=0.0 C NCY1LA=0 IY1LFO=IDEFFO IY1LCA=IDEFCA IY1LFI=IDEFFI IY1LCO=IDEFCO IY1LJU='CECE' IY1LDI='VERT' PY1LHE=PDEFHE PY1LWI=PDEFWI PY1LVG=PDEFVG PY1LHG=PDEFHG PY1LTH=PDEFTH CCCCC PY1LDS=3.5*PDEFDS CCCCC THE FOLLOWING LINE WAS FIXED JULY 1989 CCCCC PY1LDS=2.0+3.0*PDEFDS PY1LDS=2.0+2.0*PDEFDS PY1LOF=0.0 PY1LAN=90.0 C NCY2LA=0 IY2LFO=IDEFFO IY2LCA=IDEFCA IY2LFI=IDEFFI IY2LCO=IDEFCO IY2LJU='CECE' IY2LDI='VERT' PY2LHE=PDEFHE PY2LWI=PDEFWI PY2LVG=PDEFVG PY2LHG=PDEFHG PY2LTH=PDEFTH CCCCC PY2LDS=3.5*PDEFDS CCCCC THE FOLLOWING LINE WAS FIXED JULY 1989 CCCCC PY2LDS=2.0+3.0*PDEFDS PY2LDS=2.0+2.0*PDEFDS PY2LOF=0.0 PY2LAN=90.0 C NCZ1LA=0 IZ1LFO=IDEFFO IZ1LCA=IDEFCA IZ1LFI=IDEFFI IZ1LCO=IDEFCO IZ1LJU='CENT' IZ1LDI='HORI' PZ1LHE=PDEFHE PZ1LWI=PDEFWI PZ1LVG=PDEFVG PZ1LHG=PDEFHG PZ1LTH=PDEFTH CCCCC PZ1LDS=3.5*PDEFDS CCCCC THE FOLLOWING LINE WAS FIXED JULY 1989 CCCCC PZ1LDS=2.0+3.0*PDEFDS PZ1LDS=2.0+2.0*PDEFDS PZ1LOF=0.0 PZ1LAN=0.0 C NCZ2LA=0 IZ2LFO=IDEFFO IZ2LCA=IDEFCA IZ2LFI=IDEFFI IZ2LCO=IDEFCO IZ2LJU='CENT' IZ2LDI='HORI' PZ2LHE=PDEFHE PZ2LWI=PDEFWI PZ2LVG=PDEFVG PZ2LHG=PDEFHG PZ2LTH=PDEFTH CCCCC PZ2LDS=3.5*PDEFDS CCCCC THE FOLLOWING LINE WAS FIXED JULY 1989 CCCCC PZ2LDS=2.0+3.0*PDEFDS PZ2LDS=2.0+2.0*PDEFDS PZ2LOF=0.0 PZ2LAN=0.0 C C ***************************** C ** TREAT THE LEGEND CASE ** C ***************************** C C MAXLEG=100 MAXLEG=MAXLG NUMLEG=0 C DO2000I=1,MAXLEG ILEGNA(I)=' ' ILEGST(I)=0 ILEGSP(I)=0 ILEGFO(I)=IDEFFO ILEGCA(I)=IDEFCA ILEGJU(I)=IDEFJU ILEGDI(I)=IDEFDI ILEGFI(I)=IDEFFI ILEGCO(I)=IDEFCO PLEGHE(I)=PDEFHE PLEGWI(I)=PDEFWI PLEGVG(I)=PDEFVG PLEGHG(I)=PDEFHG PLEGTH(I)=PDEFTH ALEGAN(I)=ADEFAN ILEGUN(I)=IDEFUZ PLEGXC(I)=20.0 AI=I PLEGYC(I)=84.0-(AI-1.0)*4.0 2000 CONTINUE C C MXCLEG=1000 MXCLEG=MAXLG2 NCLEG=0 C DO2010I=1,MXCLEG ILEGTE(I)=' ' 2010 CONTINUE C C ********************************* C ** TREAT THE LINES CASE ** C ********************************* C C MAXLIN=100 MAXLIN=MAXLN C DO2500I=1,MAXLIN ILINPA(I)=IDEFPA CCCCC ADD FOLLOWING LINE FEBRUARY 1998. ILINPO(I)=IDEFPA ILINCO(I)=IDEFCO PLINTH(I)=PDEFTH PLINLE(I)=PDEFLE PLINL2(I)=PDEFL2 PLINL3(I)=PDEFL3 PLINGA(I)=PDEFGA PLING2(I)=PDEFG2 PLING3(I)=PDEFG3 2500 CONTINUE C C *********************************************** C ** TREAT THE ...SCALE (LINEAR OR LOG) CASE ** C *********************************************** C IX1TSW='LINE' IX2TSW='LINE' IY1TSW='LINE' IY2TSW='LINE' IZ1TSW='LINE' IZ1TSW='LINE' C C ******************************* C ** TREAT THE PRE-SORT CASE ** C ******************************* C ISORSW='ON' C C **************************** C ** TREAT THE SEGMENT CASE ** C **************************** C C MAXSEG=100 MAXSEG=MAXSG NUMSEG=0 C DO3800I=1,MAXSEG ISEGPA(I)=IDEFPA ISEGCO(I)=IDEFCO PSEGTH(I)=PDEFTH 3800 CONTINUE C DO3900I=1,MAXSEG PSEGXC(I,1)=CPUMIN PSEGXC(I,2)=CPUMIN PSEGYC(I,1)=CPUMIN PSEGYC(I,2)=CPUMIN 3900 CONTINUE C C ***************************** C ** TREAT THE ...TIC CASE ** C ***************************** C IX1TSW='ON' IX2TSW='OFF' IY1TSW='ON' IY2TSW='OFF' IZ1TSW='ON' IZ2TSW='OFF' C IX1JSW='FLOA' IX2JSW='FLOA' IY1JSW='FLOA' IY2JSW='FLOA' IZ1JSW='FLOA' IZ2JSW='FLOA' C IX1NSW='FLOA' IX2NSW='FLOA' IY1NSW='FLOA' IY2NSW='FLOA' IZ1NSW='FLOA' IZ2NSW='FLOA' C IX1TSC='LINE' IX2TSC='LINE' IY1TSC='LINE' IY2TSC='LINE' IZ1TSC='LINE' IZ2TSC='LINE' C IX1TJU='OUT' IX2TJU='OUT' IY1TJU='OUT' IY2TJU='OUT' IZ1TJU='OUT' IZ2TJU='OUT' C IX1TCO=IDEFCO IX2TCO=IDEFCO IY1TCO=IDEFCO IY2TCO=IDEFCO IZ1TCO=IDEFCO IZ2TCO=IDEFCO C NMJX1T=(-1) NMJX2T=(-1) NMJY1T=(-1) NMJY2T=(-1) NMJZ1T=(-1) NMJZ2T=(-1) C NMNX1T=(-1) NMNX2T=(-1) NMNY1T=(-1) NMNY2T=(-1) NMNZ1T=(-1) NMNZ2T=(-1) C NX1COO=(-1) NX2COO=(-1) NY1COO=(-1) NY2COO=(-1) NZ1COO=(-1) NZ2COO=(-1) C NX1CMN=(-1) NX2CMN=(-1) NY1CMN=(-1) NY2CMN=(-1) NZ1CMN=(-1) NZ2CMN=(-1) C PX1TLE=2.0 PX2TLE=2.0 PY1TLE=2.0 PY2TLE=2.0 PZ1TLE=2.0 PZ2TLE=2.0 PTICTH=0.1 PMNTFA=0.5 C C MAXTIC=100 MAXTIC=MAXTC DO4310I=1,MAXTIC PX1COO(I)=CPUMIN PX2COO(I)=CPUMIN PY1COO(I)=CPUMIN PY2COO(I)=CPUMIN PZ1COO(I)=CPUMIN PZ2COO(I)=CPUMIN PX1CMN(I)=CPUMIN PX2CMN(I)=CPUMIN PY1CMN(I)=CPUMIN PY2CMN(I)=CPUMIN PZ1CMN(I)=CPUMIN PZ2CMN(I)=CPUMIN 4310 CONTINUE C FOLLOWING TIC OFFSET VARIABLES ADDED MAY, 1990. DEFTOF=0. IDEFTU='DATA' C ITICUN=IDEFTU PX1TOL=DEFTOF PX2TOL=DEFTOF PY1TOB=DEFTOF PY2TOB=DEFTOF PX1TOR=DEFTOF PX2TOR=DEFTOF PY1TOT=DEFTOF PY2TOT=DEFTOF C END CHANGES C C ********************************* C ** TREAT THE TIC LABELS CASE ** C ********************************* C IX1ZSW='ON' IX2ZSW='OFF' IY1ZSW='ON' IY2ZSW='OFF' IZ1ZSW='ON' IZ2ZSW='OFF' C IX1ZFO=IDEFFO IX2ZFO=IDEFFO IY1ZFO=IDEFFO IY2ZFO=IDEFFO IZ1ZFO=IDEFFO IZ2ZFO=IDEFFO C IX1ZCA=IDEFCA IX2ZCA=IDEFCA IY1ZCA=IDEFCA IY2ZCA=IDEFCA IZ1ZCA=IDEFCA IZ2ZCA=IDEFCA C IX1ZJU='CETO' IX2ZJU='CEBO' IY1ZJU='RICE' IY2ZJU='LECE' IZ1ZJU='RICE' IZ2ZJU='LECE' C IX1ZDI=IDEFDI IX2ZDI=IDEFDI IY1ZDI=IDEFDI IY2ZDI=IDEFDI IZ1ZDI=IDEFDI IZ2ZDI=IDEFDI C IX1ZFI=IDEFFI IX2ZFI=IDEFFI IY1ZFI=IDEFFI IY2ZFI=IDEFFI IZ1ZFI=IDEFFI IZ2ZFI=IDEFFI C IX1ZCO=IDEFCO IX2ZCO=IDEFCO IY1ZCO=IDEFCO IY2ZCO=IDEFCO IZ1ZCO=IDEFCO IZ2ZCO=IDEFCO C IX1ZDP=IDEFDP IX2ZDP=IDEFDP IY1ZDP=IDEFDP IY2ZDP=IDEFDP IZ1ZDP=IDEFDP IZ2ZDP=IDEFDP C PX1ZDS=3.0 PX2ZDS=3.0 PY1ZDS=2.5 PY2ZDS=2.5 PZ1ZDS=2.5 PZ2ZDS=2.5 C AX1ZAN=0.0 AX2ZAN=0.0 AY1ZAN=0.0 AY2ZAN=0.0 AZ1ZAN=0.0 AZ2ZAN=0.0 C PX1ZHE=PDEFHE PX2ZHE=PDEFHE PY1ZHE=PDEFHE PY2ZHE=PDEFHE PZ1ZHE=PDEFHE PZ2ZHE=PDEFHE C PX1ZWI=PDEFWI PX2ZWI=PDEFWI PY1ZWI=PDEFWI PY2ZWI=PDEFWI PZ1ZWI=PDEFWI PZ2ZWI=PDEFWI C PX1ZVG=PDEFVG PX2ZVG=PDEFVG PY1ZVG=PDEFVG PY2ZVG=PDEFVG PZ1ZVG=PDEFVG PZ2ZVG=PDEFVG C PX1ZHG=PDEFHG PX2ZHG=PDEFHG PY1ZHG=PDEFHG PY2ZHG=PDEFHG PZ1ZHG=PDEFHG PZ2ZHG=PDEFHG C PTIZTH=PDEFTH C C **************************** C ** TREAT THE TITLE CASE ** C **************************** C C DO4500I=1,130 DO4500I=1,MAXCH ITITTE(I)=' ' 4500 CONTINUE C NCTITL=0 ITITFO=IDEFFO ITITCA=IDEFCA ITITFI=IDEFFI ITITCO=IDEFCO PTITHE=PDEFHE PTITWI=PDEFWI PTITVG=PDEFVG PTITHG=PDEFHG PTITTH=PDEFTH CCCCC PTITDS=2.0*PDEFDS CCCCC PTITDS=2.0+2.0*PDEFDS PTITDS=1.0+2.0*PDEFDS C C ************************************ C ** TREAT THE MISCELLANEOUS CASE ** C ************************************ C IBELSW='ON' NUMRIN=1 IERASW='ON' ICOPSW='OFF' NUMCOP=1 IPENSW='OFF' IFENSW='OFF' INEGSW='OFF' IHORSW='OFF' ISEQSW='OFF' NUMSEQ=1 C BAWIDT=1.0 BARSPA=0.1 DEFBAS=0.1 C PGRAXF=5.0 PGRAYF=95.0 C DECEMBER 1987: FOR TEKTRONIX FILE SENT TO QMS, LEAVING CURSUR C AT BOTTOM OF SCREEN CAUSES "HOLD SCREENS" ON QMS, RESULTING C IN NUMEROUS UNDESIRED "PAGE EJECTS". POSITION AT TOP OF C SCREEN. CCCCC PGRAYF=15.0 CCCCC PDIAXC=5.0 CCCCC PDIAYC=95.0 PDIAXC=5.0 CCCCC PDIAYC=15.0 PDIAYC=95.0 PDIAX2=PDIAXC PDIAY2=PDIAYC PDIAHE=PDEFHE/2.0 PDIAWI=PDEFWI/2.0 CCCCC PDIAVG=PDEFVG/2.0 PDIAVG=0.0 PDIAHG=PDEFHG/2.0 C C *************************** C ** TREAT THE TEXT CASE ** C *************************** C ITEXPA=IDEFPA ITEXFO=IDEFFO ITEXCA=IDEFCA ITEXJU=IDEFJU ITEXDI=IDEFDI ITEXAU=IDEFAU ITEXFI=IDEFFI ITEXCO=IDEFCO C PTEXHE=PDEFHE PTEXWI=PDEFWI PTEXVG=PDEFVG PTEXHG=PDEFHG PTEXTH=PDEFTH PTEXLE=PDEFLE ATEXAN=ADEFAN C NCTEXT=0 C MXCTEX=130 MXCTEX=MAXCH DO1000I=1,MXCTEX ITEXTE(I)=' ' 1000 CONTINUE C C *************************** C ** STEP XX-- ** C ** TREAT THE FILL CASE ** C *************************** C IDEFFS='OFF' IDEFFP='SOLI' IDEFFC=IDEFGC PDEFFS=0.1 PDEFFT=0.1 ADEFFB=0.0 C MAXFIL=100 MAXFIL=MAXFL C DO1100I=1,MAXFIL IFILSW(I)=IDEFFS IFILPA(I)=IDEFFP IFILCO(I)=IDEFFC PFILSP(I)=PDEFFS PFILTH(I)=PDEFFT AFILBA(I)=ADEFFB 1100 CONTINUE C C ****************************** C ** STEP XX-- ** C ** TREAT THE PATTERN CASE ** C ****************************** C IDEFPS='OFF' IDEFPP='SOLI' IDEFPL='SOLI' IDEFPC=IDEFGC PDEFPW=CPUMIN PDEFPH=CPUMIN PDEFPS=1.0 PDEFPT=0.1 C MAXPAT=100 MAXPAT=MAXPT C DO1200I=1,MAXPAT IPATSW(I)=IDEFPS IPATPA(I)=IDEFPP IPATLI(I)=IDEFPL IPATCO(I)=IDEFPC PPATHE(I)=PDEFPH PPATWI(I)=PDEFPW PPATSP(I)=PDEFPS PPATTH(I)=PDEFPT 1200 CONTINUE C C **************************** C ** STEP XX-- ** C ** TREAT THE SPIKE CASE ** C **************************** C IDEFSS='OFF' IDEFSL='SOLI' IDEFSC=IDEFGC IDEFSD='V' PDEFST=0.1 ADEFSB=0.0 C MAXSPI=100 MAXSPI=MAXSP C DO1300I=1,MAXSPI ISPISW(I)=IDEFSS ISPILI(I)=IDEFSL ISPICO(I)=IDEFSC ISPIDI(I)=IDEFSD PSPITH(I)=PDEFST ASPIBA(I)=ADEFSB 1300 CONTINUE C C ----------BARS---------------------------------------------- C C **************************** C ** STEP XX-- ** C ** TREAT THE BARS CASE ** C **************************** C IDEBSW='OFF' IDEBBL='SOLI' IDEBBC=IDEFGC IDEBFS='OFF' IDEBFC=IDEFGC IDEBPT='SOLI' IDEBPL='SOLI' IDEBPC=IDEFGC IDEBTY='2' IDEBDI='V' ADEBBA=0.0 ADEBWI=CPUMIN PDEBBT=0.1 PDEBPT=0.1 PDEBPS=1.0 C MAXBAR=100 MAXBAR=MAXBA C DO1400I=1,MAXBAR IBARSW(I)=IDEBSW IBABLI(I)=IDEBBL IBABCO(I)=IDEBBC IBAFSW(I)=IDEBFS IBAFCO(I)=IDEBFC IBAPTY(I)=IDEBPT IBAPLI(I)=IDEBPL IBAPCO(I)=IDEBPC IBARTY(I)=IDEBTY IBARDI(I)=IDEBDI ABARBA(I)=ADEBBA ABARWI(I)=ADEBWI PBABTH(I)=PDEBBT PBAPTH(I)=PDEBPT PBAPSP(I)=PDEBPS 1400 CONTINUE C C ----------END OF BARS------------------------------------------------- C C ----------REGIONS---------------------------------------------- C C ******************************* C ** STEP XX-- ** C ** TREAT THE REGIONS CASE ** C ******************************* C IDERSW='OFF' IDERBL='SOLI' IDERBC=IDEFGC IDERFS='OFF' IDERFC=IDEFGC IDERPT='SOLI' IDERPL='SOLI' IDERPC=IDEFGC ADERBA=0.0 ADERWI=CPUMIN PDERBT=0.1 PDERPT=0.1 PDEBPS=1.0 CCCCC THE FOLLOWING LINE WAS INSERTED JANUARY 1989 CCCCC TO FIX INFINITE LOOP IN GRFIRE IN NON-SOLID REGION FILL (JANUARY 1989) CCCCC DEFINE DEFAULT REGION PATTERN SPACING (JANUARY 1989) PDERPS=1.0 C C MAXREG=100 MAXREG=MAXRG C DO1500I=1,MAXREG IREGSW(I)=IDERSW IREBLI(I)=IDERBL IREBCO(I)=IDERBC IREFSW(I)=IDERFS IREFCO(I)=IDERFC IREPTY(I)=IDERPT IREPLI(I)=IDERPL IREPCO(I)=IDERPC AREGBA(I)=ADERBA AREGWI(I)=ADERWI PREBTH(I)=PDERBT PREPTH(I)=PDERPT PBAPSP(I)=PDEBPS CCCCC THE FOLLOWING LINE WAS INSERTED JANUARY 1989 CCCCC TO FIX INFINITE LOOP IN GRFIRE IN NON-SOLID REGION FILL (JANUARY 1989) PREPSP(I)=PDERPS 1500 CONTINUE CCCCC OCTOBER 1993. ADD FOLLOWING LINE IREBIN='OFF' CCCCC MARCH 1994. ADD FOLLOWING LINE IREBPL='OFF' C C ----------END OF REGIONS---------------------------------------- C C ----------MARKERS---------------------------------------------- C C ******************************* C ** STEP XX-- ** C ** TREAT THE MARKERS CASE ** C ******************************* C IDEMSW='OFF' IDEMBL='SOLI' IDEMBC=IDEFGC IDEMFS='OFF' IDEMFC=IDEFGC IDEMPT='SOLI' IDEMPL='SOLI' IDEMPC=IDEFGC ADEMBA=0.0 ADEMWI=CPUMIN PDEMBT=0.1 PDEMPT=0.1 PDEBPS=1.0 C MAXMAR=100 MAXMAR=MAXMR C DO1600I=1,MAXMAR IMARSW(I)=IDEMSW IMABLI(I)=IDEMBL IMABCO(I)=IDEMBC IMAFSW(I)=IDEMFS IMAFCO(I)=IDEMFC IMAPTY(I)=IDEMPT IMAPLI(I)=IDEMPL IMAPCO(I)=IDEMPC AMARBA(I)=ADEMBA AMARWI(I)=ADEMWI PMABTH(I)=PDEMBT PMAPTH(I)=PDEMPT PMAPSP(I)=PDEBPS 1600 CONTINUE C C ----------END OF MARKERS------------------------------------------------- C C ----------TEXTS---------------------------------------------- C C ***************************** C ** STEP XX-- ** C ** TREAT THE TEXTS CASE ** C ***************************** C IDETSW='OFF' IDETBL='SOLI' IDETBC=IDEFGC IDETFS='OFF' IDETFC=IDEFGC IDETPT='SOLI' IDETPL='SOLI' IDETPC=IDEFGC ADETBA=0.0 ADETWI=CPUMIN PDETBT=0.1 PDETPT=0.1 PDEBPS=1.0 C MAXTEX=100 MAXTEX=MAXTX C DO1700I=1,MAXTEX ITEXSW(I)=IDETSW ITEBLI(I)=IDETBL ITEBCO(I)=IDETBC ITEFSW(I)=IDETFS ITEFCO(I)=IDETFC ITEPTY(I)=IDETPT ITEPLI(I)=IDETPL ITEPCO(I)=IDETPC ATEXBA(I)=ADETBA ATEXWI(I)=ADETWI PTEBTH(I)=PDETBT PTEPTH(I)=PDETPT PTEPSP(I)=PDEBPS 1700 CONTINUE C C ----------END OF TEXTS------------------------------------------------- C C **************************************************** C ** TREAT THE START CHARACTER/END CHARACTER CASE ** C **************************************************** C PXSTAR=50.0 PYSTAR=50.0 C PXEND=50.0 PYEND=50.0 C ITEXCR=IDEFCR ITEXLF=IDEFLF PTEXMR=PDEFMR C ITEXSY=IDEFSY ITEXSP=IDEFSP C FOLLOWING ADDED MAY,1988. C C **************************************************** C ** TREAT THE ORIENTATION CASE ** C **************************************************** C IORNSW='FULL' C CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1990 C ************************************************** C ** TREAT THE WINDOW MANAGER CASE ** C ** TREAT THE MENU SELECTOR CASE ** C ************************************************** C IDEFWM='GENE' IWINMA=IDEFWM IDEFMS='NUMB' IMENSE=IDEFMS C CCCCC THE FOLLOWING SECTION WAS ADDED SEPTEMBER 1998 C ************************************************** C ** TREAT THE MULTIPLOT SCALE FACTOR CASE ** C ************************************************** C AMPSCH=1.0 AMPSCW=1.0 C CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1999 C ************************************************** C ** TREAT THE SUBREGIONS CASE ** C ************************************************** C IDEFSB='OFF' ISUBNU=0 DO1800I=1,MAXSUB ISUBSW(I)=IDEFSB ISUBTY(I)='BOX' ASUBXL(I)=CPUMIN ASUBXU(I)=CPUMAX ASUBYL(I)=CPUMIN ASUBYU(I)=CPUMAX 1800 CONTINUE C C ******************************* C ** EXIT AND RETURN TO MAIN ** C ******************************* C 9000 CONTINUE IF(IBUGIN.EQ.'OFF')GOTO9999 WRITE(ICOUT,9990) 9990 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9995) 9995 FORMAT('***** AT THE END OF INITPC--') CALL DPWRST('XXX','BUG ') 9999 CONTINUE C RETURN END SUBROUTINE PRINFI(FILE1,IBUGS2,ISUBRO,IERROR) C C PURPOSE--COPY A FILE TO THE PRINTER C C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--92/4 C ORIGINAL VERSION--MARCH 1992. C UPDATED --APRIL 1992. MAKE HOST DEPENDENT (ALAN) C USE DPSYS2 TO MAKE OPERATING C SYSTEM DEPENDENT CALL C UPDATED --MAY 1992. COPY --> PRINT FOR PC C UPDATED --JANUARY 1994. NOTE--PRINTING VAX/ALPHA C UPDATED --AUGUST 1997. FOR WINDOWS 95, USE COPY C INSTEAD OF PRINT C UPDATED --FEBRUARY 1998. SUPPORT USE OF SET PRINTER C FOR UNIX AND WINDOWS 95/NT C UPDATED --NOVEMBER 1998. SUPPORT NEW LAHEY COMPILER C UPDATED --NOVEMBER 2002. FOR PC, USE GSPRINT COMMAND C (REQUIRES GS 6.50 OR HIGHER) C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*80 FILE1 CHARACTER*80 FILE2 CHARACTER*4 IBUGS2 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CCCCC CHARACTER*1 IQUOTE C CHARACTER*120 ISTRIN C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C C APRIL 1992. ADD HOST INCLUDE FILE INCLUDE 'DPCOHO.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCONP.INC' C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'INFI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF PRINFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR 53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)FILE1 54 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IHOST1 61 FORMAT(' HOST = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)IHMOD1 62 FORMAT(' MODEL = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)IOPSY1 63 FORMAT(' OP-SYS = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)ICOMPI 64 FORMAT(' COMPILER = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,65)ISITE 65 FORMAT(' SITE = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C APRIL 1992. ADD HOST DEPENDENT BRANCH C C ******************************** C ** STEP 1-- ** C ** STEP THROUGH EACH HOST ** C ******************************** C IF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'OS38')GOTO1000 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO1000 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO1100 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')GOTO1100 IF(IHOST1.EQ.'NVE')GOTO2000 IF(IOPSY1.EQ.'UNIX')GOTO3000 IF(IHOST1.EQ.'VAX')GOTO5000 GOTO8000 C C ******************************** C ** STEP 2A-- ** C ** IBM/PC 386 WITH OTG COMPILER C ******************************** C 1000 CONTINUE ISTRIN=' ' C CCCCC THE FOLLOWING 2 LINES WERE FIXED MAY 1992 CCCCC N0=4 CCCCC ISTRIN(1:N0)='COPY' N0=5 ISTRIN(1:N0)='PRINT' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CCCCC THE FOLLOWING 3 LINES WERE COMMENTED OUT MAY 1992 CCCCC FILE2='LPT1:' CCCCC CALL STRLEZ(FILE2,N2) CCCCC ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) CCCCC THE FOLLOWING LINE WAS ADDED MAY 1992 N2=0 C N012=N0+1+N1+1+N2 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'INFI')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1011) 1011 FORMAT('***** FROM THE MIDDLE OF PRINFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1012)FILE1 1012 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1013)FILE2 1013 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1014)N0,N1,N2,N012 1014 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1015)ISTRIN(1:80) 1015 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF C C APRIL 1992. USE DPSYS2 (CISSUE IN ONE ROUTINE ONLY) CCCCC CALL CISSUE(ISTRIN(1:N012),IFAIL) CCCCC IERROR='NO' CCCCC IF(IFAIL.EQ.1)IERROR='YES' CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2A-- ** C ** IBM/PC 386 WITH MICROSOFT WINDOWS 95/NT COMPILER C ** USE COPY INSTEAD OF PRINT! * C ** ALSO USE PRINTER ID ** C ******************************** C C NOVEMBER 2002: IF "SET GHOSTSCRIPT PRINTER ON" ENTERED, THEN C PRINT USING THE COMMAND: C GSPRINT.EXE -PRINTER "printer-name" file-name C 1100 CONTINUE C ISTRIN=' ' C IF(IPRNGS.EQ.'ON')THEN C CCCCC CALL DPCONA(39,IQUOTE) IBASLC=CHAR(92) C ISTRIN(1:NCGSPA)=IGSVPA(1:NCGSPA) N0=NCGSPA IF(IGSVPA(NCGSPA:NCGSPA).NE.IBASLC)THEN N0=N0+1 ISTRIN(N0:N0)=IBASLC ENDIF N0=N0+1 ISTRIN(N0:N0+11)='GSPRINT.EXE ' N0=N0+12 ISTRIN(N0:N0)=' ' FILE2=' ' C IF(NCPRNT.GT.0)THEN N0=N0+1 ISTRIN(N0:N0+8)='-printer ' N0=N0+8 CCCCCC ISTRIN(N0:N0)=IQUOTE FILE2=IPRNTR N2=NCPRNT CALL STRLEZ(FILE2,N2) ISTRIN(N0+1:N0+1+N2)=FILE2(1:N2) N0=N0+1+N2 CCCCC N0=N0+1+N2+1 CCCCC ISTRIN(N0:N0)=IQUOTE N0=N0+1 ISTRIN(N0:N0)=' ' ENDIF C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1:N0+1+N1)=FILE1 N0=N0+1+N1+1 ISTRIN(N0:N0)=' ' C N012=N0+1+N1+1+N2 ELSE C CCCCC THE FOLLOWING 2 LINES WERE FIXED MAY 1992 N0=5 ISTRIN(1:N0)='COPY ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CCCCC SUPPORT SET PRINTER COMMAND FEBRUARY 1998. FILE2=' ' IF(NCPRNT.LE.0)THEN FILE2='PRN:' N2=4 ELSE FILE2=IPRNTR N2=NCPRNT ENDIF C CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) N012=N0+1+N1+1+N2 ENDIF C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'INFI')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1111) 1111 FORMAT('***** FROM THE MIDDLE OF PRINFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1112)FILE1 1112 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1113)FILE2 1113 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1114)N0,N1,N2,N012 1114 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115)ISTRIN(1:110) 1115 FORMAT('ISTRIN = ',A110) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117)IPRNGS 1117 FORMAT('IPRNGS = ',A4) CALL DPWRST('XXX','BUG ') ENDIF C CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2B-- ** C ** CYBER WITH NOS/VE ** C ** USE PRINT_FILE TO DEFAULT ** C ** PRINTER. NO PROVISION YET** C ** FOR NAMING PRINTER. ** C ******************************** C 2000 CONTINUE ISTRIN=' ' C N0=10 ISTRIN(1:N0)='PRINT_FILE' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C N012=N0+1+N1+1 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'INFI')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2011) 2011 FORMAT('***** FROM THE MIDDLE OF PRINFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2012)FILE1 2012 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2014)N0,N1,N012 2014 FORMAT('N0,N1,N012 = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2015)ISTRIN(1:80) 2015 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF C CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2C-- ** C ** UNIX OPERATING SYSTEM ** C ** USE lpr TO DEFAULT ** C ** PRINTER. NO PROVISION YET** C ** FOR NAMING PRINTER. ** C ******************************** C 3000 CONTINUE ISTRIN=' ' C CCCCC ADD SUPPORT FOR SET PRINTER COMMAND FEBRUARY 1998. IF(NCPRNT.LE.0)THEN N0=3 ISTRIN(1:N0)='lpr' ELSE N0=6 ISTRIN(1:N0)='lpr -P' N0=N0+1 N02=N0+NCPRNT-1 ISTRIN(N0:N02)=IPRNTR(1:NCPRNT) N0=N02 ENDIF ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C N012=N0+1+N1+1 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'INFI')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3011) 3011 FORMAT('***** FROM THE MIDDLE OF PRINFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3012)FILE1 3012 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3014)N0,N1,N012 3014 FORMAT('N0,N1,N012 = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3015)ISTRIN(1:80) 3015 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF C CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2D-- ** C ** VAX/VMS ** C ** USE PRINT. USE DEFAULT ** C ** PRINTER. NO PROVISION YET** C ** FOR NAMING PRINTER. ** C C NOTE--ON A VAX OR AN ALPHA (RUNNING VMS), JANUARY 1994 C TO MAKE THE PP (PRINT A PLOT) JANUARY 1994 C COMMAND WORK, THEN THE STRING JANUARY 1994 C PRINT DPPL2F.DAT JANUARY 1994 C SHOULD GET CHANGED TO JANUARY 1994 C PRINT /QUEUE=something DPPL2F.DAT JANUARY 1994 C (E.G., PRINT/QUEUE=DPPRINTER DPPL2F.DAT) JANUARY 1994 C AND THEN HAVE THE ANALYST DEFINE JANUARY 1994 C DPPRINTER (VIA ASSIGN DPPRINTER = etc.) JANUARY 1994 C EITHER OUTSIDE OF DATAPLOT JANUARY 1994 C IN HIS/HER VAX LOGIN FILE, OR JANUARY 1994 C INSIDE DATAPLOT VIA JANUARY 1994 C DATAPLOT'S SYSTEM COMMAND JANUARY 1994 C (E.G., SYSTEM ASSIGN DPPRINTER = etc.) JANUARY 1994 C C ******************************** C 5000 CONTINUE ISTRIN=' ' C N0=5 ISTRIN(1:N0)='PRINT' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C N012=N0+1+N1+1 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'INFI')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5011) 5011 FORMAT('***** FROM THE MIDDLE OF PRINFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5012)FILE1 5012 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5014)N0,N1,N012 5014 FORMAT('N0,N1,N012 = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5015)ISTRIN(1:80) 5015 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF C CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2E-- ** C ** UNSUPPORTED SYSTEMS. ** C ******************************** C 8000 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8011) 8011 FORMAT('THE PRINT FILE CAPABILITY NOT SUPPORTED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8012)IHOST1 8012 FORMAT('ON HOST ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8013) 8013 FORMAT('CONTACT YOUR SITE INSTALLER.') CALL DPWRST('XXX','BUG ') GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'INFI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF PRINFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IBUGS2,ISUBRO,IERROR 9013 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)FILE1 9014 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)IHOST1 9021 FORMAT(' HOST = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)IHMOD1 9022 FORMAT(' MODEL = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)IOPSY1 9023 FORMAT(' OP-SYS = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)ICOMPI 9024 FORMAT(' COMPILER = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9025)ISITE 9025 FORMAT(' SITE = ',A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE COPYFI(FILE1,FILE2,IBUGS2,ISUBRO,IERROR) C C PURPOSE--COPY A FILE TO ANOTHER FILE C C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--92/4 C ORIGINAL VERSION--MARCH 1992. C UPDATED --APRIL 1992. ADD OPERATING SYSTEM BRANCHES C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*80 FILE1 CHARACTER*80 FILE2 CHARACTER*4 IBUGS2 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*80 ISTRIN C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C C APRIL 1992. ADD FOLLOWING INCLUDE FILE INCLUDE 'DPCOHO.INC' C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'PYFI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR 53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)FILE1 54 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)FILE2 55 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IHOST1 61 FORMAT(' HOST = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)IHMOD1 62 FORMAT(' MODEL = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)IOPSY1 63 FORMAT(' OP-SYS = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)ICOMPI 64 FORMAT(' COMPILER = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,65)ISITE 65 FORMAT(' SITE = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C APRIL 1992. ADD HOST DEPENDENT BRANCHES C C ******************************** C ** STEP 1-- ** C ** STEP THROUGH EACH HOST ** C ******************************** C IF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'OS38')GOTO1000 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO1000 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO1000 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')GOTO1000 IF(IHOST1.EQ.'NVE')GOTO2000 IF(IOPSY1.EQ.'UNIX')GOTO3000 IF(IHOST1.EQ.'VAX')GOTO5000 GOTO8000 C C ******************************** C ** STEP 2A-- ** C ** IBM/PC 386 WITH OTG COMPILER C ******************************** C 1000 CONTINUE ISTRIN=' ' C N0=4 ISTRIN(1:N0)='COPY' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) N012=N0+1+N1+1+N2 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'PYFI')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1011) 1011 FORMAT('***** FROM THE MIDDLE OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1012)FILE1 1012 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1013)FILE2 1013 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1014)N0,N1,N2,N012 1014 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1015)ISTRIN 1015 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF C APRIL 1992. CALL CISSUE FROM DPSYS2 CCCCC CALL CISSUE(ISTRIN(1:N012),IFAIL) CCCCC IERROR='NO' CCCCC IF(IFAIL.EQ.1)IERROR='YES' CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2B-- ** C ** CYBER WITH NOS/VE ** C ** USE COPY_FILE COMMAND ** C ******************************** C 2000 CONTINUE ISTRIN=' ' C N0=9 ISTRIN(1:N0)='COPY_FILE' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) N012=N0+1+N1+1+N2 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'PYFI')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2011) 2011 FORMAT('***** FROM THE MIDDLE OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2012)FILE1 2012 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2013)FILE2 2013 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2014)N0,N1,N2,N012 2014 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2015)ISTRIN 2015 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2C-- ** C ** UNIX OPERATING SYSTEM ** C ** USE cp COMMAND ** C ******************************** C 3000 CONTINUE ISTRIN=' ' C N0=2 ISTRIN(1:N0)='cp' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) N012=N0+1+N1+1+N2 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'PYFI')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3011) 3011 FORMAT('***** FROM THE MIDDLE OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3012)FILE1 3012 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3013)FILE2 3013 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3014)N0,N1,N2,N012 3014 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3015)ISTRIN 3015 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2D-- ** C ** VAX/VMS ** C ** USE COPY COMMAND ** C ******************************** C 5000 CONTINUE ISTRIN=' ' C N0=4 ISTRIN(1:N0)='COPY' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) N012=N0+1+N1+1+N2 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'PYFI')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5011) 5011 FORMAT('***** FROM THE MIDDLE OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5012)FILE1 5012 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5013)FILE2 5013 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5014)N0,N1,N2,N012 5014 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5015)ISTRIN 5015 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2E-- ** C ** UNSUPPORTED SYSTEMS. ** C ******************************** C 8000 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8011) 8011 FORMAT('THE COPY FILE CAPABILITY NOT SUPPORTED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8012)IHOST1 8012 FORMAT('ON HOST ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8013) 8013 FORMAT('CONTACT YOUR SITE INSTALLER.') CALL DPWRST('XXX','BUG ') GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'PYFI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IBUGS2,ISUBRO,IERROR 9013 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)FILE1 9014 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)FILE2 9015 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)IHOST1 9021 FORMAT(' HOST = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)IHMOD1 9022 FORMAT(' MODEL = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)IOPSY1 9023 FORMAT(' OP-SYS = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)ICOMPI 9024 FORMAT(' COMPILER = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9025)ISITE 9025 FORMAT(' SITE = ',A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CONVFP(FILE1,FILE2,IBUGS2,ISUBRO,IERROR) C C PURPOSE--CONVERT AN ASCII FILE TO POSTSCRIPT C THE ORIGINAL ASCII FILE IS FILE1 C THE POSTSCRIPT REPRESENTATION IS PLACED IN FILE2 C C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--92/4 C ORIGINAL VERSION--MARCH 1992. C UPDATED --APRIL 1992. SUPPORT OTHER THAN PC C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*80 FILE1 CHARACTER*80 FILE2 CHARACTER*4 IBUGS2 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*80 ISTRIN C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C C APRIL 1992. ADD HOST INCLUDE FILE INCLUDE 'DPCOHO.INC' C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT--------------------------------------------------- C IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'NVFP')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CONVFP--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR 53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)FILE1 54 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)FILE2 55 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IHOST1 61 FORMAT(' HOST = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)IHMOD1 62 FORMAT(' MODEL = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)IOPSY1 63 FORMAT(' OP-SYS = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)ICOMPI 64 FORMAT(' COMPILER = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,65)ISITE 65 FORMAT(' SITE = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C APRIL 1992. ADD HOST DEPENDENT BRANCHES C C ******************************** C ** STEP 1-- ** C ** STEP THROUGH EACH HOST ** C ******************************** C IF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'OS38')GOTO100 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO100 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO100 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')GOTO100 IF(IHOST1.EQ.'NVE')GOTO200 IF(IOPSY1.EQ.'UNIX')GOTO300 IF(IHOST1.EQ.'VAX')GOTO500 GOTO8000 C C ******************************** C ** STEP 2A-- ** C ** IBM/PC 386 WITH OTG COMPILER C ******************************** C 100 CONTINUE ISTRIN=' ' C N0=4 ISTRIN(1:N0)='COPY' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) N012=N0+1+N1+1+N2 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'NVFP')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,111) 111 FORMAT('***** FROM THE MIDDLE OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,112)FILE1 112 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,113)FILE2 113 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,114)N0,N1,N2,N012 114 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,115)ISTRIN 115 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF C APRIL 1992. CALL CISSUE FROM DPSYS2 CCCCC CALL CISSUE(ISTRIN(1:N012),IFAIL) CCCCC IERROR='NO' CCCCC IF(IFAIL.EQ.1)IERROR='YES' CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO900 C C ******************************** C ** STEP 2B-- ** C ** CYBER WITH NOS/VE ** C ** USE COPY_FILE COMMAND ** C ******************************** C 200 CONTINUE ISTRIN=' ' C N0=9 ISTRIN(1:N0)='COPY_FILE' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) N012=N0+1+N1+1+N2 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'NVFP')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,211) 211 FORMAT('***** FROM THE MIDDLE OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,212)FILE1 212 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,213)FILE2 213 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,214)N0,N1,N2,N012 214 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,215)ISTRIN 215 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO900 C C ******************************** C ** STEP 2C-- ** C ** UNIX OPERATING SYSTEM ** C ** USE cp COMMAND ** C ******************************** C 300 CONTINUE ISTRIN=' ' C N0=2 ISTRIN(1:N0)='cp' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) N012=N0+1+N1+1+N2 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'NVFP')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,311) 311 FORMAT('***** FROM THE MIDDLE OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,312)FILE1 312 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,313)FILE2 313 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,314)N0,N1,N2,N012 314 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,315)ISTRIN 315 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO900 C C ******************************** C ** STEP 2D-- ** C ** VAX/VMS ** C ** USE COPY COMMAND ** C ******************************** C 500 CONTINUE ISTRIN=' ' C N0=4 ISTRIN(1:N0)='COPY' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2(1:N2) N012=N0+1+N1+1+N2 C IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'NVFP')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,511) 511 FORMAT('***** FROM THE MIDDLE OF COPYFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,512)FILE1 512 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,513)FILE2 513 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,514)N0,N1,N2,N012 514 FORMAT('N0,N1,N2,N012 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,515)ISTRIN 515 FORMAT('ISTRIN = ',A80) CALL DPWRST('XXX','BUG ') ENDIF CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO900 C C ******************************** C ** STEP 2E-- ** C ** UNSUPPORTED SYSTEMS. ** C ******************************** C 8000 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8011) 8011 FORMAT('THE PRINT POSTSCRIPT CAPABILITY NOT SUPPORTED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8012)IHOST1 8012 FORMAT('ON HOST ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8013) 8013 FORMAT('CONTACT YOUR SITE INSTALLER.') CALL DPWRST('XXX','BUG ') GOTO900 C 900 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'NVFP')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CONVFP--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IBUGS2,ISUBRO,IERROR 9013 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)FILE1 9014 FORMAT('FILE1 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)FILE2 9015 FORMAT('FILE2 = ',A80) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)IHOST1 9021 FORMAT(' HOST = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)IHMOD1 9022 FORMAT(' MODEL = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)IOPSY1 9023 FORMAT(' OP-SYS = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)ICOMPI 9024 FORMAT(' COMPILER = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9025)ISITE 9025 FORMAT(' SITE = ',A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE COPYPR(FILE1) C C PURPOSE--COPY A FILE TO THE PRINTER C C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--92/4 C ORIGINAL VERSION--MARCH 1992. C UPDATED --OCTOBER 1993. SUPPORT NON-PC HOSTS (ALAN) C UPDATED --NOVEMBER 1994. ISUBRO AND IERROR DECLARATION C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*80 FILE1 CHARACTER*80 FILE2 CHARACTER*80 ISTRIN CCCCC ADD FOLLOWING 2 LINES NOVEMBER 1994. CHARACTER*4 IERROR CHARACTER*4 ISUBRO C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C C OCTOBER 1993. ADD HOST INCLUDE FILE INCLUDE 'DPCOHO.INC' C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C CCCCC ADD FOLLOWING 2 LINES NOVEMBER 1994. IERROR='NO' ISUBRO='PYPR' C C OCTOBER 1993. ADD HOST DEPENDENT BRANCH C C ******************************** C ** STEP 1-- ** C ** STEP THROUGH EACH HOST ** C ******************************** C IF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'OS38')GOTO1000 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO1000 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO1000 IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')GOTO1000 IF(IHOST1.EQ.'NVE')GOTO2000 IF(IOPSY1.EQ.'UNIX')GOTO3000 IF(IHOST1.EQ.'VAX')GOTO5000 GOTO8000 C C ******************************** C ** STEP 2A-- ** C ** IBM/PC 386 WITH OTG COMPILER C ******************************** C 1000 CONTINUE ISTRIN=' ' C N0=4 ISTRIN(1:N0)='COPY' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C FILE2(1:5)='LPT1:' CALL STRLEZ(FILE2,N2) ISTRIN(N0+1+N1+1+1:N0+1+N1+1+N2)=FILE2 N012=N0+1+N1+1+N2 C CIBM- CALL CISSUE(ISTRIN(1:N012),IFAIL) C OCTOBER 1993. USE DPSYS2 (CISSUE IN ONE ROUTINE ONLY) CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2B-- ** C ** CYBER WITH NOS/VE ** C ** USE PRINT_FILE TO DEFAULT ** C ** PRINTER. NO PROVISION YET** C ** FOR NAMING PRINTER. ** C ******************************** C 2000 CONTINUE ISTRIN=' ' C N0=10 ISTRIN(1:N0)='PRINT_FILE' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C N012=N0+1+N1+1 C CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2C-- ** C ** UNIX OPERATING SYSTEM ** C ** USE lpr TO DEFAULT ** C ** PRINTER. NO PROVISION YET** C ** FOR NAMING PRINTER. ** C ******************************** C 3000 CONTINUE ISTRIN=' ' C N0=3 ISTRIN(1:N0)='lpr' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C N012=N0+1+N1+1 C CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2D-- ** C ** VAX/VMS ** C ** USE PRINT. USE DEFAULT ** C ** PRINTER. NO PROVISION YET** C ** FOR NAMING PRINTER. ** C ******************************** C 5000 CONTINUE ISTRIN=' ' C N0=5 ISTRIN(1:N0)='PRINT' ISTRIN(N0+1:N0+1)=' ' C CALL STRLEZ(FILE1,N1) ISTRIN(N0+1+1:N0+1+N1)=FILE1 ISTRIN(N0+1+N1+1:N0+1+N1+1)=' ' C N012=N0+1+N1+1 C CALL DPSYS2(ISTRIN,N012,ISUBRO,IERROR) GOTO9000 C C ******************************** C ** STEP 2E-- ** C ** UNSUPPORTED SYSTEMS. ** C ******************************** C 8000 CONTINUE WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8011) 8011 FORMAT('THE PRINT FILE CAPABILITY NOT SUPPORTED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8012)IHOST1 8012 FORMAT('ON HOST ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8013) 8013 FORMAT('CONTACT YOUR SITE INSTALLER.') CALL DPWRST('XXX','BUG ') GOTO9000 C 9000 CONTINUE RETURN END