COMPLEX FUNCTION C9LGMC(ZIN) C***BEGIN PROLOGUE C9LGMC C***DATE WRITTEN 780401 (YYMMDD) C***REVISION DATE 820801 (YYMMDD) C***CATEGORY NO. C7A C***KEYWORDS COMPLETE GAMMA FUNCTION,COMPLEX,CORRECTION TERM, C GAMMA FUNCTION,LOGARITHM,SPECIAL FUNCTION C***AUTHOR FULLERTON, W., (LANL) C***PURPOSE Computes the LOG GAMMA correction term for most Z so that C CLOG(CGAMMA(Z)) = 0.5*ALOG(2.*PI) + (Z-0.5)*CLOG(Z) - Z C + C9LGMC(Z) C***DESCRIPTION C C Compute the LOG GAMMA correction term for large CABS(Z) when REAL(Z) C .GE. 0.0 and for large ABS(AIMAG(Y)) when REAL(Z) .LT. 0.0. We find C C9LGMC so that C CLOG((Z)) = 0.5*ALOG(2.*PI) + (Z-0.5)*CLOG(Z) - Z + C9LGMC(Z) C***REFERENCES (NONE) C***ROUTINES CALLED R1MACH,XERROR C***END PROLOGUE C9LGMC COMPLEX ZIN, Z, Z2INV DIMENSION BERN(11) C INCLUDE 'DPCOMC.INC' CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DATA BERN( 1) / .08333333333 3333333E0 / DATA BERN( 2) / -.002777777777 7777778E0 / DATA BERN( 3) / .0007936507936 5079365E0 / DATA BERN( 4) / -.0005952380952 3809524E0 / DATA BERN( 5) / .0008417508417 5084175E0 / DATA BERN( 6) / -.001917526917 5269175E0 / DATA BERN( 7) / .006410256410 2564103E0 / DATA BERN( 8) / -.02955065359 4771242E0 / DATA BERN( 9) / .1796443723 6883057E0 / DATA BERN(10) / -1.392432216 9059011E0 / DATA BERN(11) / 13.40286404 4168392E0 / DATA NTERM, BOUND, XBIG, XMAX / 0, 3*0.0 / C***FIRST EXECUTABLE STATEMENT C9LGMC CCCCC IERR2=0 IF (NTERM.NE.0) GO TO 10 C NTERM = -0.30*ALOG(R1MACH(3)) BOUND = 0.1170*FLOAT(NTERM)* 1 (0.1*R1MACH(3))**(-1./(2.*FLOAT(NTERM)-1.)) XBIG = 1.0/SQRT(R1MACH(3)) XMAX = EXP (AMIN1(ALOG(R1MACH(2)/12.0), -ALOG(12.*R1MACH(1))) ) C 10 Z = ZIN X = REAL (Z) Y = AIMAG(Z) CABSZ = CABS(Z) C IF (X.LT.0.0 .AND. ABS(Y).LT.BOUND)THEN CCCCC CALL XERROR ( 'C9LGMC C9LGMC CCCCC1 NOT VALID FOR NEGATIVE REAL(Z) AND SMALL ABS(AIMAG(Z))', 69, 2,2) WRITE(ICOUT,11) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12) CALL DPWRST('XXX','BUG ') CCCCC IERR2=1 RETURN ENDIF 11 FORMAT('***** INTERNAL ERROR FROM C9LGMC: C9LGMC NOT ', 1 'VALID FOR NEGATIVE REAL(Z) AND') 12 FORMAT(' SMALL ABS(AIMZ(Z))') C IF (CABSZ.LT.BOUND) THEN CCCCC CALL XERROR ( 'C9LGMC C9LGMC NOT VALID FOR SM CCCCC1ALL CABS(Z)', 42, 3, 2) WRITE(ICOUT,21) CALL DPWRST('XXX','BUG ') CCCCC IERR2=1 RETURN ENDIF 21 FORMAT('***** INTERNAL ERROR FROM C9LGMC: C9LGMC NOT ', 1 'VALID FOR SMALL ABS(AIMZ(Z))') C IF (CABSZ.GE.XMAX) GO TO 50 C IF (CABSZ.GE.XBIG) C9LGMC = 1.0/(12.0*Z) IF (CABSZ.GE.XBIG) RETURN C Z2INV = 1.0/Z**2 C9LGMC = (0.0, 0.0) DO 40 I=1,NTERM NDX = NTERM + 1 - I C9LGMC = BERN(NDX) + C9LGMC*Z2INV 40 CONTINUE C C9LGMC = C9LGMC/Z RETURN C 50 C9LGMC = (0.0, 0.0) CCCCC CALL XERROR ( 'C9LGMC Z SO BIG C9LGMC UNDERFLOWS', 34, 1, 1) WRITE(ICOUT,51) CALL DPWRST('XXX','BUG ') CCCCC IERR2=2 51 FORMAT('***** INTERNAL WARNING FROM C9LGMC: Z SO BIG ', 1 'THAT C9LGMC UNDERFLOWS') RETURN C END SUBROUTINE CALCPT(PX1,PY1,AX1,AY1,ISUBN0) C C THIS ROUTINE IS A MODIFIED VERSION OF CALCPT. IT IS USED C ONLY BY THE "CALCOMP" DEVICES (CALCOMP, ZETA) USING THE C STANDARD "CALCOMP ROUTINES". C CALCPT CONVERTS FROM DATAPLOT C UNITS TO DEVICE INTEGER UNITS, BUT IT ALSO APPLIES "WINDOW" C TRANSFORMATIONS NEEDED BY THE "MULTI-PLOT" AND "WINDOW C COORDINATE" COMMANDS. THE CALCOMP COORDINATES NEED TO BE C TRANSLATED TO INCHES. C C PURPOSE--TRANSLATE THE STANDARDIZED (0.0 TO 100.0) COORDINATES (PX1,PY1) C INTO (INTEGER PICTURE POINT) DEVICE COORDINATES (AX1,AY1) C ISUBN0 = NAME OF SUBROUTINE WHICH CALLED GRWRST. C (AND THEREBY HAVE WALKBACK INFORMATION). C NOTE--THE ONLY VARIABLES IN THE PLOT CONTROL COMMON C THAT ARE USED HEREIN ARE THE ONES IN /RWIND/ C C WRITTEN BY--ALAN HECKERT C COMPUTER SERVICES DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED--SEPTEMBER 1986. C UPDATED--APRIL 1992. COMMENT OUT PWX1 LINES C UPDATED--APRIL 1992. COMMENT OUT 9000 CONTINUE C UPDATED--APRIL 1992. GIVE VALUES TO X1 AND Y1 C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CHARACTER*4 ISUBN0 C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOPC.INC' INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C CCCCC THE FOLLOWING 2 LINES WERE ADDED APRIL 1992 X1=-999.0 Y1=-999.0 C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LCPT')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CALCPT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ISUBN0 52 FORMAT('ISUBN0 (NAME OF THE CALLING SUBROUTINE) = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IMANUF,IMODEL 53 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)NUMHPP,NUMVPP 54 FORMAT('NUMHPP,NUMVPP = ',I8,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)ANUMHP,ANUMVP 55 FORMAT('ANUMHP,ANUMVP = ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)PX1,PY1 56 FORMAT('PX1,PY1 = ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)PWXMIN,PWXMAX,PWYMIN,PWYMAX 61 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)IBUGG4 69 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************************** C ** STEP 0-- ** C ** DETERMINE THE DIMENSION OF THE ** C ** IN INCHES ** C ************************************** C DOTPPI=1000. XPAGE=ANUMHP/DOTPPI YPAGE=ANUMVP/DOTPPI C C ************************************* C ** STEP 1-- ** C ** CARRY OUT THE TRANSFORMATION. ** C ************************************* C AX1=PWXMIN+(PX1/100.0)*(PWXMAX-PWXMIN) IF(AX1.LE.0.0)AX1=0.0 IF(AX1.GE.100.)AX1=100. C AY1=PWYMIN+(PY1/100.0)*(PWYMAX-PWYMIN) IF(AY1.LE.0.0)AY1=0.0 IF(AY1.GE.100.)AY1=100. C C ************************************** C ** STEP 2-- ** C ** CONVERT TO INCH FORMAT ** C ************************************** C AX1=XPAGE*(AX1/100.) AY1=YPAGE*(AY1/100.) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C CCCCC THE FOLLOWING LINE WAS COMMENTED OUT APRIL 1992 C9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LCPT')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CALCPT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IMANUF,IMODEL 9012 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)NUMHPP,NUMVPP 9013 FORMAT('NUMHPP,NUMVPP = ',I8,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ANUMHP,ANUMVP 9014 FORMAT('ANUMHP,ANUMVP = ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)PX1,PY1 9015 FORMAT('PX1,PY1 = ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT APRIL 1992 (ALAN) CCCCC WRITE(ICOUT,9016)PWX1,PWY1 C9016 FORMAT('PWX1,PWY1 = ',E15.7,E15.7) CCCCC CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)X1,Y1 9017 FORMAT('X1,Y1 = ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)AX1,AY1 9018 FORMAT('AX1,AY1 = ',I8,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)PWXMIN,PWXMAX,PWYMIN,PWYMAX 9021 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CALCTR(IA,IH,NLEN) C C CALCTR WILL CONVERT A CHARACTER VARIABLE OR QUOTED STRING C TO HOLLERITH FORMAT. IT IS REQUIRED FOR THE CALCOMP LIBRARY C ROUTINES SINCE A FEW FORTRAN COMPILERS WILL NOT ALLOW CHARACTER C VARIABLES TO BE PASSED TO HOLLERITH ARRAYS (E.G., NOS/VE FORTRAN). C THE DIMENSION OF "ITEMP" IS MACHINE DEPENDENT 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 CHARACTER*10 FMT1,FMT2 CHARACTER*(*) IA INTEGER IH(*) C C DIMENSION ITEMP TO "NUMCPW", I.E., THE NUMBER OF CHARACTERS PER WORD C CHARACTER*8 ITEMP C CCCCC NLEN=LEN(IA) NWORDS=NLEN/NUMCPW NREM=MOD(NLEN,NUMCPW) ITEMP=' ' IF(NWORDS.GT.99)NWORDS=99 IF(NWORDS.LT.0)NWORDS=0 IF(NREM.GT.0)ITEMP(1:NREM)=IA(NWORDS*NUMCPW+1:NWORDS*NUMCPW+NREM) FMT1='( A )' WRITE(FMT1(2:3),'(I2)')NWORDS WRITE(FMT1(5:6),'(I2)')NUMCPW FMT2='(A )' WRITE(FMT2(3:4),'(I2)')NREM C IF(NWORDS.GE.1)READ(IA,FMT1)(IH(J),J=1,NWORDS) IF(NREM.GT.0)READ(ITEMP,FMT2)IH(NWORDS+1) C RETURN END SUBROUTINE CANTOR(N,X,P,ANUM,IERROR) C CCCCC ***** NOTE--THIS SUBROUTINE IS CURRENTLY (APRIL 1989) CCCCC ONLY VALID FOR P = 0.33333. CCCCC TO BE DONE--GENERALIZE FOR ALL P BETWEEN 0 AND 1. C C PURPOSE--THIS SUBROUTINE GENERATES N CANTOR NUMBERS C (A CLASSIC CHAOS THEORY SET) C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF CANTOR SET NUMBERS C TO BE GENERATED. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C CANTOR NUMBERS C WILL BE PLACED. C --P = THE FRACTIONAL SIZE OF THE HOLE C IN THE MIDDLE OF THE UNIT INTERVAL C (P MUST BE BETWEEN 0 AND 1). C OUTPUT--N CANTOR SET NUMBERS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C LANGUAGE--ANSI FORTRAN (1977) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--89.6 C ORIGINAL VERSION--APRIL 1989. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION X(*) DIMENSION ANUM(*) 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 CPUMA3=CPUMAX/3.0 C C ****************************************** C ** TREAT THE CANTOR SET CASE ** C ****************************************** C C ******************************************* C ** STEP 1-- ** C ** TEST THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************* C IF(N.GE.1)GOTO190 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,101) 101 FORMAT('***** ERROR IN CANTOR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,102) 102 FORMAT(' THE SIZE OF THE DESIRED SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,103) 103 FORMAT(' OF CANTOR NUMBERS MUST BE 1 OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,104) 104 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,105)N 105 FORMAT(' N = ',I8) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 190 CONTINUE C C ****************************** C ** STEP 2-- ** C ** GENERATE THE SET ** C ****************************** C CCCCC ***** CURRENTLY ONLY VALID FOR P = 1/3 CCCCC ***** UPDATE THIS FOR GENERAL P C CCCCC PLOCAL=P PLOCAL=0.33333 R=2.0/(1.0-PLOCAL) ICOUNT=0 C K=1 DENOM=R**K ANUM(1)=1.0 ICOUNT=ICOUNT+1 X(ICOUNT)=ANUM(1)/DENOM IF(N.LE.1)GOTO1900 C DO1100K=2,20 DENOM=R**K LMAX=2**(K-1) LMIN=(LMAX/2)+1 L2=0 DO1200L=LMIN,LMAX L2=L2+1 L3=LMIN-L2 AMIRRO=ANUM(L3) ANUM(L)=DENOM-1.0-AMIRRO 1200 CONTINUE DO1300L=1,LMAX ICOUNT=ICOUNT+1 RATIO=ANUM(L)/DENOM IF(X(ICOUNT).GE.CPUMA3)GOTO1350 X(ICOUNT)=RATIO IF(ICOUNT.GE.N)GOTO1900 1300 CONTINUE 1100 CONTINUE C 1350 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1351) 1351 FORMAT('***** ERROR IN CANTOR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1352) 1352 FORMAT(' A NUMBER IN THE CANTOR SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1353) 1353 FORMAT(' HAS JUST EXCEEDED THE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1354) 1354 FORMAT(' LARGEST FLOATING POINT NUMBER') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1355) 1355 FORMAT(' ALLOWABLE FOR THIS COMPUTER (',E15.7,').') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1356) 1356 FORMAT(' THE VALUE CAUSING THE OVERFLOW WAS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1357)ICOUNT 1357 FORMAT(' THE ',I8,'-TH NUMBER IN THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1358) 1358 FORMAT(' CANTOR SET.') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1900 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE RETURN END FUNCTION CARG(Z) C***BEGIN PROLOGUE CARG C***DATE WRITTEN 770401 (YYMMDD) C***REVISION DATE 820801 (YYMMDD) C***CATEGORY NO. A4A C***KEYWORDS ARGUMENT,COMPLEX,COMPLEX NUMBER,ELEMENTARY FUNCTION C***AUTHOR FULLERTON, W., (LANL) C***PURPOSE Computes the argument of a complex number. C***DESCRIPTION C C CARG(Z) calculates the argument of the complex number Z. Note C that CARG returns a real result. If Z = X+iY, then CARG is ATAN(Y/X), C except when both X and Y are zero, in which case the result C will be zero. C***REFERENCES (NONE) C***ROUTINES CALLED (NONE) C***END PROLOGUE CARG COMPLEX Z C***FIRST EXECUTABLE STATEMENT CARG CARG = 0.0 IF (REAL(Z).NE.0. .OR. AIMAG(Z).NE.0.) CARG = 1 ATAN2 (AIMAG(Z), REAL(Z)) C RETURN END SUBROUTINE CATCHR(AMAT1,AMAT2,AMAT3,Y1,Y2,INDX, 1MAXROM,MAXCOM,NR1,NC1, 1IBUGA3,IERROR) C C PURPOSE--THIS SUBROUTINE COMPUTES THE C CATCHER MATRIX: C C = X(X'X)**(-1) C THIS MATRIX IS USEFUL FOR MANY REGRESSION DIAGNOSTIC C CAPABILITIES. C INPUT ARGUMENTS--AMAT1 = THE DESIGN MATRIX (X) C --AMAT2 = A SCRATCH MATRIX C --Y1 = A SCRATCH VECTOR C --Y2 = A SCRATCH VECTOR C --INDX = A SCRATCH INTEGER) VECTOR C --MAXROM = THE INTEGER ROW DIMENSION OF AMAT1 C --MAXCOM = THE INTEGER COUMN DIMENSION OF AMAT1 C --NR1 = THE INTEGER NUMBER OF ROWS OF AMAT1 C --NC1 = THE INTEGER NUMBER OF COLUMNS OF AMAT1 C OUTPUT ARGUMENTS--AMAT3 = THE SINGLE PRECISION VALUE OF THE C COMPUTED CATCHER MATRTIX C OUTPUT--THE COMPUTED SINGLE PRECISION VALUES OF THE C CATCHER MATRIX. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C LANGUAGE--ANSI FORTRAN (1977) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--2002.6 C ORIGINAL VERSION--JUNE 2002. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGA3 CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION AMAT1(MAXROM,MAXCOM) DIMENSION AMAT2(MAXROM,MAXCOM) DIMENSION AMAT3(MAXROM,MAXCOM) DIMENSION Y1(*) DIMENSION Y2(*) INTEGER INDX(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DATA ZERO /0.0/ DATA ONE /1.0/ DATA EPS /1.0E-20/ C C-----START POINT----------------------------------------------------- C IERROR='NO' C IF(IBUGA3.EQ.'ON')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CATCHR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)MAXROM,MAXCOM,NR1,NC1 53 FORMAT('MAXROM, MAXCOM, NR1, NC1 = ',4I8) CALL DPWRST('XXX','BUG ') ENDIF C C ********************************** C ** COMPUTE CATCHER MATRIX ** C ** 1) COMPUTE X'X ** C ** 2) COMPUTE INVERSE OF X'X ** C ** 3) COMPUTE X TIMES INVERSE ** C ********************************** C DO110J=1,MAXCOM DO120I=1,MAXROM AMAT2(I,J)=ZERO 120 CONTINUE 110 CONTINUE C CALL SGEMM ('T', 'N', NC1, NC1, NR1, ONE, AMAT1, MAXROM, $ AMAT1, MAXROM, ZERO, AMAT2, MAXROM, IERROR) IF(IERROR.EQ.'YES')RETURN C IF(IBUGA3.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,151) 151 FORMAT('***** IN CATCHR, AFTER CALL SGEMM--') CALL DPWRST('XXX','BUG ') DO 152 I=1,NC1 WRITE(ICOUT,153)I,(AMAT2(I,J),J=1,MIN(5,NC1)) 153 FORMAT('***** I,AMAT2(I,1..MIN(NC1,5)',I8,5E15.7) CALL DPWRST('XXX','BUG ') 152 CONTINUE ENDIF C RCOND=0.0 CALL SGECO(AMAT2,MAXROM,NC1,INDX,RCOND,Y1) C IF(IBUGA3.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,171)RCOND 171 FORMAT('***** IN CATCHR, AFTER CALL SGECO, RCOND=',E15.7) CALL DPWRST('XXX','BUG ') DO 172 I=1,NC1 WRITE(ICOUT,173)I,(AMAT2(I,J),J=1,MIN(5,NC1)) 173 FORMAT('***** I,AMAT2(I,1..MIN(NC1,5)',I8,5E15.7) CALL DPWRST('XXX','BUG ') 172 CONTINUE ENDIF C IF(RCOND.LE.EPS)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5171) CALL DPWRST('XXX','ERRO ') WRITE(ICOUT,5172) CALL DPWRST('XXX','ERRO ') WRITE(ICOUT,5173) CALL DPWRST('XXX','ERRO ') IERROR='YES' GOTO9000 ENDIF 5171 FORMAT('*** ERROR FROM CATCHR: UNABLE TO COMPUTE THE INVERSE OF ', 1 'THE X-TRANSPOSE*X MATRIX.') 5172 FORMAT(' PROBLEM: SOME COLUMNS ARE LINEARLY DEPDENDENT ON ', 1 ' OTHER COLUMNS.') 5173 FORMAT(' SUGGESTED SOLUTION: WORK WITH A SUBSET OF THE ', 1 'ORIGINAL COLUMNS.') C IJOB=1 CALL SGEDI(AMAT2,MAXROM,NC1,INDX,Y1,Y2,IJOB) C IF(IBUGA3.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,181) 181 FORMAT('***** IN CATCHR, AFTER CALL SGEDI') CALL DPWRST('XXX','BUG ') DO 182 I=1,NC1 WRITE(ICOUT,183)I,(AMAT2(I,J),J=1,MIN(5,NC1)) 183 FORMAT('***** I,AMAT2(I,1..MIN(NC1,5)',I8,5E15.7) CALL DPWRST('XXX','BUG ') 182 CONTINUE ENDIF C CALL SGEMM ('N', 'N', NR1, NC1, NC1, ONE, AMAT1, MAXROM, $ AMAT2, MAXROM, ZERO, AMAT3, MAXROM, IERROR) IF(IERROR.EQ.'YES')RETURN C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CATCHR--') CALL DPWRST('XXX','BUG ') DO9022I=1,NR1 WRITE(ICOUT,9023)I,(AMAT3(I,J),J=1,MIN(5,NC1)) 9023 FORMAT('***** I,AMAT3(I,1..MIN(NC1,5)',I8,5E15.7) CALL DPWRST('XXX','BUG ') 9022 CONTINUE WRITE(ICOUT,9012)IBUGA3,IERROR 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CATLAN(DX,DCATLN) C C PURPOSE--THIS SUBROUTINE COMPUTES THE CATLAN BETA FUNCTION C FOR REAL ARGUMENTS GREATER THAN OR EQUAL TO 1 USING C EULER-MACMACLAURIN SUMMATION. C CATLAN(X)=SUM((-1)**(K-1)/(2*K+1)**X) WHERE THE SUM IS FROM C 0 TO INFINITY C FOR BETTER COMPUTATIONAL ACCURACY, ACTUALLY C COMPUTE CATLAN(X) - 1. C INPUT ARGUMENTS--DX = THE DOUBLE PRECISION VALUE AT C WHICH THE CATLAN C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--DCATLN = THE DOUBLE PRECISION ZETA C FUNCTION VALUE. C OUTPUT--THE DOUBLE PRECISION CATLAN C FUNCTION VALUE DCATLN. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS C SERIES 55, 1964. C --THOMPSON, "ATLAS FOR COMPUTING MATHEMATICAL C FUNCTIONS", WILEY, 1997. THIS ROUTINE IS A C FORTRAN TRANSLATION OF THE C FUNCTION ON PAGE 150 C OF THIS BOOK. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C LANGUAGE--ANSI FORTRAN (1966) C VERSION NUMBER--97.9 C ORIGINAL VERSION--SEPTEMBER 1997. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C IMPLICIT DOUBLE PRECISION (A-H, O-Z) REAL CPUMAX, CPUMIN C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----DATA STATEMENTS------------------------------------------------- C DATA DEPS/1.0D-20/ C C-----START POINT----------------------------------------------------- C IF(DX.EQ.1.0D0)THEN DCATLN=-0.214601836603 RETURN ENDIF DP=1.0 CALL CATLN2(DEPS,DP,DX,DTERM1) DP=-1.0 CALL CATLN2(DEPS,DP,DX,DTERM2) C CCCCC COMPUTE CATLAN(X) - 1 FOR BETTER ACCURACY. CCCCC DCATLN=DSUM+1.0D0 DCATLN=DTERM1 - DTERM2 RETURN END SUBROUTINE CATLN2(DEPS,DP,DX,DSUM) C C PURPOSE--THIS SUBROUTINE IS USED THE CATLAN SUBROUTINE C IN COMPUTING THE CATLAN BETA FUNCTION. C INPUT ARGUMENTS--DX = THE DOUBLE PRECISION VALUE AT C WHICH THE CATLAN C FUNCTION IS TO BE EVALUATED. C DP = EITHER +1 OR -1 C DEPS = USED TO CONTROL PREFISION C OUTPUT ARGUMENTS--DSUM = SUM RETURNED TO TO THE CATLAN ROUTINE C OUTPUT--THE DOUBLE PRECISION DSUM C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS C SERIES 55, 1964. C --THOMPSON, "ATLAS FOR COMPUTING MATHEMATICAL C FUNCTIONS", WILEY, 1997. THIS ROUTINE IS A C FORTRAN TRANSLATION OF THE C FUNCTION ON PAGE 150 C OF THIS BOOK. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C LANGUAGE--ANSI FORTRAN (1966) C VERSION NUMBER--97.9 C ORIGINAL VERSION--SEPTEMBER 1997. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C IMPLICIT DOUBLE PRECISION (A-H, O-Z) REAL CPUMAX, CPUMIN 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 DTERM=32.0D0*DX*(DX+1.0D0)*(DX+2.0D0)*(DX+3.0D0)* 1 (DX+4.0D0)/945.0D0 DN=(DTERM/DEPS)**(1.0D0/(DX+5.0D0)) IF(DN.LE.5.5D0)THEN N=5 ELSEIF(DN.GE.9999.5)THEN N=10000 ELSE N=INT(DN) ENDIF C FN=DBLE(N) FK=0.0D0 DNEGX=-DX DSUM=0.0D0 DO100K=1,N-1 FK=FK+1.0D0 DSUM=DSUM + (4.0D0*FK+DP)**DNEGX 100 CONTINUE C C ADD EULER-MACLAURIN CORRECTION TERMS C F4NP=4.0D0*FN+DP DSUM=DSUM + (F4NP**DNEGX)*(0.5D0 + 0.25D0*F4NP/(DX-1.0D0) 1 + DX*(1.0D0 - 1 4.0D0*(DX+1.0D0)*(DX+2.0D0)/(15.0D0*F4NP*F4NP))/ 1 (3.0D0*F4NP))+DTERM/(F4NP**(DX+5.0D0)) C 9000 CONTINUE RETURN END SUBROUTINE CAUCDF(X,CDF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--ATAN. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES F. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE: 301-921-2315 C ORIGINAL VERSION--APRIL 1994. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 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--------------------------------------------------------------------- C DATA PI/3.14159265358979/ C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C CDF=0.5+((1.0/PI)*ATAN(X)) C RETURN END SUBROUTINE CAUPDF(X,PDF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE PROBABILITY DENSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION PROBABILITY C DENSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY C FUNCTION VALUE PDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE: 301-921-2315 C ORIGINAL VERSION--APRIL 1994. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 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--------------------------------------------------------------------- C DATA C/.31830988618379/ C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C PDF=C*(1.0/(1.0+X*X)) C RETURN END SUBROUTINE CAUPPC(X,N,IWRITE,Y,W,MAXNYW,PPCC,IBUGA3,IERROR) C C PURPOSE--THIS SUBROUTINE COMPUTES THE CAUCHY C PROBABILITY PLOT CORRELATION COEFFICIENT. C THE PROTOTYPE CAUCHY DISTRIBUTION USED HEREIN C HAS MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI) * (1/(1+X*X)). C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE CAUCHY PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE CAUCHY DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT ARGUMENTS--PPCC = THE SINGLE PRECISION VALUE OF THE C COMPUTED CAUCHY PPCC. C OUTPUT--NONE. C PRINTING--YES. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JULY 1972. C UPDATED --JULY 1981. C UPDATED --AUGUST 1981. C UPDATED --NOVEMBER 1981. C UPDATED --MAY 1982. C UPDATED --JANUARY 1989. MISPLACED PARAM. STATEMENT (ALAN) C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IWRITE CHARACTER*4 IBUGA3 CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION X(*) DIMENSION Y(*) DIMENSION W(*) C C--------------------------------------------------------------------- C INCLUDE 'DPCOPA.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-----DATA STATEMENTS------------------------------------------------- C DATA PI/3.14159265359/ C C-----START POINT----------------------------------------------------- C C IERROR='NO' IUPPER=MAXOBV C SUM1=0.0 SUM2=0.0 SUM3=0.0 C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CAUPPC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)N 53 FORMAT('N = ',I8) CALL DPWRST('XXX','BUG ') DO55I=1,N WRITE(ICOUT,56)I,X(I) 56 FORMAT('I,X(I) = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 55 CONTINUE 90 CONTINUE C C ************************************************ C ** COMPUTE CAUCHY ** C ** PROBABILITY PLOT CORRELATION COEFFICIENT ** C ************************************************ C C ******************************************** C ** STEP 1-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C AN=N C IF(1.LE.N.AND.N.LE.IUPPER)GOTO119 IERROR='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,111) 111 FORMAT('***** ERROR IN CAUPPC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,112) 112 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,113) 113 FORMAT(' IN THE VARIABLE FOR WHICH') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,114) 114 FORMAT(' THE CAUCHY PROBABILITY PLOT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,115) 115 FORMAT(' CORRELATION COEFFICIENT IS TO BE COMPUTED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,116)IUPPER 116 FORMAT(' MUST BE BETWEEN 1 AND ',I8,' (INCLUSIVELY).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,117) 117 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,118)N 118 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8, 1'.') CALL DPWRST('XXX','BUG ') GOTO9000 119 CONTINUE C IF(N.EQ.1)GOTO120 GOTO129 120 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,121) 121 FORMAT('***** NON-FATAL DIAGNOSTIC IN CAUPPC--', 1'THE 2ND INPUT ARGUMENT (N) HAS THE VALUE 1') CALL DPWRST('XXX','BUG ') PPCC=0.0 GOTO9000 129 CONTINUE C HOLD=X(1) DO135I=2,N IF(X(I).NE.HOLD)GOTO139 135 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,136)HOLD 136 FORMAT('***** NON-FATAL DIAGNOSTIC IN CAUPPC--', 1'THE 1ST INPUT ARGUMENT (A VECTOR) HAS ALL ELEMENTS = ',E15.7) CALL DPWRST('XXX','BUG ') PPCC=0.0 GOTO9000 139 CONTINUE C 190 CONTINUE C C ************************************************* C ** STEP 2-- ** C ** COMPUTE THE CAUCHY ** C ** PROBABILITY PLOT CORRELATION COEFFICIENT. ** C ************************************************* C CALL SORT(X,N,Y) C CALL UNIMED(N,W) C DO200I=1,N ARG=PI*W(I) W(I)=-COS(ARG)/SIN(ARG) 200 CONTINUE C SUM1=0.0 DO300I=1,N SUM1=SUM1+Y(I) 300 CONTINUE YBAR=SUM1/AN WBAR=0.0 C SUM1=0.0 SUM2=0.0 SUM3=0.0 DO400I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(W(I)-WBAR)*(Y(I)-YBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 400 CONTINUE PPCC=SUM2/SQRT(SUM3*SUM1) C C ******************************* C ** STEP 3-- ** C ** WRITE OUT A LINE ** C ** OF SUMMARY INFORMATION. ** C ******************************* C IF(IFEEDB.EQ.'OFF')GOTO890 IF(IWRITE.EQ.'OFF')GOTO890 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,811) 811 FORMAT('THE CAUCHY PROBABILITY PLOT CORRELATION COEFFICIENT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,812)N,PPCC 812 FORMAT('OF THE ',I8,' OBSERVATIONS = ',E15.7) CALL DPWRST('XXX','BUG ') 890 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CAUPPC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGA3,IERROR 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)N 9013 FORMAT('N = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)SUM1,SUM2,SUM3 9014 FORMAT('SUM1,SUM2,SUM3 = ',3E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)PPCC 9015 FORMAT('PPCC = ',E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CAUPPF(P,PPF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT C FUNCTION VALUE PPF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----DATA STATEMENTS----------------------------------------------------- C DATA PI/3.14159265359/ C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(ICOUT,1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)P CALL DPWRST('XXX','BUG ') RETURN 90 CONTINUE 1 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ', 1' CAUPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****') C ARG=PI*P PPF=-COS(ARG)/SIN(ARG) C RETURN END SUBROUTINE CAURAN(N,ISEED,X) C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. 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 FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 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 DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGE 15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGE 231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----DATA STATEMENTS------------------------------------------------- C DATA PI/3.14159265359/ C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 GOTO90 50 WRITE(ICOUT, 5) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)N CALL DPWRST('XXX','BUG ') RETURN 90 CONTINUE 5 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ', 1'CAURAN SUBROUTINE IS NON-POSITIVE *****') 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8 ,' *****') C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N CAUCHY RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N ARG=PI*X(I) X(I)=-COS(ARG)/SIN(ARG) 100 CONTINUE C RETURN END SUBROUTINE CAUSF(P,SF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY C FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION C IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION, C AND ALSO IS THE RECIPROCAL OF THE PROBABILITY C DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X). C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE SPARSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--SF = THE SINGLE PRECISION C SPARSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION SPARSITY C FUNCTION VALUE SF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SIN. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE: 301-921-2315 C ORIGINAL VERSION--APRIL 1994. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- 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--------------------------------------------------------------------- C DATA PI/3.14159265358979/ C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 CONTINUE WRITE(ICOUT,1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)P RETURN 1 FORMAT('***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE') 2 FORMAT(' CAUPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1)') 3 FORMAT(' INTERVAL *****') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****') C 90 CONTINUE C C-----START POINT----------------------------------------------------- C ARG=PI*P SF=PI/((SIN(ARG))**2) C RETURN END COMPLEX FUNCTION CBETA(A,B,IERR2) C***BEGIN PROLOGUE CBETA C***DATE WRITTEN 770701 (YYMMDD) C***REVISION DATE 820801 (YYMMDD) C***CATEGORY NO. C7B C***KEYWORDS BETA FUNCTION,COMPLETE BETA FUNCTION,COMPLEX, C SPECIAL FUNCTION C***AUTHOR FULLERTON, W., (LANL) C***PURPOSE CBETA computes the complete Beta function of complex C parameters A and B. C***DESCRIPTION C C CBETA computes the complete beta function of complex parameters A C and B. C Input Parameters: C A complex and the real part of A positive C B complex and the real part of B positive C***REFERENCES (NONE) C***ROUTINES CALLED CGAMMA,CLBETA,GAMLIM,XERROR C***END PROLOGUE CBETA 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 COMPLEX A, B, CGAMMA, CLBETA, CEXP DATA XMAX / 0.0 / C***FIRST EXECUTABLE STATEMENT CBETA IERR2=0 IF (XMAX.EQ.0.0) CALL GAMLIM (XMIN, XMAX) C IF (REAL(A).LE.0.0 .OR. REAL(B).LE.0.0) THEN CCCCC CALL XERROR ( 'CBETA REA CCCCC1L PART OF BOTH ARGUMENTS MUST BE GT 0', 48, 1, 2) WRITE(ICOUT,11) CALL DPWRST('XXX','BUG ') ENDIF 11 FORMAT('***** ERROR FROM CBETA: REAL PARTS OF PARAMETER', 1 'MUST BE POSITIVE') C IF (REAL(A)+REAL(B).LT.XMAX) CBETA = CGAMMA(A) * (CGAMMA(B)/ 1 CGAMMA(A+B) ) IF (REAL(A)+REAL(B).LT.XMAX) RETURN C CBETA = CEXP (CLBETA(A, B)) C RETURN END SUBROUTINE CC(X,N,ENGLSL,ENGUSL,TARGET,IWRITE,XCC, 1IBUGA3,IERROR) C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE CC (PROCESS CAPABILITY INDEX) C OF THE DATA IN THE INPUT VECTOR X. C CC = MAX((TARGET-MU)/(TARGET-LSL),(MU-TARGET)/(USL)) C NOTE--CC IS A MEASURE OF PROCESS ACCURACY-- C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --ENGLSL = LOWER (ENGINEERING) SPEC LIMIT C --ENGUSL = UPPER (ENGINEERING) SPEC LIMIT C --TARGET = TARGET (ENGINEERING) SPEC LIMIT C OUTPUT ARGUMENTS--CC = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE CC C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE CC INDEX C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--MEAN AND SD. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--NORMA HUBELE, ARIZONA STATE C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--98.11 C ORIGINAL VERSION--NOVEMBER 1998. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IWRITE CHARACTER*4 IBUGA3 CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DOUBLE PRECISION DN DOUBLE PRECISION DX DOUBLE PRECISION DSUM DOUBLE PRECISION DMEAN C DOUBLE PRECISION DUSL DOUBLE PRECISION DLSL DOUBLE PRECISION DTARG DOUBLE PRECISION DNUM DOUBLE PRECISION DDEN DOUBLE PRECISION DCC C DIMENSION X(*) 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 IERROR='NO' C DMEAN=0.0D0 C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)N 53 FORMAT('N = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ENGUSL,ENGLSL 54 FORMAT('ENGUSL,ENGLSL = ',2E15.7) CALL DPWRST('XXX','BUG ') DO55I=1,N WRITE(ICOUT,56)I,X(I) 56 FORMAT('I,X(I) = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 55 CONTINUE 90 CONTINUE C C ******************************************** C ** COMPUTE PROCESS CAPABILITY INDEX CC ** C ******************************************** C C ******************************************** C ** STEP 1-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C IF(N.GE.1)GOTO119 IERROR='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,111) 111 FORMAT('***** ERROR IN CC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,112) 112 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,113) 113 FORMAT(' IN THE VARIABLE FOR WHICH') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,114) 114 FORMAT(' THE CC STATISTIC IS TO BE COMPUTED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,115) 115 FORMAT(' MUST BE 1 OR LARGER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,116) 116 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,117)N 117 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8, 1'.') CALL DPWRST('XXX','BUG ') GOTO9000 119 CONTINUE C C *************************************** C ** STEP 2-- ** C ** COMPUTE THE STANDARD DEVIATION. ** C *************************************** C DN=N DSUM=0.0D0 DO200I=1,N DX=X(I) DSUM=DSUM+DX 200 CONTINUE DMEAN=DSUM/DN C C ************************************************** C ** STEP 3-- ** C ** COMPUTE THE CC RATIO ** C ************************************************** C DUSL=ENGUSL DLSL=ENGLSL DTARG=TARGET C DNUM=(DTARG-DMEAN)/(DTARG-DLSL) DDEN=(DMEAN-DTARG)/DUSL C DCC=MAX(DNUM,DDEN) XCC=REAL(DCC) C C ******************************* C ** STEP 3-- ** C ** WRITE OUT A LINE ** C ** OF SUMMARY INFORMATION. ** C ******************************* C IF(IFEEDB.EQ.'OFF')GOTO890 IF(IWRITE.EQ.'OFF')GOTO890 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,811)N,XCC 811 FORMAT('THE CC OF THE ',I8,' OBSERVATIONS = ', 1E15.7) CALL DPWRST('XXX','BUG ') 890 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGA3,IERROR 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)N 9013 FORMAT('N = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)DMEAN 9014 FORMAT('DMEAN = ',D15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)DUSL,DLSL 9016 FORMAT('DUSL,DLSL = ',2D15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)DNUM,DDEN,DCC,XCC 9017 FORMAT('DNUM,DDEN,DCC,XCC = ',3D15.7,E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END COMPLEX FUNCTION CCOT(Z) C***BEGIN PROLOGUE CCOT C***DATE WRITTEN 770401 (YYMMDD) C***REVISION DATE 820801 (YYMMDD) C***CATEGORY NO. C4A C***KEYWORDS COMPLEX,COTANGENT,ELEMENTARY FUNCTION C***AUTHOR FULLERTON, W., (LANL) C***PURPOSE Computes the complex Cotangent. C***DESCRIPTION C C CCOT(Z) calculates the comlex trigonometric cotangent of Z. C***REFERENCES (NONE) C***ROUTINES CALLED R1MACH,XERCLR,XERROR C***END PROLOGUE CCOT COMPLEX Z C INCLUDE 'DPCOMC.INC' CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DATA SQEPS /0./ C***FIRST EXECUTABLE STATEMENT CCOT IF (SQEPS.EQ.0.) SQEPS = SQRT (R1MACH(4)) C X2 = 2.0*REAL(Z) Y2 = 2.0*AIMAG(Z) C SN2X = SIN (X2) CCCCC CALL XERCLR C DEN = COSH(Y2) - COS(X2) IF (DEN.EQ.0.) THEN CCCCC CALL XERROR ( 'CCOT COT IS SINGULAR FOR INPUT Z CCCCC1 (X IS 0 OR PI AND Y IS 0)' , 61, 2, 2) WRITE(ICOUT,102) CALL DPWRST('XXX','BUG ') RETURN ENDIF 102 FORMAT('***** INTERNAL ERROR FROM CCOT: COT IS SINGULAR') C IF (ABS(DEN).GT.AMAX1(ABS(X2),1.)*SQEPS) GO TO 10 CCCCC CALL XERCLR CCCCC CALL XERROR ( 'CCOT ANSWER LT HALF PRECISION, ABS(X) TOO BIG OR CCCCC1 X TOO NEAR 0 OR PI', 70, 1, 1) WRITE(ICOUT,202) CALL DPWRST('XXX','BUG ') 202 FORMAT('***** INTERNAL WARNING FROM CCOT: ANSWER IS LESS THAN' 1,' HALF PRECISION BECAUSE ABS(X) IS TOO LARGE') WRITE(ICOUT,203) CALL DPWRST('XXX','BUG ') 203 FORMAT(' OR X IS TOO NEAR 0 OR PI') C 10 CCOT = CMPLX (SN2X/DEN, -SINH(Y2)/DEN) C RETURN END DOUBLE PRECISION FUNCTION CDFGLO(X,PARA) C===================================================== CDFGLO.FOR C*********************************************************************** C* * C* FORTRAN CODE WRITTEN FOR INCLUSION IN IBM RESEARCH REPORT RC20525, * C* 'FORTRAN ROUTINES FOR USE WITH THE METHOD OF L-MOMENTS, VERSION 3' * C* * C* J. R. M. HOSKING * C* IBM RESEARCH DIVISION * C* T. J. WATSON RESEARCH CENTER * C* YORKTOWN HEIGHTS * C* NEW YORK 10598, U.S.A. * C* * C* VERSION 3 AUGUST 1996 * C* * C*********************************************************************** C C DISTRIBUTION FUNCTION OF THE GENERALIZED LOGISTIC DISTRIBUTION C IMPLICIT DOUBLE PRECISION (A-H,O-Z) DOUBLE PRECISION PARA(3) C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C REAL CPUMIN REAL CPUMAX COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DATA ZERO/0.0D0/,ONE/1.0D0/ C C SMALL IS USED TO TEST WHETHER X IS EFFECTIVELY AT C THE ENDPOINT OF THE DISTRIBUTION C DATA SMALL/1.0D-15/ C U=PARA(1) A=PARA(2) G=PARA(3) C IF(A.LE.ZERO)THEN CDFGLO=ZERO WRITE(ICOUT,7000) 7000 FORMAT('***** ERROR IN GL5CDF--NON-POSITIVE SCALE ', 1 'PARAMETER IS INVALID.') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,7005) 7005 FORMAT(' L-MOMENTS INVALID') CALL DPWRST('XXX','WRIT') GOTO 9000 ENDIF C Y=(X-U)/A IF(G.EQ.ZERO)GOTO 20 ARG=ONE-G*Y IF(ARG.GT.SMALL)GOTO 10 IF(G.LT.ZERO)CDFGLO=ZERO IF(G.GT.ZERO)CDFGLO=ONE GOTO9000 C 10 CONTINUE Y=-DLOG(ARG)/G 20 CONTINUE CDFGLO=ONE/(ONE+DEXP(-Y)) C 9000 CONTINUE RETURN END DOUBLE PRECISION FUNCTION CDFWAK(X,PARA) C===================================================== CDFWAK.FOR C*********************************************************************** C* * C* FORTRAN CODE WRITTEN FOR INCLUSION IN IBM RESEARCH REPORT RC20525, * C* 'FORTRAN ROUTINES FOR USE WITH THE METHOD OF L-MOMENTS, VERSION 3' * C* * C* J. R. M. HOSKING * C* IBM RESEARCH DIVISION * C* T. J. WATSON RESEARCH CENTER * C* YORKTOWN HEIGHTS * C* NEW YORK 10598, U.S.A. * C* * C* VERSION 3 AUGUST 1996 * C* * C*********************************************************************** C C CUMULATIVE DISTRIBUTION FUNCTION OF THE WAKEBY DISTRIBUTION C C OTHER ROUTINES USED: QUAWAK C C METHOD: THE EQUATION X=G(Z), WHERE G(Z) IS THE WAKEBY QUANTILE C EXPRESSED AS A FUNCTION OF Z=-LOG(1-F), IS SOLVED USING HALLEY'S C METHOD (THE 2ND-ORDER ANALOGUE OF NEWTON-RAPHSON ITERATION). C IMPLICIT DOUBLE PRECISION (A-H,O-Z) DOUBLE PRECISION PARA(5) C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C REAL CPUMIN REAL CPUMAX COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DATA ZERO/0.0D0/,HALF/0.5D0/,ONE/1.0D0/ DATA P1/0.1D0/,P7/0.7D0/,P99/0.99D0/ C C EPS,MAXIT CONTROL THE TEST FOR CONVERGENCE OF THE ITERATION C ZINCMX IS THE LARGEST PERMITTED ITERATIVE STEP C ZMULT CONTROLS WHAT HAPPENS WHEN THE ITERATION STEPS BELOW ZERO C UFL SHOULD BE CHOSEN SO THAT DEXP(UFL) JUST DOES NOT CAUSE C UNDERFLOW C DATA EPS/1.0D-8/,MAXIT/20/,ZINCMX/3.0D0/,ZMULT/0.2D0/ DATA UFL/-170.0D0/ C XI=PARA(1) A=PARA(2) B=PARA(3) C=PARA(4) D=PARA(5) C C TEST FOR VALID PARAMETERS C IF(B+D.LE.ZERO.AND.(B.NE.ZERO.OR.C.NE.ZERO.OR.D.NE.ZERO))GOTO 1000 IF(A.EQ.ZERO.AND.B.NE.ZERO)GOTO 1000 IF(C.EQ.ZERO.AND.D.NE.ZERO)GOTO 1000 IF(C.LT.ZERO.OR.A+C.LT.ZERO)GOTO 1000 IF(A.EQ.ZERO.AND.C.EQ.ZERO)GOTO 1000 C CDFWAK=ZERO IF(X.LE.XI)RETURN C C TEST FOR SPECIAL CASES C IF(B.EQ.ZERO.AND.C.EQ.ZERO.AND.D.EQ.ZERO)GOTO 100 IF(C.EQ.ZERO)GOTO 110 IF(A.EQ.ZERO)GOTO 120 C C GENERAL CASE C CDFWAK=ONE IF(D.LT.ZERO.AND.X.GE.XI+A/B-C/D)GOTO9000 C C INITIAL VALUES FOR ITERATION: C IF X IS IN THE LOWEST DECILE OF THE DISTRIBUTION, START AT Z=0 C (F=0); C IF X IS IN THE HIGHEST PERCENTILE OF THE DISTRIBUTION, C STARTING VALUE IS OBTAINED FROM ASYMPTOTIC FORM OF THE C DISTRIBUTION FOR LARGE Z (F NEAR 1); C OTHERWISE START AT Z=0.7 (CLOSE TO F=0.5). C Z=P7 IF(X.LT.QUAWAK(P1,PARA))Z=ZERO IF(X.LT.QUAWAK(P99,PARA))GOTO 10 IF(D.LT.ZERO)Z=DLOG((X-XI-A/B)*D/C+ONE)/D IF(D.EQ.ZERO)Z=(X-XI-A/B)/C IF(D.GT.ZERO)Z=DLOG((X-XI)*D/C+ONE)/D 10 CONTINUE C C HALLEY'S METHOD, WITH MODIFICATIONS: C IF HALLEY ITERATION WOULD MOVE IN WRONG DIRECTION C (TEMP.LE.ZERO), USE ORDINARY NEWTON-RAPHSON INSTEAD; C IF STEP GOES TOO FAR (ZINC.GT.ZINCMX OR ZNEW.LE.ZERO), C LIMIT ITS LENGTH. C DO 30 IT=1,MAXIT EB=ZERO BZ=-B*Z IF(BZ.GE.UFL)EB=DEXP(BZ) GB=Z IF(DABS(B).GT.EPS)GB=(ONE-EB)/B ED=DEXP(D*Z) GD=-Z IF(DABS(D).GT.EPS)GD=(ONE-ED)/D XEST=XI+A*GB-C*GD FUNC=X-XEST DERIV1=A*EB+C*ED DERIV2=-A*B*EB+C*D*ED TEMP=DERIV1+HALF*FUNC*DERIV2/DERIV1 IF(TEMP.LE.ZERO)TEMP=DERIV1 ZINC=FUNC/TEMP IF(ZINC.GT.ZINCMX)ZINC=ZINCMX ZNEW=Z+ZINC IF(ZNEW.LE.ZERO)GOTO 20 Z=ZNEW IF(DABS(ZINC).LE.EPS)GOTO 200 GOTO 30 20 CONTINUE Z=Z*ZMULT 30 CONTINUE C C NOT CONVERGED C WRITE(ICOUT,7010) 7010 FORMAT('***** WARNING IN WAKCDF--') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,7012) 7012 FORMAT(' ITERATION HAS NOT CONVERGED. THE RESULT ', 1 'MAY NOT BE RELIABLE.') CALL DPWRST('XXX','WRIT') GOTO 200 C C SPECIAL CASE B=C=D=0: WAKEBY IS EXPONENTIAL C 100 CONTINUE Z=(X-XI)/A GOTO 200 C C SPECIAL CASE C=0: WAKEBY IS GENERALIZED PARETO, BOUNDED ABOVE C 110 CONTINUE CDFWAK=ONE IF(X.GE.XI+A/B)RETURN Z=-DLOG(ONE-(X-XI)*B/A)/B GOTO 200 C C SPECIAL CASE A=0: WAKEBY IS GENERALIZED PARETO, NO UPPER BOUND C 120 CONTINUE Z=DLOG(ONE+(X-XI)*D/C)/D GOTO 200 C C CONVERT Z VALUE TO PROBABILITY C 200 CDFWAK=ONE IF(-Z.LT.UFL)GOTO9000 CDFWAK=ONE-DEXP(-Z) GOTO9000 C 1000 CONTINUE WRITE(ICOUT,7000) 7000 FORMAT('***** ERROR IN WAKCDF--PARAMETERS INVALID.') CALL DPWRST('XXX','WRIT') CDFWAK=ZERO GOTO9000 C 9000 CONTINUE RETURN END SUBROUTINE CHASE(A,X,Y,IMX,JMX,I,J,NS,CN,XC,YC,NMX,N,BOX) C C PURPOSE--XX 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 UPDATED --JANUARY 1989. MORE CHANGES TO STANDARD FORTRAN 77-- C BYTE TO CHARACTER*1, C DO WHILE/END DO (ALAN HECKERT). C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOCP.INC' C C--------------------------------------------------------------------- C CCCCC BYTE BOX(4,IMX,JMX) JANUARY 1989 CCCCC DIMENSION A(IMX,JMX),X(IMX),Y(JMX),XC(NMX),YC(NMX) CCCCC DIMENSION XP(3),YP(3),LP(3) C CCCCC BYTE BOX JANUARY 1989 CHARACTER*1 BOX CHARACTER*1 ITEMP C DIMENSION A(MAXIMX,MAXJMX) DIMENSION X(*) DIMENSION Y(*) DIMENSION XC(*) DIMENSION YC(*) DIMENSION BOX(4,MAXIMX,MAXJMX) C DIMENSION XP(3) DIMENSION YP(3) DIMENSION LP(3) C C-----START POINT----------------------------------------------------- C IO=0 CCCCC DO WHILE ((BOX(NS,I,J).EQ.0.OR.BOX(NS,I,J).EQ.2).AND.IO.EQ.0) 99 CONTINUE IF((BOX(NS,I,J).EQ.'0'.OR.BOX(NS,I,J).EQ.'2').AND.IO.EQ.0)GOTO100 GOTO199 100 CONTINUE ITEMP=BOX(NS,I,J) CALL DPCOAN(ITEMP,IJUNK) IJUNK=IJUNK+1 CALL DPCONA(IJUNK,ITEMP) BOX(NS,I,J)=ITEMP CCCCC BOX(NS,I,J)=BOX(NS,I,J)+1 DO110L=1,3 XP(L)=0. YP(L)=0. 110 CONTINUE NXT=0 DO120LL=NS+1,NS+3 L=MOD((LL-1),4)+1 IF (BOX(L,I,J).EQ.'0'.OR.BOX(L,I,J).EQ.'2') THEN IF (L.EQ.1) THEN DNM=A(I,J+1)-A(I,J) IF (DNM.NE.0.) THEN R=(CN-A(I,J))/DNM ELSE R=-1. END IF IF ((R.GT.0..AND.R.LT.1.).OR. 1 (R.EQ.0..AND.DNM.LT.0.).OR. 2 (R.EQ.1..AND.DNM.GT.0.)) THEN NXT=NXT+1 LP(NXT)=1 XP(NXT)=X(I) YP(NXT)=Y(J)+R*(Y(J+1)-Y(J)) END IF ELSE IF (L.EQ.2) THEN DNM=A(I+1,J+1)-A(I,J+1) IF (DNM.NE.0.) THEN R=(CN-A(I,J+1))/DNM ELSE R=-1. END IF IF ((R.GT.0..AND.R.LT.1.).OR. 1 (R.EQ.0..AND.DNM.LT.0.).OR. 2 (R.EQ.1..AND.DNM.GT.0.)) THEN NXT=NXT+1 LP(NXT)=2 XP(NXT)=X(I)+R*(X(I+1)-X(I)) YP(NXT)=Y(J+1) END IF ELSE IF (L.EQ.3) THEN DNM=A(I+1,J)-A(I+1,J+1) IF (DNM.NE.0.) THEN R=(CN-A(I+1,J+1))/DNM ELSE R=-1. END IF IF ((R.GT.0..AND.R.LT.1.).OR. 1 (R.EQ.0..AND.DNM.LT.0.).OR. 2 (R.EQ.1..AND.DNM.GT.0.)) THEN NXT=NXT+1 LP(NXT)=3 XP(NXT)=X(I+1) YP(NXT)=Y(J+1)+R*(Y(J)-Y(J+1)) END IF ELSE IF (L.EQ.4) THEN DNM=A(I,J)-A(I+1,J) IF (DNM.NE.0.) THEN R=(CN-A(I+1,J))/DNM ELSE R=-1. END IF IF ((R.GT.0..AND.R.LT.1.).OR. 1 (R.EQ.0..AND.DNM.LT.0.).OR. 2 (R.EQ.1..AND.DNM.GT.0.)) THEN NXT=NXT+1 LP(NXT)=4 XP(NXT)=X(I+1)+R*(X(I)-X(I+1)) YP(NXT)=Y(J) END IF END IF END IF 120 CONTINUE IF (NXT.EQ.0) THEN NS=-1 GOTO9000 ELSE IF (NXT.EQ.1) THEN LN=1 ELSE IF (NXT.EQ.2) THEN LN=1 PRINT *,' WARNING! CELL HAS 2 EXITS!' ELSE D1=(XC(N)-XP(1))**2+(YC(N)-YP(1))**2 D2=(XC(N)-XP(3))**2+(YC(N)-YP(3))**2 IF (D1.LE.D2) THEN LN=1 ELSE LN=3 END IF END IF N=N+1 XC(N)=XP(LN) YC(N)=YP(LN) L=LP(LN) ITEMP=BOX(L,I,J) CALL DPCOAN(ITEMP,IJUNK) IJUNK=IJUNK+1 CALL DPCONA(IJUNK,ITEMP) BOX(L,I,J)=ITEMP CCCCC BOX(L,I,J)=BOX(L,I,J)+1 IF (BOX(L,I,J).EQ.'3') THEN IO=1 ELSE ML2=MOD(L,2) I=I+ML2*(L-2) J=J+(ML2-1)*(L-3) NS=MOD((L+ML2),4)+2-ML2 IO=0 END IF GOTO99 199 CONTINUE NS=-1 GOTO9000 C 9000 CONTINUE RETURN END SUBROUTINE CDIV(AR,AI,BR,BI,CR,CI) C***BEGIN PROLOGUE CDIV C***REFER TO EISDOC C C Complex division, (CR,CI) = (AR,AI)/(BR,BI) C***ROUTINES CALLED (NONE) C***END PROLOGUE CDIV REAL AR,AI,BR,BI,CR,CI C REAL S,ARS,AIS,BRS,BIS C***FIRST EXECUTABLE STATEMENT CDIV S = ABS(BR) + ABS(BI) ARS = AR/S AIS = AI/S BRS = BR/S BIS = BI/S S = BRS**2 + BIS**2 CR = (ARS*BRS + AIS*BIS)/S CI = (AIS*BRS - ARS*BIS)/S RETURN END SUBROUTINE CFFT2D(N,F,LDF,W,FORWD) C***BEGIN PROLOGUE CFFT2D C***DATE WRITTEN 870811 (YYMMDD) C***REVISION DATE 870811 (YYMMDD) C***CATEGORY NO. J1B C***KEYWORDS TWO DIMENSIONAL FOURIER TRANSFORM, FFT C***AUTHOR KAHANER, DAVID K., (NBS) C***PURPOSE Two dimensional complex fast Fourier transform. C***DESCRIPTION C From the book, "Numerical Methods and Software" by C D. Kahaner, C. Moler, S. Nash C Prentice Hall, 1988 C Two dimensional fast Fourier transform, forward or backward C of complex N*N matrix F. C C Input: C N: (INTEGER) Number of rows and columns in the matrix F to be C transformed. You must set N > 0, NOT CHECKED. C F: (COMPLEX) Array of N*N complex values to be transformed. C This array is overwritten on output. C LDF: (INTEGER) Leading (first) dimension of the complex array F C in the subroutine that calls CFFT2D. For example, C if you declare F by either C COMPLEX F(0:15,0:20) OR F(16,21) then C set LDF=16. You must have LDF >= N, NOT CHECKED. C W: (COMPLEX) Array for internal use as work storage. C Must be dimensioned by calling program to be C at least 6N+15 REAL words or 3N+8 COMPLEX words. C FORWD: (LOGICAL) Direction of transform. Set to .TRUE. for C forward transform, set to .FALSE. for backward C transform. C C C Output: C F: (COMPLEX) Forward or reverse transformed input matrix. C Output is unscaled, that is, a call to CFFT2D C with FORWD=.TRUE. followed by a call to CFFT2D C with FORWD=.FALSE. returns original data C multiplied by N*N. C C C Remark: C For some applications it is desirable to have the transform scaled so C the center of the N by N frequency square corresponds to zero C frequency. The user can do this replacing the original input data C F(I,J) by F(I,J)*(-1.)**(I+J), I,J =0,...,N-1. C C C***REFERENCES (NONE) C***ROUTINES CALLED CFFTI, CFFTF, CFFTB C***END PROLOGUE CFFT2D COMPLEX F(0:LDF-1,0:*), W(0:*) LOGICAL FORWD C***FIRST EXECUTABLE STATEMENT CFFT2D C Find transform of each row, then of each column C First row transforms CALL CFFTI(N,W(N)) DO 10 I=0,N-1 C Place row in beginning of array W DO 5 J=0,N-1 W(J) = F(I,J) 5 CONTINUE C Compute fft of row IF(FORWD) THEN CALL CFFTF(N,W,W(N)) ELSE CALL CFFTB(N,W,W(N)) ENDIF C Copy back to row of f DO 6 J=0,N-1 F(I,J)=W(J) 6 CONTINUE 10 CONTINUE C Column transforms DO 20 J=0,N-1 C Pass column of F to CFFTF or CFFTB by passing F(0,J). C Similarly CFFTF or CFFTB places results back there. IF(FORWD) THEN CALL CFFTF(N, F(0,J), W(N)) ELSE CALL CFFTB(N, F(0,J), W(N)) ENDIF 20 CONTINUE RETURN END SUBROUTINE CFFTB(N,C,WSAVE) C***BEGIN PROLOGUE CFFTB C***DATE WRITTEN 790601 (YYMMDD) C***REVISION DATE 860115 (YYMMDD) C***CATEGORY NO. J1A2 C***KEYWORDS FOURIER TRANSFORM C***AUTHOR SWARZTRAUBER, P. N., (NCAR) C***PURPOSE Unnormalized inverse of CFFTF. C***DESCRIPTION C From the book, "Numerical Methods and Software" by C D. Kahaner, C. Moler, S. Nash C Prentice Hall, 1988 C C Subroutine CFFTB computes the backward complex discrete Fourier C transform (the Fourier synthesis). Equivalently, CFFTB computes C a complex periodic sequence from its Fourier coefficients. C The transform is defined below at output parameter C. C C A call of CFFTF followed by a call of CFFTB will multiply the C sequence by N. C C The array WSAVE which is used by subroutine CFFTB must be C initialized by calling subroutine CFFTI(N,WSAVE). C C Input Parameters C C C N the length of the complex sequence C. The method is C more efficient when N is the product of small primes. C C C a complex array of length N which contains the sequence C C WSAVE a real work array which must be dimensioned at least 4*N+15 C in the program that calls CFFTB. The WSAVE array must be C initialized by calling subroutine CFFTI(N,WSAVE), and a C different WSAVE array must be used for each different C value of N. This initialization does not have to be C repeated so long as N remains unchanged. Thus subsequent C transforms can be obtained faster than the first. C The same WSAVE array can be used by CFFTF and CFFTB. C C Output Parameters C C C For J=1,...,N C C C(J)=the sum from K=1,...,N of C C C(K)*EXP(I*J*K*2*PI/N) C C where I=SQRT(-1) C C WSAVE contains initialization calculations which must not be C destroyed between calls of subroutine CFFTF or CFFTB C C * References * C * * C * 1. P.N. Swarztrauber, Vectorizing the FFTs, in Parallel * C * Computations (G. Rodrigue, ed.), Academic Press, 1982, * C * pp. 51-83. * C * 2. B.L. Buzbee, The SLATEC Common Math Library, in Sources * C * and Development of Mathematical Software (W. Cowell, ed.), * C * Prentice-Hall, 1984, pp. 302-318. * C * * C ********************************************************************* C C***REFERENCES (NONE) C***ROUTINES CALLED CFFTB1 C***END PROLOGUE CFFTB DIMENSION C(*) ,WSAVE(*) C***FIRST EXECUTABLE STATEMENT CFFTB IF (N .EQ. 1) RETURN IW1 = N+N+1 IW2 = IW1+N+N CALL CFFTB1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2)) RETURN END SUBROUTINE CFFTB1(N,C,CH,WA,IFAC) C***BEGIN PROLOGUE CFFTB1 C***REFER TO CFFTB C***ROUTINES CALLED PASSB,PASSB2,PASSB3,PASSB4,PASSB5 C***END PROLOGUE CFFTB1 DIMENSION CH(*) ,C(*) ,WA(*) ,IFAC(*) C***FIRST EXECUTABLE STATEMENT CFFTB1 NF = IFAC(2) NA = 0 L1 = 1 IW = 1 DO 116 K1=1,NF IP = IFAC(K1+2) L2 = IP*L1 IDO = N/L2 IDOT = IDO+IDO IDL1 = IDOT*L1 IF (IP .NE. 4) GO TO 103 IX2 = IW+IDOT IX3 = IX2+IDOT IF (NA .NE. 0) GO TO 101 CALL PASSB4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3)) GO TO 102 101 CALL PASSB4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3)) 102 NA = 1-NA GO TO 115 103 IF (IP .NE. 2) GO TO 106 IF (NA .NE. 0) GO TO 104 CALL PASSB2 (IDOT,L1,C,CH,WA(IW)) GO TO 105 104 CALL PASSB2 (IDOT,L1,CH,C,WA(IW)) 105 NA = 1-NA GO TO 115 106 IF (IP .NE. 3) GO TO 109 IX2 = IW+IDOT IF (NA .NE. 0) GO TO 107 CALL PASSB3 (IDOT,L1,C,CH,WA(IW),WA(IX2)) GO TO 108 107 CALL PASSB3 (IDOT,L1,CH,C,WA(IW),WA(IX2)) 108 NA = 1-NA GO TO 115 109 IF (IP .NE. 5) GO TO 112 IX2 = IW+IDOT IX3 = IX2+IDOT IX4 = IX3+IDOT IF (NA .NE. 0) GO TO 110 CALL PASSB5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4)) GO TO 111 110 CALL PASSB5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4)) 111 NA = 1-NA GO TO 115 112 IF (NA .NE. 0) GO TO 113 CALL PASSB (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW)) GO TO 114 113 CALL PASSB (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW)) 114 IF (NAC .NE. 0) NA = 1-NA 115 L1 = L2 IW = IW+(IP-1)*IDOT 116 CONTINUE IF (NA .EQ. 0) RETURN N2 = N+N DO 117 I=1,N2 C(I) = CH(I) 117 CONTINUE RETURN END SUBROUTINE CFFTF(N,C,WSAVE) C***BEGIN PROLOGUE CFFTF C***DATE WRITTEN 790601 (YYMMDD) C***REVISION DATE 860115 (YYMMDD) C***CATEGORY NO. J1A2 C***KEYWORDS FOURIER TRANSFORM C***AUTHOR SWARZTRAUBER, P. N., (NCAR) C***PURPOSE Forward transform of a complex, periodic sequence. C***DESCRIPTION C From the book, "Numerical Methods and Software" by C D. Kahaner, C. Moler, S. Nash C Prentice Hall, 1988 C C Subroutine CFFTF computes the forward complex discrete Fourier C transform (the Fourier analysis). Equivalently, CFFTF computes C the Fourier coefficients of a complex periodic sequence. C The transform is defined below at output parameter C. C C The transform is not normalized. To obtain a normalized transform C the output must be divided by N. Otherwise a call of CFFTF C followed by a call of CFFTB will multiply the sequence by N. C C The array WSAVE which is used by subroutine CFFTF must be C initialized by calling subroutine CFFTI(N,WSAVE). C C Input Parameters C C C N the length of the complex sequence C. The method is C more efficient when N is the product of small primes. C C C a complex array of length N which contains the sequence C C WSAVE a real work array which must be dimensioned at least 4*N+15 C in the program that calls CFFTF. The WSAVE array must be C initialized by calling subroutine CFFTI(N,WSAVE), and a C different WSAVE array must be used for each different C value of N. This initialization does not have to be C repeated so long as N remains unchanged. Thus subsequent C transforms can be obtained faster than the first. C The same WSAVE array can be used by CFFTF and CFFTB. C C Output Parameters C C C for J=1,...,N C C C(J)=the sum from K=1,...,N of C C C(K)*EXP(-I*J*K*2*PI/N) C C where I=SQRT(-1) C C WSAVE contains initialization calculations which must not be C destroyed between calls of subroutine CFFTF or CFFTB C C * References * C * * C * 1. P.N. Swarztrauber, Vectorizing the FFTs, in Parallel * C * Computations (G. Rodrigue, ed.), Academic Press, 1982, * C * pp. 51-83. * C * 2. B.L. Buzbee, The SLATEC Common Math Library, in Sources * C * and Development of Mathematical Software (W. Cowell, ed.), * C * Prentice-Hall, 1984, pp. 302-318. * C * * C ********************************************************************* C C***REFERENCES (NONE) C***ROUTINES CALLED CFFTF1 C***END PROLOGUE CFFTF DIMENSION C(*) ,WSAVE(*) C***FIRST EXECUTABLE STATEMENT CFFTF IF (N .EQ. 1) RETURN IW1 = N+N+1 IW2 = IW1+N+N CALL CFFTF1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2)) RETURN END SUBROUTINE CFFTF1(N,C,CH,WA,IFAC) C***BEGIN PROLOGUE CFFTF1 C***REFER TO CFFTF C***ROUTINES CALLED PASSF,PASSF2,PASSF3,PASSF4,PASSF5 C***END PROLOGUE CFFTF1 DIMENSION CH(*) ,C(*) ,WA(*) ,IFAC(*) C***FIRST EXECUTABLE STATEMENT CFFTF1 NF = IFAC(2) NA = 0 L1 = 1 IW = 1 DO 116 K1=1,NF IP = IFAC(K1+2) L2 = IP*L1 IDO = N/L2 IDOT = IDO+IDO IDL1 = IDOT*L1 IF (IP .NE. 4) GO TO 103 IX2 = IW+IDOT IX3 = IX2+IDOT IF (NA .NE. 0) GO TO 101 CALL PASSF4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3)) GO TO 102 101 CALL PASSF4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3)) 102 NA = 1-NA GO TO 115 103 IF (IP .NE. 2) GO TO 106 IF (NA .NE. 0) GO TO 104 CALL PASSF2 (IDOT,L1,C,CH,WA(IW)) GO TO 105 104 CALL PASSF2 (IDOT,L1,CH,C,WA(IW)) 105 NA = 1-NA GO TO 115 106 IF (IP .NE. 3) GO TO 109 IX2 = IW+IDOT IF (NA .NE. 0) GO TO 107 CALL PASSF3 (IDOT,L1,C,CH,WA(IW),WA(IX2)) GO TO 108 107 CALL PASSF3 (IDOT,L1,CH,C,WA(IW),WA(IX2)) 108 NA = 1-NA GO TO 115 109 IF (IP .NE. 5) GO TO 112 IX2 = IW+IDOT IX3 = IX2+IDOT IX4 = IX3+IDOT IF (NA .NE. 0) GO TO 110 CALL PASSF5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4)) GO TO 111 110 CALL PASSF5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4)) 111 NA = 1-NA GO TO 115 112 IF (NA .NE. 0) GO TO 113 CALL PASSF (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW)) GO TO 114 113 CALL PASSF (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW)) 114 IF (NAC .NE. 0) NA = 1-NA 115 L1 = L2 IW = IW+(IP-1)*IDOT 116 CONTINUE IF (NA .EQ. 0) RETURN N2 = N+N DO 117 I=1,N2 C(I) = CH(I) 117 CONTINUE RETURN END SUBROUTINE CFFTI(N,WSAVE) C***BEGIN PROLOGUE CFFTI C***DATE WRITTEN 790601 (YYMMDD) C***REVISION DATE 860115 (YYMMDD) C***CATEGORY NO. J1A2 C***KEYWORDS FOURIER TRANSFORM C***AUTHOR SWARZTRAUBER, P. N., (NCAR) C***PURPOSE Initialize for CFFTF and CFFTB. C***DESCRIPTION C From the book, "Numerical Methods and Software" by C D. Kahaner, C. Moler, S. Nash C Prentice Hall, 1988 C C Subroutine CFFTI initializes the array WSAVE which is used in C both CFFTF and CFFTB. The prime factorization of N together with C a tabulation of the trigonometric functions are computed and C stored in WSAVE. C C Input Parameter C C N the length of the sequence to be transformed C C Output Parameter C C WSAVE a work array which must be dimensioned at least 4*N+15. C The same work array can be used for both CFFTF and CFFTB C as long as N remains unchanged. Different WSAVE arrays C are required for different values of N. The contents of C WSAVE must not be changed between calls of CFFTF or CFFTB. C***REFERENCES (NONE) C***ROUTINES CALLED CFFTI1 C***END PROLOGUE CFFTI DIMENSION WSAVE(*) C***FIRST EXECUTABLE STATEMENT CFFTI IF (N .EQ. 1) RETURN IW1 = N+N+1 IW2 = IW1+N+N CALL CFFTI1 (N,WSAVE(IW1),WSAVE(IW2)) RETURN END SUBROUTINE CFFTI1(N,WA,IFAC) C***BEGIN PROLOGUE CFFTI1 C***REFER TO CFFTI C***ROUTINES CALLED (NONE) C***END PROLOGUE CFFTI1 DIMENSION WA(*) ,IFAC(*) ,NTRYH(4) DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/3,4,2,5/ C***FIRST EXECUTABLE STATEMENT CFFTI1 NL = N NF = 0 J = 0 101 J = J+1 IF (J-4) 102,102,103 102 NTRY = NTRYH(J) GO TO 104 103 NTRY = NTRY+2 104 NQ = NL/NTRY NR = NL-NTRY*NQ IF (NR) 101,105,101 105 NF = NF+1 IFAC(NF+2) = NTRY NL = NQ IF (NTRY .NE. 2) GO TO 107 IF (NF .EQ. 1) GO TO 107 DO 106 I=2,NF IB = NF-I+2 IFAC(IB+2) = IFAC(IB+1) 106 CONTINUE IFAC(3) = 2 107 IF (NL .NE. 1) GO TO 104 IFAC(1) = N IFAC(2) = NF TPI = 8.*ATAN(1.) ARGH = TPI/REAL(N) I = 2 L1 = 1 DO 110 K1=1,NF IP = IFAC(K1+2) LD = 0 L2 = L1*IP IDO = N/L2 IDOT = IDO+IDO+2 IPM = IP-1 DO 109 J=1,IPM I1 = I WA(I-1) = 1. WA(I) = 0. LD = LD+L1 FI = 0. ARGLD = REAL(LD)*ARGH DO 108 II=4,IDOT,2 I = I+2 FI = FI+1. ARG = FI*ARGLD WA(I-1) = COS(ARG) WA(I) = SIN(ARG) 108 CONTINUE IF (IP .LE. 5) GO TO 109 WA(I1-1) = WA(I-1) WA(I1) = WA(I) 109 CONTINUE L1 = L2 110 CONTINUE RETURN END DOUBLE PRECISION FUNCTION CHEVAL(N,A,T) C C This function evaluates a Chebyshev series, using the C Clenshaw method with Reinsch modification, as analysed C in the paper by Oliver. C C INPUT PARAMETERS C C N - INTEGER - The no. of terms in the sequence C C A - DOUBLE PRECISION ARRAY, dimension 0 to N - The coefficients of C the Chebyshev series C C T - DOUBLE PRECISION - The value at which the series is to be C evaluated C C C REFERENCES C C "An error analysis of the modified Clenshaw method for C evaluating Chebyshev and Fourier series" J. Oliver, C J.I.M.A., vol. 20, 1977, pp379-391 C C C MACHINE-DEPENDENT CONSTANTS: NONE C C C INTRINSIC FUNCTIONS USED; C C ABS C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley , C High St., C PAISLEY, C SCOTLAND C C C LATEST MODIFICATION: 21 December , 1992 C C INTEGER I,N DOUBLE PRECISION A(0:N),D1,D2,HALF,T,TEST,TT,TWO,U0,U1,U2,ZERO C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOMC.INC' CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DATA ZERO,HALF/ 0.0 D 0 , 0.5 D 0 / DATA TEST,TWO/ 0.6 D 0 , 2.0 D 0 / U1 = ZERO C C If ABS ( T ) < 0.6 use the standard Clenshaw method C IF ( ABS( T ) .LT. TEST ) THEN U0 = ZERO TT = T + T DO 100 I = N , 0 , -1 U2 = U1 U1 = U0 U0 = TT * U1 + A( I ) - U2 100 CONTINUE CHEVAL = ( U0 - U2 ) / TWO ELSE C C If ABS ( T ) > = 0.6 use the Reinsch modification C D1 = ZERO C C T > = 0.6 code C IF ( T .GT. ZERO ) THEN TT = ( T - HALF ) - HALF TT = TT + TT DO 200 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) + D2 U1 = D1 + U2 200 CONTINUE CHEVAL = ( D1 + D2 ) / TWO ELSE C C T < = -0.6 code C TT = ( T + HALF ) + HALF TT = TT + TT DO 300 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) - D2 U1 = D1 - U2 300 CONTINUE CHEVAL = ( D1 - D2 ) / TWO ENDIF ENDIF RETURN END SUBROUTINE CGAMA(X,Y,KF,GR,GI) C C ========================================================= C Purpose: Compute the gamma function â(z) or ln[â(z)] C for a complex argument C Input : x --- Real part of z C y --- Imaginary part of z C KF --- Function code C KF=0 for ln[â(z)] C KF=1 for â(z) C Output: GR --- Real part of ln[â(z)] or â(z) C GI --- Imaginary part of ln[â(z)] or â(z) C ======================================================== C IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION A(10) PI=3.141592653589793D0 DATA A/8.333333333333333D-02,-2.777777777777778D-03, & 7.936507936507937D-04,-5.952380952380952D-04, & 8.417508417508418D-04,-1.917526917526918D-03, & 6.410256410256410D-03,-2.955065359477124D-02, & 1.796443723688307D-01,-1.39243221690590D+00/ IF (Y.EQ.0.0D0.AND.X.EQ.INT(X).AND.X.LE.0.0D0) THEN GR=1.0D+300 GI=0.0D0 RETURN ELSE IF (X.LT.0.0D0) THEN X1=X Y1=Y X=-X Y=-Y ENDIF X0=X IF (X.LE.7.0) THEN NA=INT(7-X) X0=X+NA ENDIF Z1=DSQRT(X0*X0+Y*Y) TH=DATAN(Y/X0) GR=(X0-.5D0)*DLOG(Z1)-TH*Y-X0+0.5D0*DLOG(2.0D0*PI) GI=TH*(X0-0.5D0)+Y*DLOG(Z1)-Y DO 10 K=1,10 T=Z1**(1-2*K) GR=GR+A(K)*T*DCOS((2.0D0*K-1.0D0)*TH) 10 GI=GI-A(K)*T*DSIN((2.0D0*K-1.0D0)*TH) IF (X.LE.7.0) THEN GR1=0.0D0 GI1=0.0D0 DO 15 J=0,NA-1 GR1=GR1+.5D0*DLOG((X+J)**2+Y*Y) 15 GI1=GI1+DATAN(Y/(X+J)) GR=GR-GR1 GI=GI-GI1 ENDIF IF (X1.LT.0.0D0) THEN Z1=DSQRT(X*X+Y*Y) TH1=DATAN(Y/X) SR=-DSIN(PI*X)*DCOSH(PI*Y) SI=-DCOS(PI*X)*DSINH(PI*Y) Z2=DSQRT(SR*SR+SI*SI) TH2=DATAN(SI/SR) IF (SR.LT.0.0D0) TH2=PI+TH2 GR=DLOG(PI/(Z1*Z2))-GR GI=-TH1-TH2-GI X=X1 Y=Y1 ENDIF IF (KF.EQ.1) THEN G0=DEXP(GR) GR=G0*DCOS(GI) GI=G0*DSIN(GI) ENDIF RETURN END COMPLEX FUNCTION CGAMMA(Z) C***FOR DATAPLOT, THIS ROUTINE IS USED IN CALCULATION OF CBETA FUNCTION, C***WE USE CGAMA ABOVE FOR CGAMMA FUNCTION. C***BEGIN PROLOGUE CGAMMA C***DATE WRITTEN 770701 (YYMMDD) C***REVISION DATE 820801 (YYMMDD) C***CATEGORY NO. C7A C***KEYWORDS COMPLETE GAMMA FUNCTION,COMPLEX,GAMMA FUNCTION, C SPECIAL FUNCTION C***AUTHOR FULLERTON, W., (LANL) C***PURPOSE Computes the Gamma function of complex argument. C***DESCRIPTION C C CGAMMA(Z) calculates the complete gamma function for COMPLEX C argument Z. This is a preliminary version that is portable C but not accurate. C***REFERENCES (NONE) C***ROUTINES CALLED CLNGAM C***END PROLOGUE CGAMMA COMPLEX Z, CLNGAM, CEXP C***FIRST EXECUTABLE STATEMENT CGAMMA CGAMMA = CEXP (CLNGAM(Z)) C RETURN END SUBROUTINE CHEBT(X,AN,CN) C C PURPOSE--THIS SUBROUTINE COMPUTES THE CHEBYSHEV T C POLYNOMIAL OF ORDER N. C INPUT ARGUMENTS--X = THE SINGLE PRECISION INPUT ARGUMENT C CN = THE SINGLE PRECISION VALUE FOR THE C ORDER OF THE FUNCTION (SHOULD BE C NON-NEGATIVE ORDER) C OUTPUT ARGUMENTS--CN = THE SINGLE PRECISION VALUE OF THE C CHEBYSHEV T POLYNOMIAL. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS-- C OTHER DATAPAC SUBROUTINES NEEDED--NONE C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE C MODE OF INTERNAL OPERATIONS--SOME DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--"HANDBOOK OF MATHEMATICAL FUNCTIONS, AMS 55", C ABRAMOWITZ AND STEGUM. C USE FOLLOWING RECURRENCE FORMULA: C T(N+1) = 2.0*X*T(N-1)-T(N-2) C FIRST FEW TERMS ARE FROM TABLE 22.3 OF ABRAMOWITZ C AND STEGUM. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE: 301-975-2855 C ORIGINAL VERSION--JULY 1995. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 ICOUTINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,ICOUTINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DOUBLE PRECISION DX DOUBLE PRECISION DCN, DCN1, DCN2 C C-----START POINT----------------------------------------------------- C IF(X.LT.-1.0.OR.X.GT.1.0)THEN WRITE(ICOUT,4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)X CALL DPWRST('XXX','BUG ') GOTO9999 ENDIF 4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 1ST INPUT ARGUMENT ', 1'TO THE CHEBT SUBROUTINE IS OUTSIDE THE (-1,1) INTERVAL *****') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****') N=INT(AN+0.5) IF(N.LT.0)THEN WRITE(ICOUT,6) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)N CALL DPWRST('XXX','BUG ') GOTO9999 ENDIF 6 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 2ND INPUT ARGUMENT ', 1'TO THE CHEBT SUBROUTINE IS NEGATIVE *****') 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****') C DX=DBLE(X) C IF(N.LE.0)THEN CN=1.0 ELSEIF(N.EQ.1)THEN CN=X ELSEIF(N.EQ.2)THEN CN=2.0*X**2-1.0 ELSEIF(N.EQ.3)THEN DCN=4.0D0*DX**3 - 3.0*DX CN=REAL(DCN) ELSE DCN1=4.0D0*DX**3 - 3.0*DX DCN2=2.0D0*DX**2-1.0D0 DO1000I=4,N DCN=2.0D0*DX*DCN1-DCN2 DCN2=DCN1 DCN1=DCN 1000 CONTINUE CN=REAL(DCN) ENDIF C 9999 CONTINUE RETURN END SUBROUTINE CHEBU(X,AN,CN) C C PURPOSE--THIS SUBROUTINE COMPUTES THE CHEBYSHEV U C POLYNOMIAL OF ORDER N. C INPUT ARGUMENTS--X = THE SINGLE PRECISION INPUT ARGUMENT C CN = THE SINGLE PRECISION VALUE FOR THE C ORDER OF THE FUNCTION (SHOULD BE C NON-NEGATIVE ORDER) C OUTPUT ARGUMENTS--CN = THE SINGLE PRECISION VALUE OF THE C CHEBYSHEV U POLYNOMIAL. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS-- C OTHER DATAPAC SUBROUTINES NEEDED--NONE C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE C MODE OF INTERNAL OPERATIONS--SOME DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--"HANDBOOK OF MATHEMATICAL FUNCTIONS, AMS 55", C ABRAMOWITZ AND STEGUM. C USE FOLLOWING RECURRENCE FORMULA: C U(N+1) = 2.0*X*U(N-1)-U(N-2) C FIRST FEW TERMS ARE FROM TABLE 22.5 OF ABRAMOWITZ C AND STEGUM. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE: 301-975-2855 C ORIGINAL VERSION--JULY 1995. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 ICOUTINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,ICOUTINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DOUBLE PRECISION DX DOUBLE PRECISION DCN, DCN1, DCN2 C C-----START POINT----------------------------------------------------- C IF(X.LT.-1.0.OR.X.GT.1.0)THEN WRITE(ICOUT,4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)X CALL DPWRST('XXX','BUG ') GOTO9999 ENDIF 4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 1ST INPUT ARGUMENT ', 1'TO THE CHEBU SUBROUTINE IS OUTSIDE THE (-1,1) INTERVAL *****') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****') N=INT(AN+0.5) IF(N.LT.0)THEN WRITE(ICOUT,6) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)N CALL DPWRST('XXX','BUG ') GOTO9999 ENDIF 6 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 2ND INPUT ARGUMENT ', 1'TO THE CHEBU SUBROUTINE IS NEGATIVE *****') 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****') C DX=DBLE(X) C IF(N.LE.0)THEN CN=1.0 ELSEIF(N.EQ.1)THEN CN=2.0*X ELSEIF(N.EQ.2)THEN CN=4.0*X**2-1.0 ELSEIF(N.EQ.3)THEN DCN=8.0D0*DX**3 - 4.0*DX CN=REAL(DCN) ELSE DCN1=8.0D0*DX**3 - 4.0*DX DCN2=4.0D0*DX**2-1.0D0 DO1000I=4,N DCN=2.0D0*DX*DCN1-DCN2 DCN2=DCN1 DCN1=DCN 1000 CONTINUE CN=REAL(DCN) ENDIF C 9999 CONTINUE RETURN END SUBROUTINE CHEDIS(AMAT,AMAT2,MAXROM,MAXCOM,NR1,NC1,ICASE,IWRITE, 1IBUGA3,IERROR) C C PURPOSE--THIS SUBROUTINE COMPUTES THE C CHEBYCHEV DISTANCE OF A MATRIX. THE FORMULA IS: C Dij=MAX|(Xik - Xjk)| C THE MAXIMUM IS FROM K = 1 TO P (WHERE THERE ARE P C COLUMNS IN THE MATRIX). FOR EXAMPLE, D23 IS C THE DISTANCE BETWEEN THE SECOND AND THIRD ROWS. C (ALTERNATIVELY, THE DISTANCE CAN BE CALCULATED C ACROSS COLUMNS). C THIS IS ALSO CALLED THE L INFINITY NORM DISTANCE C OR THE MAXIMUM DIFFERENCE DISTANCE. C INPUT ARGUMENTS--AMAT = THE SINGLE PRECISION MATRIX C --MAXROM = THE INTEGER ROW DIMENSION OF AMAT C --MAXCOM = THE INTEGER COUMN DIMENSION OF AMAT C --NR1 = THE INTEGER NUMBER OF ROWS OF AMAT C --NC1 = THE INTEGER NUMBER OF COLUMNS OF AMAT C OUTPUT ARGUMENTS--AMAT2 = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE CHEBYCHEV DISTANCES. C OUTPUT--MATRIX OF CHEBYCHEV DISTANCES C NOTE--THIS ROUTINE ASSUMES THE ERROR CHECKING (FOR EQUAL C ROWS AND COLUMNS, MATCHING DIMENSIONS FOR X AND AMAT) C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C LANGUAGE--ANSI FORTRAN (1977) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--98.7 C ORIGINAL VERSION--JULY 1998. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASE CHARACTER*4 IWRITE CHARACTER*4 IBUGA3 CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DOUBLE PRECISION DSUM DOUBLE PRECISION DYM1 DOUBLE PRECISION DYM2 DOUBLE PRECISION DTEMP C DIMENSION AMAT(MAXROM,MAXCOM) DIMENSION AMAT2(MAXROM,MAXCOM) 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 IERROR='NO' C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CHEDIS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)NR1,NC1 53 FORMAT('NR1, NC1 = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ICASE 54 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************************** C ** COMPUTE CHEBYCHEV DISTANCE * C ******************************** C IF(ICASE.EQ.'ROW ')THEN DO5861I=1,NR1 DO5863J=1,I IF(I.EQ.J)THEN AMAT2(I,I)=0.0 ELSE DSUM=0.0D0 DO5865K=1,NC1 DYM1=AMAT(I,K) DYM2=AMAT(J,K) DTEMP=DABS(DYM1-DYM2) IF(DTEMP.GT.DSUM)DSUM=DTEMP 5865 CONTINUE AMAT2(I,J)=REAL(DSUM) AMAT2(J,I)=AMAT2(I,J) ENDIF 5863 CONTINUE 5861 CONTINUE ELSEIF(ICASE.EQ.'COLU')THEN DO5961I=1,NC1 DO5963J=1,I IF(I.EQ.J)THEN AMAT2(I,I)=0.0 ELSE DSUM=0.0D0 DO5965K=1,NR1 DYM1=AMAT(K,I) DYM2=AMAT(K,J) DTEMP=DABS(DYM1-DYM2) IF(DTEMP.GT.DSUM)DSUM=DTEMP 5965 CONTINUE AMAT2(I,J)=REAL(DSUM) AMAT2(J,I)=AMAT2(I,J) ENDIF 5963 CONTINUE 5961 CONTINUE ENDIF C C ******************************* C ** STEP 3-- ** C ** WRITE OUT A LINE ** C ** OF SUMMARY INFORMATION. ** C ******************************* C IF(IFEEDB.EQ.'OFF')GOTO890 IF(IWRITE.EQ.'OFF')GOTO890 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,811) 811 FORMAT('THE CHEBYCHEV DISTANCE MATRIX HAS BEEN CALCULATED.') CALL DPWRST('XXX','BUG ') 890 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CHEDIS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGA3,IERROR 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CHCDF(X,ANU,CDF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE CHI DISTRIBUTION C WITH POSITIVE DEGREES OF FREEDOM PARAMETER = NU. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X. C THE PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C THE CDF IS CAN BE COMPUTED WITH THE SLATEC ROUTINE C DGAMIC. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C --ANU = THE POSITIVE NUMBER OF DEGREES C OF FREEDOM. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE CHI DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = ANU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE. C --NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1994, PAGE 417. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--95/4 C ORIGINAL VERSION--APRIL 1995. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DOUBLE PRECISION DTERM1, DTERM2 DOUBLE PRECISION DCDF DOUBLE PRECISION DGAMIP C C--------------------------------------------------------------------- C INCLUDE 'DPCOMC.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-----DATA STATEMENTS------------------------------------------------- C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(ANU.LE.0.0)THEN WRITE(ICOUT,15) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)ANU CALL DPWRST('XXX','BUG ') CDF=0.0 GOTO9000 ENDIF 15 FORMAT('***** ERROR--THE SECOND INPUT ARGUMENT TO CHCDF ', 1'IS NON-POSITIVE') IF(X.LT.0.0)THEN WRITE(ICOUT,4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)X CALL DPWRST('XXX','BUG ') CDF=0.0 GOTO9000 ENDIF 4 FORMAT('***** ERROR--THE FIRST INPUT ARGUMENT TO CHCDF ', 1'IS NEGATIVE') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7) 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7) C IF(X.LE.R1MACH(1))THEN CDF=0.0 RETURN ENDIF C DTERM1=DBLE(ANU/2.0) DTERM2=DBLE(X**2/2.0) DCDF=DGAMIP(DTERM1,DTERM2) CDF=REAL(DCDF) C 9000 CONTINUE RETURN END SUBROUTINE CHCDF2(DX,DNU,DCDF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE CHI DISTRIBUTION C WITH POSITIVE DEGREES OF FREEDOM PARAMETER = NU. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X. C THE PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C THE CDF IS CAN BE COMPUTED WITH THE SLATEC ROUTINE C DGAMIC. C NOTE--THIS IS A DOUBLE PRECISION VERSION OF CHCDF USED BY C CHPPF FOR GREATER ACCURACY. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C --ANU = THE POSITIVE NUMBER OF DEGREES C OF FREEDOM. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE CHI DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = ANU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE. C --NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1994, PAGE 417. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--95/4 C ORIGINAL VERSION--APRIL 1995. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DOUBLE PRECISION DTERM1, DTERM2 DOUBLE PRECISION DX DOUBLE PRECISION DCDF DOUBLE PRECISION DNU DOUBLE PRECISION DGAMIP C C--------------------------------------------------------------------- C INCLUDE 'DPCOMC.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-----DATA STATEMENTS------------------------------------------------- C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(DNU.LE.0.0D0)THEN WRITE(ICOUT,15) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)ANU CALL DPWRST('XXX','BUG ') DCDF=0.0D0 GOTO9000 ENDIF 15 FORMAT('***** ERROR--THE SECOND INPUT ARGUMENT TO CHCDF ', 1'IS NON-POSITIVE') IF(DX.LT.0.0D0)THEN WRITE(ICOUT,4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)DX CALL DPWRST('XXX','BUG ') DCDF=0.0D0 GOTO9000 ENDIF 4 FORMAT('***** ERROR--THE FIRST INPUT ARGUMENT TO CHCDF ', 1'IS NEGATIVE') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7) 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7) C IF(DX.LE.D1MACH(1))THEN DCDF=0.0D0 RETURN ENDIF C DTERM1=DNU/2.0D0 DTERM2=DX**2/2.0D0 DCDF=DGAMIP(DTERM1,DTERM2) C 9000 CONTINUE RETURN END SUBROUTINE CHM(A,B,X,HG,IERROR) C C =================================================== C Purpose: Compute confluent hypergeometric function C M(a,b,x) C Input : a --- Parameter C b --- Parameter ( b <> 0,-1,-2,... ) C x --- Argument C Output: HG --- M(a,b,x) C IERROR REPORT ERROR CONDITIONS C =================================================== C IMPLICIT DOUBLE PRECISION (A-H,O-Z) PI=3.141592653589793D0 A0=A A1=A X0=X HG=0.0D0 IF (B.EQ.0.0D0.OR.B.EQ.-ABS(INT(B))) THEN HG=1.0D+300 ELSE IF (A.EQ.0.0D0.OR.X.EQ.0.0D0) THEN HG=1.0D0 ELSE IF (A.EQ.-1.0D0) THEN HG=1.0D0-X/B ELSE IF (A.EQ.B) THEN HG=DEXP(X) ELSE IF (A-B.EQ.1.0D0) THEN HG=(1.0D0+X/B)*DEXP(X) ELSE IF (A.EQ.1.0D0.AND.B.EQ.2.0D0) THEN HG=(DEXP(X)-1.0D0)/X ELSE IF (A.EQ.INT(A).AND.A.LT.0.0D0) THEN M=INT(-A) R=1.0D0 HG=1.0D0 DO 10 K=1,M R=R*(A+K-1.0D0)/K/(B+K-1.0D0)*X 10 HG=HG+R ENDIF IF (HG.NE.0.0D0) RETURN IF (X.LT.0.0D0) THEN A=B-A A0=A X=DABS(X) ENDIF IF (A.LT.2.0D0) NL=0 IF (A.GE.2.0D0) THEN NL=1 LA=INT(A) A=A-LA-1.0D0 ENDIF DO 30 N=0,NL IF (A0.GE.2.0D0) A=A+1.0D0 IF (X.LE.30.0D0+DABS(B).OR.A.LT.0.0D0) THEN HG=1.0D0 RG=1.0D0 DO 15 J=1,500 RG=RG*(A+J-1.0D0)/(J*(B+J-1.0D0))*X HG=HG+RG IF (DABS(RG/HG).LT.1.0D-15) GO TO 25 15 CONTINUE ELSE TA=DGAMMA(A) TB=DGAMMA(B) XG=B-A TBA=DGAMMA(XG) SUM1=1.0D0 SUM2=1.0D0 R1=1.0D0 R2=1.0D0 DO 20 I=1,8 R1=-R1*(A+I-1.0D0)*(A-B+I)/(X*I) R2=-R2*(B-A+I-1.0D0)*(A-I)/(X*I) SUM1=SUM1+R1 20 SUM2=SUM2+R2 HG1=TB/TBA*X**(-A)*DCOS(PI*A)*SUM1 HG2=TB/TA*DEXP(X)*X**(A-B)*SUM2 HG=HG1+HG2 ENDIF 25 IF (N.EQ.0) Y0=HG IF (N.EQ.1) Y1=HG 30 CONTINUE IF (A0.GE.2.0D0) THEN DO 35 I=1,LA-1 HG=((2.0D0*A-B+X)*Y1+(B-A)*Y0)/A Y0=Y1 Y1=HG 35 A=A+1.0D0 ENDIF IF (X0.LT.0.0D0) HG=HG*DEXP(X0) A=A1 X=X0 RETURN END SUBROUTINE CHPDF(X,ANU,PDF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE CHI DISTRIBUTION C WITH POSITIVE DEGREES OF FREEDOM PARAMETER = NU. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X. C THE PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C --ANU = THE POSITIVE NUMBER OF DEGREES C OF FREEDOM. C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE PDF FOR THE CHI DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = ANU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE. C --NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--NORPDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1994, PAGE 417. C --"STATISTICAL DISTRIBUTIONS", EVANS, HASTINGS, C PEACOCK. WILEY, 1993. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--95/4 C ORIGINAL VERSION--APRIL 1995. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C INCLUDE 'DPCOMC.INC' C DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4, DTERM5 DOUBLE PRECISION DARG1, DARG2 DOUBLE PRECISION DPDF DOUBLE PRECISION DLNGAM C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----DATA STATEMENTS------------------------------------------------- C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(ANU.LE.0.0)THEN WRITE(ICOUT,15) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)ANU CALL DPWRST('XXX','BUG ') PDF=0.0 GOTO9999 ENDIF 15 FORMAT('***** ERROR--THE SECOND INPUT ARGUMENT TO CHPDF ', 1'IS NON-POSITIVE') IF(X.LT.0.0)THEN WRITE(ICOUT,4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)X CALL DPWRST('XXX','BUG ') PDF=0.0 GOTO9999 ENDIF 4 FORMAT('***** ERROR--THE FIRST INPUT ARGUMENT TO CHPDF ', 1'IS NEGATIVE') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7) 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7) C DARG1=DBLE(X) DARG2=DBLE(ANU) C DTERM1=(DARG2-1.0D0)*DLOG(DARG1) DTERM2=-DARG1*DARG1/2.0D0 C IF(DABS(DTERM2).GE.DLOG(D1MACH(2)))THEN PDF=0.0 GOTO9999 ENDIF C DTERM3=(DARG2/2.0D0-1.0D0)*DLOG(2.0D0) DTERM4=DLNGAM(DARG2/2.0D0) DTERM5=DTERM1+DTERM2-DTERM3-DTERM4 IF(DTERM5.GE.DLOG(D1MACH(2)))THEN WRITE(ICOUT,101)X,ANU CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)X CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)ANU CALL DPWRST('XXX','BUG ') PDF=LOG(R1MACH(2)) GOTO9999 ELSE DPDF=DEXP(DTERM5) ENDIF PDF=REAL(DPDF) GOTO9999 101 FORMAT('***** ERROR--THE CHPDF ROUTINE OVERFLOWS. PDF ', 1 'SET TO LOG OF LARGEST VALUE.') C 9999 CONTINUE RETURN END SUBROUTINE CHPPF(P,NU,PPF) C C PURPOSE --PERCENT POINT FUNCTION FOR THE CHI C DISTRIBUTION. USES A BISECTION METHOD. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--95/4 C ORIGINAL VERSION--APRIL 1995. C UPDATED --OCTOBER 2006. CONVERT TO DOUBLE PRECISION C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C REAL NU C DOUBLE PRECISION DNU DOUBLE PRECISION DP DOUBLE PRECISION EPS DOUBLE PRECISION SIG DOUBLE PRECISION ZERO DOUBLE PRECISION DMEAN DOUBLE PRECISION DSD DOUBLE PRECISION XL DOUBLE PRECISION XR DOUBLE PRECISION XINC DOUBLE PRECISION CDFL DOUBLE PRECISION CDFR DOUBLE PRECISION FXL DOUBLE PRECISION FXR DOUBLE PRECISION FCS DOUBLE PRECISION P1 DOUBLE PRECISION DX DOUBLE PRECISION DCDF C DOUBLE PRECISION DGAMMA EXTERNAL DGAMMA C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DATA EPS /0.000001/ DATA SIG /1.0D-7/ DATA ZERO /0.0D0/ DATA MAXIT /1000/ C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)THEN WRITE(ICOUT,1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)P CALL DPWRST('XXX','BUG ') PPF=0.0 GOTO9999 ENDIF 1 FORMAT('***** ERROR--THE FIRST INPUT ARGUMENT TO CHPPF ', 1 'IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL.') IF(NU.LE.0.0)THEN WRITE(ICOUT,11) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)NU CALL DPWRST('XXX','BUG ') PPF=0.0 GOTO9999 ENDIF 11 FORMAT('***** ERROR--THE SECOND INPUT ARGUMENT TO CHPPF ', 1'IS LESS THAN OR EQUAL TO 0.') C 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7) 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I15) C C FIND BRACKETING INTERVAL. C C 1) USE 0 AS THE LOWER LIMIT C 2) START WITH THE MEAN AS THE UPPER LIMIT AND INCREMENT C BY 1 SD. C C MEAN = SQRT(2)*GAMMA((NU+1)/2)/GAMMA(NU/2) C VARI = NU - MEAN**2 C IF(P.EQ.0.0)THEN PPF=0.0 GOTO9999 ENDIF C DNU=DBLE(NU) DP=DBLE(P) DMEAN=DSQRT(2.0D0)*DGAMMA((DNU+1.0D0)/2.0D0)/DGAMMA(DNU/2.0D0) DSD=DNU - DMEAN**2 IF(DSD.GT.0.0D0)THEN DSD=DSQRT(DSD) ELSE DSD=20.0D0 ENDIF C XL=0.0D0 XINC=DSD ICOUNT=0 MAXCNT=10000 C 91 CONTINUE XR=XL+XINC IF(XL.LE.0.0D0)XL=0.0D0 IF(XR.LE.0.0D0)XR=XL+1.0D0 CALL CHCDF2(XL,DNU,CDFL) CALL CHCDF2(XR,DNU,CDFR) IF(CDFL.LT.DP .AND. CDFR.LT.DP)THEN XL=XR ELSEIF(CDFL.GT.DP .AND. CDFR.GT.DP)THEN XL=XL-XINC ELSE GOTO99 ENDIF ICOUNT=ICOUNT+1 IF(ICOUNT.GT.MAXCNT)THEN WRITE(ICOUT,96) CALL DPWRST('XXX','BUG ') PPF=0.0 GOTO9999 ENDIF 96 FORMAT('***** ERROR--CHPPF UNABLE TO FIND BRACKETING ', * 'INTERVAL.') GOTO91 C C BISECTION METHOD C 99 CONTINUE IC = 0 FXL = -DP FXR = 1.0D0 - DP 105 CONTINUE DX = (XL+XR)*0.5D0 CALL CHCDF2(DX,DNU,DCDF) P1=DCDF PPF=REAL(DX) FCS = P1 - DP IF(FCS*FXL.GT.ZERO)THEN XL = DX FXL = FCS ELSE XR = DX FXR = FCS ENDIF XRML = XR - XL IF(XRML.LE.SIG .AND. ABS(FCS).LE.EPS)GOTO9999 IC = IC + 1 IF(IC.LE.MAXIT)GOTO105 WRITE(ICOUT,130) CALL DPWRST('XXX','BUG ') 130 FORMAT('***** ERROR--CHPPF ROUTINE DID NOT CONVERGE.') GOTO9999 C 9999 CONTINUE RETURN END SUBROUTINE CHRAN(N,ANU,ISEED,X) C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE CHI DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = ANU. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --ANU = THE SINGLE PRECISION VALUE OF THE C DEGREES OF FREEDOM PARAMETER. C ANU SHOULD BE A POSITIVE INTEGER. 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 CHI DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER VALUE = ANU. 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 --ANU SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--2003.7 C ORIGINAL VERSION--JULY 2003. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)THEN WRITE(ICOUT, 5) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)N CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF IF(ANU.LE.0.0)THEN WRITE(ICOUT,15) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)ANU CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF 5 FORMAT('***** ERROR--THE REQUESTED NUMBER OF CHI RANDOM', 1 ' NUMBERS IS NON-POSITIVE.') 15 FORMAT('***** ERROR--THE DEGREES OF FREEDOM PARAMETER FOR', 1 ' CHI RANDOM NUMBERS IS NON-POSITIVE.') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7) 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N CHI DISTRIBUTION RANDOM C NUMBERS USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N CALL CHPPF(X(I),ANU,XTEMP) X(I)=XTEMP 100 CONTINUE C 9000 CONTINUE RETURN END SUBROUTINE CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2, 1IERROR) C C PURPOSE--CHECK TO SEE IF THE NUMBER OF INPUT ARGUMENTS C TO THE CALLING SUBROUTINES IS BETWEEN ALLOWABLE LIMITS. C OUTPUT--A VALUE OF 'NO' OR 'YES' IS STORED C IN THE HOLLERITH VARIABLE IERROR C DEPENDING ON WHETHER THE NUMBER OF ARGUMENTS C IS WITHIN ALLOWABLE LIMITS C OR OUTSIDE OF ALLOWABLE LIMITS, RESPECTIVELY. C NOTE--THIS CHECKING SUBROUTINE IS PARTICULARLY C USEFUL FOR THOSE SUBROUTINES WHICH C WOULD RESULT IN A TERMINATION IF THE ANALYST C FORGOT TO ENTER ANY ARGUMENTS AT ALL C FOR A COMMAND WHICH REQUIRES AT LEAST 1 C (LIKE HISTOGRAM, NORMAL PROBABILITY PLOT, ETC.). C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--DECEMBER 28, 1977. C UPDATED --DECEMBER 1981. C UPDATED --FEBRUARY 1982. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IANS CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION IANS(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(MINNA.LE.NUMARG.AND.NUMARG.LE.MAXNA)GOTO1200 C 1100 CONTINUE WRITE(ICOUT,1102)ISUBN1,ISUBN2 1102 FORMAT('***** ERROR IN ',A4,A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1104) 1104 FORMAT(' THE NUMBER OF ARGUMENTS ACCOMPANYING') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1106) 1106 FORMAT(' THE LAST COMMAND WAS IMPROPER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1112)NUMARG 1112 FORMAT(' THE ENTERED NUMBER OF ARGUMENTS WAS ',I6) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1108) 1108 FORMAT(' A VALID NUMBER OF ARGUMENTS FOR THIS COMMAND ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1110)MINNA,MAXNA 1110 FORMAT(' IS BETWEEN ',I6,' AND ',I6,' (INCLUSIVELY).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1124) 1124 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1126)(IANS(I),I=1,IWIDTH) 1126 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' RETURN C 1200 CONTINUE IERROR='NO' RETURN C END SUBROUTINE CHECKF(IHWORD,IHWOR2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,ITYPE) C C PURPOSE--CHECK TO SEE IF THE HOLLERITH NAME IN (IHWORD,IHWOR2) C EXISTS IN THE CURRENT TABLE OF AVAILABLE NAMES AND RETURN C THE TYPE (PARAMETER, VARIABLE, STRING, OR MATRIX). C OUTPUT--ITYPE = THE TYPE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--2002/7 C ORIGINAL VERSION--JULY 2002. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IHWORD CHARACTER*4 IHWOR2 CHARACTER*4 IHWUSE CHARACTER*4 IHNAME CHARACTER*4 IHNAM2 CHARACTER*4 IUSE CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 MESSAG CHARACTER*4 IANS C CHARACTER*8 ITYPE C C--------------------------------------------------------------------- C DIMENSION IHNAME(*) DIMENSION IHNAM2(*) DIMENSION IUSE(*) DIMENSION IN(*) DIMENSION IVALUE(*) DIMENSION VALUE(*) C DIMENSION IANS(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ITYPE='NONE' ILOC=0 C DO150I=1,NUMNAM I2=I IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))THEN ILOC=I2 IF(IUSE(I).EQ.'P')THEN ITYPE='PARAMETER' ELSEIF(IUSE(I).EQ.'V')THEN ITYPE='VARIBLE' ELSEIF(IUSE(I).EQ.'F')THEN ITYPE='STRING' ELSEIF(IUSE(I).EQ.'M')THEN ITYPE='MATRIX' ELSE ITYPE='UNKN' ENDIF GOTO9000 ENDIF 150 CONTINUE C 9000 CONTINUE IF(MESSAG.EQ.'ON')THEN WRITE(ICOUT,51)IHNAME(ILOC),IHNAM2(ILOC) 51 FORMAT('***** VARIABLE ',A4,A4,' FOUND AS A ',A8) CALL DPWRST('XXX','BUG ') ENDIF RETURN C END SUBROUTINE CHECKN(IHWORD,IHWOR2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR) C C PURPOSE--CHECK TO SEE IF THE HOLLERITH NAME IN (IHWORD,IHWOR2) C EXISTS IN THE CURRENT TABLE OF AVAILABLE PARAMETER AND C VARIABLE NAMES AS GIVEN IN IHNAME(.) AND IHNAM2(I). C OUTPUT--THE LOCATION (THAT IS, THE LINE OR ROW) IN THE TABLE C WHERE THE NAME WAS FOUND (IF FOUND). C THIS LOCATION IS STORED IN THE VARIABLE ILOC. C ALSO, A VALUE OF 'YES' OR 'NO' IS STORED C IN THE HOLLERITH VARIABLE IERROR C DEPENDING ON WHETHER THE NAME WAS NOT FOUND C OR WAS FOUND, RESPECTIVELY. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--DECEMBER 28, 1977. C UPDATED --JUNE 8, 1978. C UPDATED --NOVEMBER 1980. C UPDATED --JANUARY 1981. C UPDATED --JULY 1981. C UPDATED --NOVEMBER 1981. C UPDATED --MAY 1982. C UPDATED --JANUARY 1988. (UPDATED ERROR MESSAGES) C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IHWORD CHARACTER*4 IHWOR2 CHARACTER*4 IHWUSE CHARACTER*4 IHNAME CHARACTER*4 IHNAM2 CHARACTER*4 IUSE CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 MESSAG CHARACTER*4 IANS CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION IHNAME(*) DIMENSION IHNAM2(*) DIMENSION IUSE(*) DIMENSION IN(*) DIMENSION IVALUE(*) DIMENSION VALUE(*) C DIMENSION IANS(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IHWUSE.EQ.'P')GOTO100 IF(IHWUSE.EQ.'V')GOTO200 IF(IHWUSE.EQ.'EITH')GOTO300 IF(IHWUSE.EQ.'PORV')GOTO300 IF(IHWUSE.EQ.'VORP')GOTO300 C 100 CONTINUE DO150I=1,NUMNAM I2=I IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO800 IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))GOTO110 150 CONTINUE GOTO700 C 110 CONTINUE IF(MESSAG.EQ.'NO')GOTO119 WRITE(ICOUT,111)IHWORD,IHWOR2 111 FORMAT(' A COMMAND OR EXPRESSION EXPECTED THE NAME ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,112) 112 FORMAT(' TO BE USED AS A PARAMETER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,113) 113 FORMAT(' THE NAME WAS FOUND IN THE INTERNAL TABLE,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,114) 114 FORMAT(' BUT NOT AS A PARAMETER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,115) 115 FORMAT(' PLEASE RECHECK THE COMMAND SYNTAX.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') 119 CONTINUE GOTO750 C 200 CONTINUE DO250I=1,NUMNAM I2=I IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO800 IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))GOTO210 250 CONTINUE GOTO700 C 210 CONTINUE IF(MESSAG.EQ.'NO')GOTO219 WRITE(ICOUT,211)IHWORD,IHWOR2 211 FORMAT(' A COMMAND OR EXPRESSION EXPECTED THE NAME ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,212) 212 FORMAT(' TO BE USED AS A VARIABLE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,213) 213 FORMAT(' THE NAME WAS FOUND IN THE INTERNAL TABLE,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,214) 214 FORMAT(' BUT NOT AS A VARIABLE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,215) 215 FORMAT(' PLEASE RECHECK THE COMMAND SYNTAX.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') 219 CONTINUE GOTO750 C 300 CONTINUE DO350I=1,NUMNAM I2=I IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO800 IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO800 IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))GOTO310 350 CONTINUE GOTO700 C 310 CONTINUE IF(MESSAG.EQ.'NO')GOTO319 WRITE(ICOUT,311)IHWORD,IHWOR2 311 FORMAT(' A COMMAND OR EXPRESSION EXPECTED THE NAME ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,312) 312 FORMAT(' TO BE USED AS A PARAMETER OR VARIABLE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,313) 313 FORMAT(' THE NAME WAS FOUND IN THE INTERNAL TABLE,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,314) 314 FORMAT(' BUT NEITHER AS A PARAMETER NOR A VARIABLE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,315) 315 FORMAT(' PLEASE RECHECK THE COMMAND SYNTAX.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') 319 CONTINUE GOTO750 C 700 CONTINUE IF(MESSAG.EQ.'NO')GOTO709 WRITE(ICOUT,702)ISUBN1,ISUBN2 702 FORMAT('***** ERROR IN CHECKN AS CALLED FROM ',2A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,703) 703 FORMAT(' A VARIABLE OR PARAMETER NAME USED (OR NEEDED)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,704) 704 FORMAT(' IN A COMMAND OR AN EXPRESSION') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,705) 705 FORMAT(' WAS NOT FOUND IN THE CURRENT LIST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,706) 706 FORMAT(' OF AVAILABLE PARAMETER AND VARIABLE NAMES.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,707)IHWORD,IHWOR2 707 FORMAT(' THE VARIABLE OR PARAMETER IN QUESTION WAS ',2A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') 709 CONTINUE GOTO750 C 750 CONTINUE ILOC=0 IERROR='YES' RETURN C 800 CONTINUE ILOC=I2 IERROR='NO' RETURN C END SUBROUTINE CHECN2(IHTEST,IHTES2,ITTEST, 1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN,NUMNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC, 1JVALUE,AVALUE,JUSE,JN, 1IOLDNA,IOLDN2,IOLDNI,IFOUND,IBUGA3,ISUBRO,IERROR) C C PURPOSE--SEARCH THE INTERNAL LIST IHNAME(.) C FOR THE NAME GIVEN BY IHTEST. C CHECK FOR PRESENCE IN LIST. C CHECK FOR VARIABLES HAVING SAME LENGTH. C CHECK FOR VARIABLES HAVING POSITIVE LENGTH. C C--------------------------------------------------------------------- C CHARACTER*4 IHTEST CHARACTER*4 IHTES2 CHARACTER*4 ITTEST CHARACTER*4 IHNAME CHARACTER*4 IHNAM2 CHARACTER*4 IUSE CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 MESSAG CHARACTER*4 IANS CHARACTER*4 JUSE CHARACTER*4 IOLDNA CHARACTER*4 IOLDN2 CHARACTER*4 IFOUND CHARACTER*4 IBUGA3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C DIMENSION IHNAME(*) DIMENSION IHNAM2(*) DIMENSION IVALUE(*) DIMENSION VALUE(*) DIMENSION IUSE(*) DIMENSION IN(*) DIMENSION IANS(*) 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 ????? I I=(-999) C IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ECN2')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CHECN2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3,ISUBRO 52 FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IHTEST,IHTES2,ITTEST 53 FORMAT('IHTEST,IHTES2,ITTEST = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)NUMNAM 54 FORMAT('NUMNAM = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55) 55 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I),', 1'IN(I)--') CALL DPWRST('XXX','BUG ') DO56I=1,NUMNAM WRITE(ICOUT,57)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I), 1IN(I) 57 FORMAT(I8,2X,A4,2X,A4,2X,A4,I8,F15.7,I8) CALL DPWRST('XXX','BUG ') 56 CONTINUE WRITE(ICOUT,61)IWIDTH 61 FORMAT('IWIDTH = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)(IANS(I),I=1,IWIDTH) 62 FORMAT('IANS(.) = ',100A1) CALL DPWRST('XXX','BUG ') 90 CONTINUE C IF(NUMNAM.LE.0)GOTO1010 DO1000I=1,NUMNAM I2=I IF(IHTEST.EQ.IHNAME(I).AND.IHTES2.EQ.IHNAM2(I))GOTO1100 GOTO1000 C 1100 CONTINUE IFOUND='YES' ILOC=I2 IF(ITTEST.EQ.'P')GOTO1200 IF(ITTEST.EQ.'V')GOTO1300 IF(ITTEST.EQ.'PV')GOTO1400 IF(ITTEST.EQ.'VP')GOTO1400 IF(ITTEST.EQ.'EITH')GOTO1400 IF(ITTEST.EQ.'BOTH')GOTO1400 C 1200 CONTINUE IF(IUSE(ILOC).EQ.'P')GOTO1210 GOTO1220 C 1210 CONTINUE JVALUE=IVALUE(ILOC) AVALUE=VALUE(ILOC) JUSE=IUSE(ILOC) JN=IN(ILOC) GOTO9000 C 1220 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1231 IF(IPRINT.EQ.'OFF')GOTO1231 IF(MESSAG.EQ.'NO')GOTO1231 WRITE(ICOUT,1221)ISUBN1,ISUBN2 1221 FORMAT('***** ERROR IN ',A4,A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1222) 1222 FORMAT(' A NAME WHICH SHOULD BE A PARAMETER') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1223) 1223 FORMAT(' HAS BEEN FOUND IN THE NAME LIST,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1224) 1224 FORMAT(' BUT AS A DIFFERENT TYPE THAN A PARAMETER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1225)IHTEST,IHTES2 1225 FORMAT('NAME = ',A4,A4) CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).EQ.'V')WRITE(ICOUT,1226) 1226 FORMAT('TYPE = VARIABLE') IF(IUSE(ILOC).EQ.'V')CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).EQ.'F')WRITE(ICOUT,1227) 1227 FORMAT('TYPE = FUNCTION') IF(IUSE(ILOC).EQ.'F')CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).NE.'V'.AND.IUSE(ILOC).NE.'F')WRITE(ICOUT,1228) 1IUSE(ILOC) 1228 FORMAT('TYPE = ',A4) IF(IUSE(ILOC).NE.'V'.AND.IUSE(ILOC).NE.'F') 1CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1229) 1229 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1230)(IANS(J),J=1,IWIDTH) 1230 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') 1231 CONTINUE IERROR='YES' GOTO9000 C 1300 CONTINUE IF(IUSE(ILOC).EQ.'V')GOTO1310 GOTO1320 C 1310 CONTINUE JVALUE=IVALUE(ILOC) AVALUE=VALUE(ILOC) JUSE=IUSE(ILOC) JN=IN(ILOC) C IF(IOLDNI.NE.-999.AND.JN.NE.IOLDNI)GOTO1340 IF(JN.LE.0)GOTO1360 IOLDNA=IHTEST IOLDN2=IHTES2 IOLDNI=JN GOTO9000 C 1320 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1331 IF(IPRINT.EQ.'OFF')GOTO1331 IF(MESSAG.EQ.'NO')GOTO1331 WRITE(ICOUT,1321)ISUBN1,ISUBN2 1321 FORMAT('***** ERROR IN ',A4,A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1322) 1322 FORMAT(' A NAME WHICH SHOULD BE A VARIABLE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1323) 1323 FORMAT(' HAS BEEN FOUND IN THE NAME LIST,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1324) 1324 FORMAT(' BUT AS A TYPE OTHER THAN A VARIABLE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1325)IHTEST,IHTES2 1325 FORMAT('NAME = ',A4,A4) CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).EQ.'P')WRITE(ICOUT,1326) 1326 FORMAT('TYPE = PARAMETER') IF(IUSE(ILOC).EQ.'P')CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).EQ.'F')WRITE(ICOUT,1327) 1327 FORMAT('TYPE = FUNCTION') IF(IUSE(ILOC).EQ.'F')CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).NE.'P'.AND.IUSE(ILOC).NE.'F')WRITE(ICOUT,1328) 1IUSE(ILOC) 1328 FORMAT('TYPE = ',A4) IF(IUSE(ILOC).NE.'P'.AND.IUSE(ILOC).NE.'F') 1CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1329) 1329 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1330)(IANS(J),J=1,IWIDTH) 1330 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') 1331 CONTINUE IERROR='YES' GOTO9000 C 1340 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1351 IF(IPRINT.EQ.'OFF')GOTO1351 IF(MESSAG.EQ.'NO')GOTO1351 WRITE(ICOUT,1341)ISUBN1,ISUBN2 1341 FORMAT('***** ERROR IN ',A4,A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1342) 1342 FORMAT(' ALL VARIABLES USED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1343) 1343 FORMAT(' ON THE RIGHT-HAND SIDE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1344) 1344 FORMAT(' MUST HAVE LENGTH GREATER THAN (OR EQUAL TO) 1') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1345) 1345 FORMAT(' (NUMBER OF ELEMNTS IS AT LEAST 1);') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1346) 1346 FORMAT(' SUCH WAS NOT THE CASE HERE FOR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1347)IHTEST,IHTES2,IN(ILOC) 1347 FORMAT(' VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1349) 1349 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1350)(IANS(J),J=1,IWIDTH) 1350 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') 1351 CONTINUE IERROR='YES' GOTO9000 C 1360 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1371 IF(IPRINT.EQ.'OFF')GOTO1371 IF(MESSAG.EQ.'NO')GOTO1371 WRITE(ICOUT,1361)ISUBN1,ISUBN2 1361 FORMAT('***** ERROR IN ',A4,A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1362) 1362 FORMAT(' ALL VARIABLES USED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1363) 1363 FORMAT(' ON THE RIGHT-HAND SIDE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1364) 1364 FORMAT(' MUST HAVE THE SAME LENGTH') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1365) 1365 FORMAT(' (NUMBER OF ELEMENTS);') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1366) 1366 FORMAT(' SUCH WAS NOT THE CASE HERE FOR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1367)IHTEST,IHTES2,JN 1367 FORMAT(' VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1368)IOLDNA,IOLDN2,IOLDNI 1368 FORMAT(' VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1369) 1369 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1370)(IANS(J),J=1,IWIDTH) 1370 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') 1371 CONTINUE IERROR='YES' GOTO9000 C 1400 CONTINUE IF(ITTEST.EQ.'P'.AND.IUSE(ILOC).NE.'P')GOTO1420 IF(ITTEST.EQ.'V'.AND.IUSE(ILOC).NE.'V')GOTO1420 IF(IUSE(ILOC).EQ.'P')GOTO1405 IF(IUSE(ILOC).EQ.'V')GOTO1410 GOTO1420 C 1405 CONTINUE JVALUE=IVALUE(ILOC) AVALUE=VALUE(ILOC) JUSE=IUSE(ILOC) JN=IN(ILOC) GOTO9000 C 1410 CONTINUE JVALUE=IVALUE(ILOC) AVALUE=VALUE(ILOC) JUSE=IUSE(ILOC) JN=IN(ILOC) C IF(IOLDNI.NE.-999.AND.JN.NE.IOLDNI)GOTO1440 IF(JN.LE.0)GOTO1460 IOLDNA=IHTEST IOLDN2=IHTES2 IOLDNI=JN GOTO9000 C 1420 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1432 IF(IPRINT.EQ.'OFF')GOTO1432 IF(MESSAG.EQ.'NO')GOTO1432 WRITE(ICOUT,1421)ISUBN1,ISUBN2 1421 FORMAT('***** ERROR IN ',A4,A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1422) 1422 FORMAT(' A NAME WHICH SHOULD BE A VARIABLE ', 1'OR PARAMETER') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1423) 1423 FORMAT(' HAS BEEN FOUND IN THE NAME LIST,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1424) 1424 FORMAT(' BUT AS A TYPE OTHER THAN A VARIABLE ', 1'OR PARAMETER.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1425)IHTEST,IHTES2 1425 FORMAT('NAME = ',A4,A4) CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).EQ.'P')WRITE(ICOUT,1426) 1426 FORMAT('TYPE = PARAMETER') IF(IUSE(ILOC).EQ.'P')CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).EQ.'V')WRITE(ICOUT,1427) 1427 FORMAT('TYPE = VARIABLE') IF(IUSE(ILOC).EQ.'V')CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).EQ.'F')WRITE(ICOUT,1428) 1428 FORMAT('TYPE = FUNCTION') IF(IUSE(ILOC).EQ.'F')CALL DPWRST('XXX','BUG ') IF(IUSE(ILOC).NE.'P'.AND.IUSE(ILOC).NE.'V'. 1AND.IUSE(ILOC).NE.'F')WRITE(ICOUT,1429)IUSE(ILOC) 1429 FORMAT('TYPE = ',A4) IF(IUSE(ILOC).NE.'P'.AND.IUSE(ILOC).NE.'V'. 1AND.IUSE(ILOC).NE.'F')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1430) 1430 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1431)(IANS(J),J=1,IWIDTH) 1431 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') 1432 CONTINUE IERROR='YES' GOTO9000 C 1440 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1451 IF(IPRINT.EQ.'OFF')GOTO1451 IF(MESSAG.EQ.'NO')GOTO1451 WRITE(ICOUT,1441)ISUBN1,ISUBN2 1441 FORMAT('***** ERROR IN ',A4,A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1442) 1442 FORMAT(' ALL VARIABLES USED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1443) 1443 FORMAT(' ON THE RIGHT-HAND SIDE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1444) 1444 FORMAT(' MUST HAVE LENGTH GREATER THAN (OR EQUAL TO) 1') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1445) 1445 FORMAT(' (NUMBER OF ELEMENTS IS AT LEAST 1);') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1446) 1446 FORMAT(' SUCH WAS NOT THE CASE HERE FOR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1447)IHTEST,IHTES2,IN(ILOC) 1447 FORMAT(' VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1449) 1449 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1450)(IANS(J),J=1,IWIDTH) 1450 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') 1451 CONTINUE IERROR='YES' GOTO9000 C 1460 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1471 IF(IPRINT.EQ.'OFF')GOTO1471 IF(MESSAG.EQ.'NO')GOTO1471 WRITE(ICOUT,1461)ISUBN1,ISUBN2 1461 FORMAT('***** ERROR IN ',A4,A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1462) 1462 FORMAT(' ALL VARIABLES USED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1463) 1463 FORMAT(' ON THE RIGHT-HAND SIDE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1464) 1464 FORMAT(' MUST HAVE THE SAME LENGTH') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1465) 1465 FORMAT(' (NUMBER OF ELEMENTS);') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1466) 1466 FORMAT(' SUCH WAS NOT THE CASE HERE FOR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1467)IHTEST,IHTES2,JN 1467 FORMAT(' VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1468)IOLDNA,IOLDN2,IOLDNI 1468 FORMAT(' VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1469) 1469 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1470)(IANS(J),J=1,IWIDTH) 1470 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') 1471 CONTINUE IERROR='YES' GOTO9000 C 1000 CONTINUE C 1010 CONTINUE IF(IFEEDB.EQ.'OFF')GOTO1021 IF(IPRINT.EQ.'OFF')GOTO1021 IF(MESSAG.EQ.'NO')GOTO1021 WRITE(ICOUT,1011)ISUBN1,ISUBN2 1011 FORMAT('***** ERROR IN ',A4,A4,'--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1012) 1012 FORMAT(' A VARIABLE OR PARAMETER NAME USED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1013) 1013 FORMAT(' ON THE RIGHT-HAND SIDE IS NOT YET DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1014)IHTEST,IHTES2 1014 FORMAT(' VARIABLE OR PARAMETER NAME = ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1015) 1015 FORMAT(' CURRENT LIST OF DEFINED VARIABLES AND ', 1'PARAMETERS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO1016I2=1,NUMNAM IF(IUSE(I).EQ.'P'.OR.IUSE(I).EQ.'V') 1WRITE(ICOUT,1017)IHNAME(I2),IHNAM2(I2),IUSE(I2),IVALUE(I2), 1VALUE(I2),IN(ILOC) 1017 FORMAT(A4,2X,A4,2X,A4,2X,I8,2X,E15.6,I8) IF(IUSE(I).EQ.'P'.OR.IUSE(I).EQ.'V') 1CALL DPWRST('XXX','BUG ') 1016 CONTINUE WRITE(ICOUT,1019) 1019 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1020)(IANS(J),J=1,IWIDTH) 1020 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') 1021 CONTINUE IERROR='YES' GOTO9000 C 9000 CONTINUE C IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ECN2')GOTO9090 WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CHECN2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ILOC 9012 FORMAT('ILOC = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)JVALUE,AVALUE,JUSE,JN 9013 FORMAT('JVALUE,AVALUE,JUSE,JN = ',I8,F15.7,3X,A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IOLDNA,IOLDN2,IOLDNI,IFOUND,IBUGA3,IERROR 9014 FORMAT('IOLDNA,IOLDN2,IOLDNI,IFOUND,IBUGA3,IERROR = ', 1A4,2X,A4,2X,I8,2X,A4,I8,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CHLHSN(NR,N,A,EPSM,SX,UDIAG) IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C PURPOSE C ------- C FIND THE L(L-TRANSPOSE) [WRITTEN LL+] DECOMPOSITION OF THE PERTURBED C MODEL HESSIAN MATRIX A+MU*I(WHERE MU\0 AND I IS THE IDENTITY MATRIX) C WHICH IS SAFELY POSITIVE DEFINITE. IF A IS SAFELY POSITIVE DEFINITE C UPON ENTRY, THEN MU=0. C C PARAMETERS C ---------- C NR --> ROW DIMENSION OF MATRIX C N --> DIMENSION OF PROBLEM C A(N,N) <--> ON ENTRY; "A" IS MODEL HESSIAN (ONLY LOWER C TRIANGULAR PART AND DIAGONAL STORED) C ON EXIT: A CONTAINS L OF LL+ DECOMPOSITION OF C PERTURBED MODEL HESSIAN IN LOWER TRIANGULAR C PART AND DIAGONAL AND CONTAINS HESSIAN IN UPPER C TRIANGULAR PART AND UDIAG C EPSM --> MACHINE EPSILON C SX(N) --> DIAGONAL SCALING MATRIX FOR X C UDIAG(N) <-- ON EXIT: CONTAINS DIAGONAL OF HESSIAN C C INTERNAL VARIABLES C ------------------ C TOL TOLERANCE C DIAGMN MINIMUM ELEMENT ON DIAGONAL OF A C DIAGMX MAXIMUM ELEMENT ON DIAGONAL OF A C OFFMAX MAXIMUM OFF-DIAGONAL ELEMENT OF A C OFFROW SUM OF OFF-DIAGONAL ELEMENTS IN A ROW OF A C EVMIN MINIMUM EIGENVALUE OF A C EVMAX MAXIMUM EIGENVALUE OF A C C DESCRIPTION C ----------- C 1. IF "A" HAS ANY NEGATIVE DIAGONAL ELEMENTS, THEN CHOOSE MU>0 C SUCH THAT THE DIAGONAL OF A:=A+MU*I IS ALL POSITIVE C WITH THE RATIO OF ITS SMALLEST TO LARGEST ELEMENT ON THE C ORDER OF SQRT(EPSM). C C 2. "A" UNDERGOES A PERTURBED CHOLESKY DECOMPOSITION WHICH C RESULTS IN AN LL+ DECOMPOSITION OF A+D, WHERE D IS A C NON-NEGATIVE DIAGONAL MATRIX WHICH IS IMPLICITLY ADDED TO C "A" DURING THE DECOMPOSITION IF "A" IS NOT POSITIVE DEFINITE. C "A" IS RETAINED AND NOT CHANGED DURING THIS PROCESS BY C COPYING L INTO THE UPPER TRIANGULAR PART OF "A" AND THE C DIAGONAL INTO UDIAG. THEN THE CHOLESKY DECOMPOSITION ROUTINE C IS CALLED. ON RETURN, ADDMAX CONTAINS MAXIMUM ELEMENT OF D. C C 3. IF ADDMAX=0, "A" WAS POSITIVE DEFINITE GOING INTO STEP 2 C AND RETURN IS MADE TO CALLING PROGRAM. OTHERWISE, C THE MINIMUM NUMBER SDD WHICH MUST BE ADDED TO THE C DIAGONAL OF A TO MAKE IT SAFELY STRICTLY DIAGONALLY DOMINANT C IS CALCULATED. SINCE A+ADDMAX*I AND A+SDD*I ARE SAFELY C POSITIVE DEFINITE, CHOOSE MU=MIN(ADDMAX,SDD) AND DECOMPOSE C A+MU*I TO OBTAIN L. C DIMENSION A(NR,1),SX(N),UDIAG(N) C C SCALE HESSIAN C PRE- AND POST- MULTIPLY "A" BY INV(SX) C DO 20 J=1,N DO 10 I=J,N A(I,J)=A(I,J)/(SX(I)*SX(J)) 10 CONTINUE 20 CONTINUE C C STEP1 C ----- C NOTE: IF A DIFFERENT TOLERANCE IS DESIRED THROUGHOUT THIS C ALGORITHM, CHANGE TOLERANCE HERE: TOL=SQRT(EPSM) C DIAGMX=A(1,1) DIAGMN=A(1,1) IF(N.EQ.1) GO TO 35 DO 30 I=2,N IF(A(I,I).LT.DIAGMN) DIAGMN=A(I,I) IF(A(I,I).GT.DIAGMX) DIAGMX=A(I,I) 30 CONTINUE 35 POSMAX=MAX(DIAGMX,0.D0) C C DIAGMN .LE. 0 C IF(DIAGMN.GT.POSMAX*TOL) GO TO 100 C IF(DIAGMN.LE.POSMAX*TOL) C THEN AMU=TOL*(POSMAX-DIAGMN)-DIAGMN IF(AMU.NE.0.) GO TO 60 C IF(AMU.EQ.0.) C THEN C C FIND LARGEST OFF-DIAGONAL ELEMENT OF A OFFMAX=0. IF(N.EQ.1) GO TO 50 DO 45 I=2,N IM1=I-1 DO 40 J=1,IM1 IF(ABS(A(I,J)).GT.OFFMAX) OFFMAX=ABS(A(I,J)) 40 CONTINUE 45 CONTINUE 50 AMU=OFFMAX IF(AMU.NE.0.) GO TO 55 C IF(AMU.EQ.0.) C THEN AMU=1.0 GO TO 60 C ELSE 55 AMU=AMU*(1.0+TOL) C ENDIF C ENDIF C C A=A + MU*I C 60 DO 65 I=1,N A(I,I)=A(I,I)+AMU 65 CONTINUE DIAGMX=DIAGMX+AMU C ENDIF C C STEP2 C ----- C COPY LOWER TRIANGULAR PART OF "A" TO UPPER TRIANGULAR PART C AND DIAGONAL OF "A" TO UDIAG C 100 CONTINUE DO 110 J=1,N UDIAG(J)=A(J,J) IF(J.EQ.N) GO TO 110 JP1=J+1 DO 105 I=JP1,N A(J,I)=A(I,J) 105 CONTINUE 110 CONTINUE C CALL CHOLDC(NR,N,A,DIAGMX,TOL,ADDMAX) C C C STEP3 C ----- C IF ADDMAX=0, "A" WAS POSITIVE DEFINITE GOING INTO STEP 2, C THE LL+ DECOMPOSITION HAS BEEN DONE, AND WE RETURN. C OTHERWISE, ADDMAX>0. PERTURB "A" SO THAT IT IS SAFELY C DIAGONALLY DOMINANT AND FIND LL+ DECOMPOSITION C IF(ADDMAX.LE.0.) GO TO 170 C IF(ADDMAX.GT.0.) C THEN C C RESTORE ORIGINAL "A" (LOWER TRIANGULAR PART AND DIAGONAL) C DO 120 J=1,N A(J,J)=UDIAG(J) IF(J.EQ.N) GO TO 120 JP1=J+1 DO 115 I=JP1,N A(I,J)=A(J,I) 115 CONTINUE 120 CONTINUE C C FIND SDD SUCH THAT A+SDD*I IS SAFELY POSITIVE DEFINITE C NOTE: EVMIN<0 SINCE A IS NOT POSITIVE DEFINITE; C EVMIN=0. EVMAX=A(1,1) DO 150 I=1,N OFFROW=0. IF(I.EQ.1) GO TO 135 IM1=I-1 DO 130 J=1,IM1 OFFROW=OFFROW+ABS(A(I,J)) 130 CONTINUE 135 IF(I.EQ.N) GO TO 145 IP1=I+1 DO 140 J=IP1,N OFFROW=OFFROW+ABS(A(J,I)) 140 CONTINUE 145 EVMIN=MIN(EVMIN,A(I,I)-OFFROW) EVMAX=MAX(EVMAX,A(I,I)+OFFROW) 150 CONTINUE SDD=TOL*(EVMAX-EVMIN)-EVMIN C C PERTURB "A" AND DECOMPOSE AGAIN C AMU=MIN(SDD,ADDMAX) DO 160 I=1,N A(I,I)=A(I,I)+AMU UDIAG(I)=A(I,I) 160 CONTINUE C C "A" NOW GUARANTEED SAFELY POSITIVE DEFINITE C CALL CHOLDC(NR,N,A,0.0D0,TOL,ADDMAX) C ENDIF C C UNSCALE HESSIAN AND CHOLESKY DECOMPOSITION MATRIX C 170 DO 190 J=1,N DO 175 I=J,N A(I,J)=SX(I)*A(I,J) 175 CONTINUE IF(J.EQ.1) GO TO 185 JM1=J-1 DO 180 I=1,JM1 A(I,J)=SX(I)*SX(J)*A(I,J) 180 CONTINUE 185 UDIAG(J)=UDIAG(J)*SX(J)*SX(J) 190 CONTINUE RETURN END SUBROUTINE CHOLDC(NR,N,A,DIAGMX,TOL,ADDMAX) IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C PURPOSE C ------- C FIND THE PERTURBED L(L-TRANSPOSE) [WRITTEN LL+] DECOMPOSITION C OF A+D, WHERE D IS A NON-NEGATIVE DIAGONAL MATRIX ADDED TO A IF C NECESSARY TO ALLOW THE CHOLESKY DECOMPOSITION TO CONTINUE. C C PARAMETERS C ---------- C NR --> ROW DIMENSION OF MATRIX C N --> DIMENSION OF PROBLEM C A(N,N) <--> ON ENTRY: MATRIX FOR WHICH TO FIND PERTURBED C CHOLESKY DECOMPOSITION C ON EXIT: CONTAINS L OF LL+ DECOMPOSITION C IN LOWER TRIANGULAR PART AND DIAGONAL OF "A" C DIAGMX --> MAXIMUM DIAGONAL ELEMENT OF "A" C TOL --> TOLERANCE C ADDMAX <-- MAXIMUM AMOUNT IMPLICITLY ADDED TO DIAGONAL OF "A" C IN FORMING THE CHOLESKY DECOMPOSITION OF A+D C INTERNAL VARIABLES C ------------------ C AMINL SMALLEST ELEMENT ALLOWED ON DIAGONAL OF L C AMNLSQ =AMINL**2 C OFFMAX MAXIMUM OFF-DIAGONAL ELEMENT IN COLUMN OF A C C C DESCRIPTION C ----------- C THE NORMAL CHOLESKY DECOMPOSITION IS PERFORMED. HOWEVER, IF AT ANY C POINT THE ALGORITHM WOULD ATTEMPT TO SET L(I,I)=SQRT(TEMP) C WITH TEMP < TOL*DIAGMX, THEN L(I,I) IS SET TO SQRT(TOL*DIAGMX) C INSTEAD. THIS IS EQUIVALENT TO ADDING TOL*DIAGMX-TEMP TO A(I,I) C C DIMENSION A(NR,1) C ADDMAX=0. AMINL=SQRT(DIAGMX*TOL) AMNLSQ=AMINL*AMINL C C FORM COLUMN J OF L C DO 100 J=1,N C FIND DIAGONAL ELEMENTS OF L SUM=0. IF(J.EQ.1) GO TO 20 JM1=J-1 DO 10 K=1,JM1 SUM=SUM + A(J,K)*A(J,K) 10 CONTINUE 20 TEMP=A(J,J)-SUM IF(TEMP.LT.AMNLSQ) GO TO 30 C IF(TEMP.GE.AMINL**2) C THEN A(J,J)=SQRT(TEMP) GO TO 40 C ELSE C C FIND MAXIMUM OFF-DIAGONAL ELEMENT IN COLUMN 30 OFFMAX=0. IF(J.EQ.N) GO TO 37 JP1=J+1 DO 35 I=JP1,N IF(ABS(A(I,J)).GT.OFFMAX) OFFMAX=ABS(A(I,J)) 35 CONTINUE 37 IF(OFFMAX.LE.AMNLSQ) OFFMAX=AMNLSQ C C ADD TO DIAGONAL ELEMENT TO ALLOW CHOLESKY DECOMPOSITION TO CONTINUE A(J,J)=SQRT(OFFMAX) ADDMAX=MAX(ADDMAX,OFFMAX-TEMP) C ENDIF C C FIND I,J ELEMENT OF LOWER TRIANGULAR MATRIX 40 IF(J.EQ.N) GO TO 100 JP1=J+1 DO 70 I=JP1,N SUM=0.0 IF(J.EQ.1) GO TO 60 JM1=J-1 DO 50 K=1,JM1 SUM=SUM+A(I,K)*A(J,K) 50 CONTINUE 60 A(I,J)=(A(I,J)-SUM)/A(J,J) 70 CONTINUE 100 CONTINUE RETURN END SUBROUTINE CHOLNV(N, CHOINV) * * Inverts a lower triangular matrix in situ * INTEGER I, II, J, JJ, K, KK, N DOUBLE PRECISION CHOINV(*), T DOUBLE PRECISION S II = 0 DO 100 I = 1,N T = 1/CHOINV(II+I) JJ = 0 DO 200 J = 1,I-1 S = 0 JJ = JJ + J KK = JJ DO 300 K = J,I-1 S = S + CHOINV(II+K)*CHOINV(KK) KK = KK + K 300 CONTINUE CHOINV(II+J) = -S*T 200 CONTINUE II = II + I CHOINV(II) = T 100 CONTINUE C RETURN END SUBROUTINE CHOLPD(N, CHOPRD) * * Multiplies Choleski factors in situ * INTEGER I, II, J, K, KK, N, NN DOUBLE PRECISION CHOPRD(*), S NN = (N*(N+1))/2 KK = NN DO 100 K = N,1,-1 KK = KK - K II = NN DO 200 I = N,K,-1 II = II - I S = 0 DO 300 J = 1,K S = S + CHOPRD(II+J)*CHOPRD(KK+J) 300 CONTINUE CHOPRD(II+K) = S 200 CONTINUE 100 CONTINUE C RETURN END SUBROUTINE CHOLPI(N, CHOPDI) * * Multiplies Choleski inverse factors in situ * INTEGER I, II, J, JJ, K, KK, N DOUBLE PRECISION CHOPDI(*) DOUBLE PRECISION S II = 0 DO 100 I = 1,N DO 200 J = 1,I S = 0 JJ = II + I KK = II + J DO 300 K = I,N S = S + CHOPDI(KK)*CHOPDI(JJ) JJ = JJ + K KK = KK + K 300 CONTINUE CHOPDI(II+J) = S 200 CONTINUE II = II + I 100 CONTINUE C RETURN END SUBROUTINE CHOLSK(N, CHOFAC) * * Computes Choleski factor in situ * INTEGER I, II, J, JJ, K, N DOUBLE PRECISION CHOFAC(*), T DOUBLE PRECISION S, ZERO PARAMETER ( ZERO = 0 ) JJ = 0 DO 100 J = 1,N II = JJ DO 200 I = J,N S = CHOFAC(II+J) DO 300 K = 1,J-1 S = S - CHOFAC(II+K)*CHOFAC(JJ+K) 300 CONTINUE IF ( I .EQ. J ) THEN T = SQRT( MAX( S, ZERO ) ) CHOFAC(II+J) = T ELSE CHOFAC(II+J) = S/T ENDIF II = II + I 200 CONTINUE JJ = JJ + J 100 CONTINUE C RETURN END SUBROUTINE CHSCDF(X,NU,CDF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X. C THE PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C --NU = THE INTEGER NUMBER OF DEGREES C OF FREEDOM. C NU SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE CHI-SQUARED DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE. C --NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 941, FORMULAE 26.4.4 AND 26.4.5. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGE 176, C FORMULA 28, AND PAGE 180, FORMULA 33.1. C --OWEN, HANDBOOK OF STATISTICAL TABLES, C 1962, PAGES 50-55. C --PEARSON AND HARTLEY, BIOMETRIKA TABLES C FOR STATISTICIANS, VOLUME 1, 1954, C PAGES 122-131. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--JUNE 1972. C UPDATED --MAY 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --OCTOBER 1976. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DOUBLE PRECISION DX,PI,CHI,SUM,TERM,AI,DCDFN DOUBLE PRECISION DNU DOUBLE PRECISION DSQRT,DEXP DOUBLE PRECISION DLOG DOUBLE PRECISION DFACT,DPOWER DOUBLE PRECISION DW DOUBLE PRECISION D1,D2,D3 DOUBLE PRECISION TERM0,TERM1,TERM2,TERM3,TERM4 DOUBLE PRECISION B11 DOUBLE PRECISION B21 DOUBLE PRECISION B31,B32 DOUBLE PRECISION B41,B42,B43 C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----DATA STATEMENTS------------------------------------------------- C DATA NUCUT/1000/ DATA PI/3.14159265358979D0/ DATA DPOWER/0.33333333333333D0/ DATA B11/0.33333333333333D0/ DATA B21/-0.02777777777778D0/ DATA B31/-0.00061728395061D0/ DATA B32/-13.0D0/ DATA B41/0.00018004115226D0/ DATA B42/6.0D0/ DATA B43/17.0D0/ C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(NU.LE.0)GOTO50 IF(X.LT.0.0)GOTO55 GOTO90 50 WRITE(ICOUT,15) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)NU CALL DPWRST('XXX','BUG ') CDF=0.0 RETURN 55 WRITE(ICOUT,4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)X CALL DPWRST('XXX','BUG ') CDF=0.0 RETURN 90 CONTINUE 4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 1ST INPUT ARGUMENT ', 1'TO THE CHSCDF SUBROUTINE IS NEGATIVE *****') 15 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT TO THE ', 1'CHSCDF SUBROUTINE IS NON-POSITIVE *****') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****') 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8 ,' *****') C DX=X ANU=NU DNU=NU C C IF X IS NON-POSITIVE, SET CDF = 0.0 AND RETURN. C IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200 C STANDARD DEVIATIONS BELOW THE MEAN, C SET CDF = 0.0 AND RETURN. C IF NU IS 10 OR LARGER AND X IS MORE THAN 100 C STANDARD DEVIATIONS BELOW THE MEAN, C SET CDF = 0.0 AND RETURN. C IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200 C STANDARD DEVIATIONS ABOVE THE MEAN, C SET CDF = 1.0 AND RETURN. C IF NU IS 10 OR LARGER AND X IS MORE THAN 100 C STANDARD DEVIATIONS ABOVE THE MEAN, C SET CDF = 1.0 AND RETURN. C IF(X.LE.0.0)GOTO105 AMEAN=ANU SD=SQRT(2.0*ANU) Z=(X-AMEAN)/SD IF(NU.LT.10.AND.Z.LT.-200.0)GOTO105 IF(NU.GE.10.AND.Z.LT.-100.0)GOTO105 IF(NU.LT.10.AND.Z.GT.200.0)GOTO107 IF(NU.GE.10.AND.Z.GT.100.0)GOTO107 GOTO109 105 CDF=0.0 RETURN 107 CDF=1.0 RETURN 109 CONTINUE C C DISTINGUISH BETWEEN 3 SEPARATE REGIONS C OF THE (X,NU) SPACE. C BRANCH TO THE PROPER COMPUTATIONAL METHOD C DEPENDING ON THE REGION. C NUCUT HAS THE VALUE 1000. C IF(NU.LT.NUCUT)GOTO1000 IF(NU.GE.NUCUT.AND.X.LE.ANU)GOTO2000 IF(NU.GE.NUCUT.AND.X.GT.ANU)GOTO3000 IBRAN=1 WRITE(ICOUT,99)IBRAN 99 FORMAT('*****INTERNAL ERROR IN CHSCDF SUBROUTINE--', 1'IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ',I8) CALL DPWRST('XXX','BUG ') RETURN C C TREAT THE SMALL AND MODERATE DEGREES OF FREEDOM CASE C (THAT IS, WHEN NU IS SMALLER THAN 1000). C METHOD UTILIZED--EXACT FINITE SUM C (SEE AMS 55, PAGE 941, FORMULAE 26.4.4 AND 26.4.5). C 1000 CONTINUE CHI=DSQRT(DX) IEVODD=NU-2*(NU/2) IF(IEVODD.EQ.0)GOTO120 C SUM=0.0D0 TERM=1.0/CHI IMIN=1 IMAX=NU-1 GOTO130 C 120 SUM=1.0D0 TERM=1.0D0 IMIN=2 IMAX=NU-2 C 130 IF(IMIN.GT.IMAX)GOTO160 DO100I=IMIN,IMAX,2 AI=I TERM=TERM*(DX/AI) SUM=SUM+TERM 100 CONTINUE 160 CONTINUE C SUM=SUM*DEXP(-DX/2.0D0) IF(IEVODD.EQ.0)GOTO170 SUM=(DSQRT(2.0D0/PI))*SUM SPCHI=CHI CALL NORCDF(SPCHI,CDFN) DCDFN=CDFN SUM=SUM+2.0D0*(1.0D0-DCDFN) 170 CDF=1.0D0-SUM RETURN C C TREAT THE CASE WHEN NU IS LARGE C (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000) C AND X IS LESS THAN OR EQUAL TO NU. C METHOD UTILIZED--WILSON-HILFERTY APPROXIMATION C (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 176, FORMULA 28). C 2000 CONTINUE DFACT=4.5D0*DNU U=(((DX/DNU)**DPOWER)-1.0D0+(1.0D0/DFACT))*DSQRT(DFACT) CALL NORCDF(U,CDFN) CDF=CDFN RETURN C C TREAT THE CASE WHEN NU IS LARGE C (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000) C AND X IS LARGER THAN NU. C METHOD UTILIZED--HILL'S ASYMPTOTIC EXPANSION C (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 180, FORMULA 33.1). C 3000 CONTINUE DW=DSQRT(DX-DNU-DNU*DLOG(DX/DNU)) DANU=DSQRT(2.0D0/DNU) D1=DW D2=DW**2 D3=DW**3 TERM0=DW TERM1=B11*DANU TERM2=B21*D1*(DANU**2) TERM3=B31*(D2+B32)*(DANU**3) TERM4=B41*(B42*D3+B43*D1)*(DANU**4) U=TERM0+TERM1+TERM2+TERM3+TERM4 CALL NORCDF(U,CDFN) CDF=CDFN RETURN C END SUBROUTINE CHSPDF(X,NU,PDF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C THIS DISTRIBUTION IS DEFINED FOR ALL X. C THE PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE PROBABILITY DENSITY C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C --NU = THE INTEGER NUMBER OF DEGREES C OF FREEDOM. C NU SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION PROBABILITY C DENSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY C FUNCTION VALUE PDF FOR THE THE CHI-SQUARED DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 941, FORMULAE 26.4.1. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGE XXX, C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--NOVEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DOUBLE PRECISION DX DOUBLE PRECISION DNU DOUBLE PRECISION DNUH DOUBLE PRECISION DGF DOUBLE PRECISION DPOWER DOUBLE PRECISION DCONST DOUBLE PRECISION DTERM1 DOUBLE PRECISION DTERM2 DOUBLE PRECISION DTERM C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C C ******************************************** C ** STEP 1-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C IF(NU.LE.0)GOTO150 GOTO190 150 CONTINUE WRITE(ICOUT,115) 115 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT ', 1'TO THE CHSPDF SUBROUTINE IS NON-POSITIVE *****') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,147)NU 147 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8, 1' *****') CALL DPWRST('XXX','BUG ') PDF=0.0 GOTO9000 190 CONTINUE C C ********************************************************** C ** STEP 2-- ** C ** COMPUTE THE CONSTANT = 1/((GAMMA(NU/2))*2**(NU/2)) ** C ********************************************************** C C DX=X DNU=NU DNUH=DNU/2.0D0 CALL DGAMMF(DNUH,DGF) DPOWER=2.0D0**DNUH DCONST=1.0D0/(DPOWER*DGF) C C ************************************ C ** STEP 3-- ** C ** COMPUTE THE DENSITY FUNCTION ** C ************************************ C IF(X.LE.0.0)PDF=0.0 IF(X.LE.0.0)GOTO9000 C DTERM1=DX**(DNUH-1.0D0) DTERM2=DEXP(-(DX/2.0D0)) DTERM=DTERM1*DTERM2 PDF=DCONST*DTERM GOTO9000 C 9000 CONTINUE CCCCC WRITE(ICOUT,9011)DX,DNUH,DNUH,DGF,DPOWER,DCONST C9011 FORMAT('DX,DNUH,DNUH,DGF,DPOWER,DCONST = ',6D12.4) CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,9012)DTERM1,DTERM2,DTERM,PDF C9012 FORMAT('DTERM1,DTERM2,DTERM,PDF = ',3D12.4,E15.7) CCCCC CALL DPWRST('XXX','BUG ') RETURN END SUBROUTINE CHSPPF(P,NU,PPF) C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C THE CHI-SQUARED DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL NON-NEGATIVE X, C AND ITS PROBABILITY DENSITY FUNCTION IS GIVEN C IN REFERENCES 2, 3, AND 4 BELOW. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --NU = THE INTEGER NUMBER OF DEGREES C OF FREEDOM. C NU SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE CHI-SQUARED DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE. C --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--DEXP, DLOG. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C ACCURACY--(ON THE UNIVAC 1108, EXEC 8 SYSTEM AT NBS) C COMPARED TO THE KNOWN NU = 2 (EXPONENTIAL) C RESULTS, AGREEMENT WAS HAD OUT TO 6 SIGNIFICANT C DIGITS FOR ALL TESTED P IN THE RANGE P = .001 TO C P = .999. FOR P = .95 AND SMALLER, THE AGREEMENT C WAS EVEN BETTER--7 SIGNIFICANT DIGITS. C (NOTE THAT THE TABULATED VALUES GIVEN IN THE WILK, C GNANADESIKAN, AND HUYETT REFERENCE BELOW, PAGE 20, C ARE IN ERROR FOR AT LEAST THE GAMMA = 1 CASE-- C THE WORST DETECTED ERROR WAS AGREEMENT TO ONLY 3 C SIGNIFICANT DIGITS (IN THEIR 8 SIGNIFICANT DIGIT TABLE) C FOR P = .999.) C REFERENCES--WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY C PLOTS FOR THE GAMMA DISTRIBUTION', C TECHNOMETRICS, 1962, PAGES 1-15, C ESPECIALLY PAGES 3-5. C --NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 257, FORMULA 6.1.41, C AND PAGES 940-943. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 166-206. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 46-51. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C UPDATED --JUNE 1987. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DOUBLE PRECISION DP,DGAMMA CCCCC DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D,G DOUBLE PRECISION Z,Z2,DEN,A,B,C,D DOUBLE PRECISION XMIN0,XMIN,AI,XMAX,DX,PCALC,XMID DOUBLE PRECISION XLOWER,XUPPER,XDEL DOUBLE PRECISION SUM,TERM,CUT1,CUT2,AJ,CUTOFF,T DOUBLE PRECISION DLG,DLT,DLX,DLPCAL DOUBLE PRECISION DLP,DLGAMM,DLXMI0 DOUBLE PRECISION Z2INV DOUBLE PRECISION DEXP,DLOG C DIMENSION D(10) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----DATA STATEMENTS------------------------------------------------- C DATA C/ .918938533204672741D0/ DATA D(1),D(2),D(3),D(4),D(5) 1 /+.833333333333333333D-1,-.277777777777777778D-2, 1+.793650793650793651D-3,-.595238095238095238D-3,+.8417508417508417 151D-3/ DATA D(6),D(7),D(8),D(9),D(10) 1 /-.191752691752691753D-2,+.641025641025641025D-2,-.2955065359 147712418D-1,+.179644372368830573D0,-.139243221690590111D1/ C C-----START POINT----------------------------------------------------- C XMID=0.0 XLOWER=0.0 XUPPER=0.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 IF(NU.LT.1)GOTO55 GOTO90 50 WRITE(ICOUT,1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46)P CALL DPWRST('XXX','BUG ') PPF=0.0 RETURN 55 WRITE(ICOUT,15) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)NU CALL DPWRST('XXX','BUG ') PPF=0.0 RETURN 90 CONTINUE 1 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ', 1'CHSPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL') 15 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT TO THE ', 1'CHSPPF SUBROUTINE IS NON-POSITIVE *****') 46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****') 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8 ,' *****') C C EXPRESS THE CHI-SQUARED DISTRIBUTION PERCENT POINT C FUNCTION IN TERMS OF THE EQUIVALENT GAMMA C DISTRIBUTION PERCENT POINT FUNCTION, C AND THEN EVALUATE THE LATTER. C DP=P DNU=NU DGAMMA=DNU/2.0D0 MAXIT=10000 C C COMPUTE THE GAMMA FUNCTION USING THE ALGORITHM IN THE C NBS APPLIED MATHEMATICS SERIES REFERENCE. C THIS GAMMA FUNCTION NEED BE CALCULATED ONLY ONCE. C IT IS USED IN THE CALCULATION OF THE CDF BASED ON C THE TENTATIVE VALUE OF THE PPF IN THE ITERATION. C Z=DGAMMA DEN=1.0D0 150 IF(Z.GE.10.0D0)GOTO160 DEN=DEN*Z Z=Z+1.0D0 GOTO150 160 Z2=Z*Z CCCCC Z3=Z*Z2 CCCCC Z4=Z2*Z2 CCCCC Z5=Z2*Z3 A=(Z-0.5D0)*DLOG(Z)-Z+C CCCCC B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+ CCCCC1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5) Z2INV=1.0D0/Z2 B=D(9) B=Z2INV*B+D(8) B=Z2INV*B+D(7) B=Z2INV*B+D(6) B=Z2INV*B+D(5) B=Z2INV*B+D(4) B=Z2INV*B+D(3) B=Z2INV*B+D(2) B=Z2INV*B+D(1) B=(1.0D0/Z)*B CCCCC G=DEXP(A+B)/DEN DLG=(A+B)-DLOG(DEN) C C DETERMINE LOWER AND UPPER LIMITS ON THE DESIRED 100P C PERCENT POINT. C ILOOP=1 CCCCC XMIN0=(DP*DGAMMA*G)**(1.0D0/DGAMMA) DLP=DLOG(DP) DLGAMM=DLOG(DGAMMA) DLXMI0=(1.0D0/DGAMMA)*(DLP+DLGAMM+DLG) XMIN0=DEXP(DLXMI0) XMIN=XMIN0 ICOUNT=1 350 AI=ICOUNT XMAX=AI*XMIN0 DX=XMAX GOTO1000 360 IF(PCALC.GE.DP)GOTO370 XMIN=XMAX ICOUNT=ICOUNT+1 IF(ICOUNT.LE.30000)GOTO350 370 XMID=(XMIN+XMAX)/2.0D0 C C NOW ITERATE BY BISECTION UNTIL THE DESIRED ACCURACY IS ACHIEVED. C ILOOP=2 XLOWER=XMIN XUPPER=XMAX ICOUNT=0 550 DX=XMID GOTO1000 560 IF(PCALC.EQ.DP)GOTO570 IF(PCALC.GT.DP)GOTO580 XLOWER=XMID XMID=(XMID+XUPPER)/2.0D0 GOTO590 580 XUPPER=XMID XMID=(XMID+XLOWER)/2.0D0 590 XDEL=XMID-XLOWER IF(XDEL.LT.0.0D0)XDEL=-XDEL ICOUNT=ICOUNT+1 IF(XDEL.LT.0.0000000001D0.OR.ICOUNT.GT.100)GOTO570 GOTO550 570 PPF=2.0D0*XMID RETURN C C******************************************************************** C THIS SECTION BELOW IS LOGICALLY SEPARATE FROM THE ABOVE. C THIS SECTION COMPUTES A CDF VALUE FOR ANY GIVEN TENTATIVE C PERCENT POINT X VALUE AS DEFINED IN EITHER OF THE 2 C ITERATION LOOPS IN THE ABOVE CODE. C C COMPUTE T-SUB-Q AS DEFINED ON PAGE 4 OF THE WILK, GNANADESIKAN, C AND HUYETT REFERENCE C 1000 SUM=1.0D0/DGAMMA TERM=1.0D0/DGAMMA CUT1=DX-DGAMMA CUT2=DX*10000000000.0D0 DO700J=1,MAXIT AJ=J TERM=DX*TERM/(DGAMMA+AJ) SUM=SUM+TERM CUTOFF=CUT1+(CUT2*TERM/SUM) IF(AJ.GT.CUTOFF)GOTO750 700 CONTINUE WRITE(ICOUT,705)MAXIT CALL DPWRST('XXX','BUG ') WRITE(ICOUT,706)P CALL DPWRST('XXX','BUG ') WRITE(ICOUT,707)NU CALL DPWRST('XXX','BUG ') WRITE(ICOUT,708) CALL DPWRST('XXX','BUG ') PPF=0.0 RETURN C 750 T=SUM DLT=DLOG(T) DLX=DLOG(DX) CCCCC WRITE(ICOUT,777)DX,DGAMMA,T,DLT,G,DLG CC777 FORMAT('DX,DGAMMA,T,DLT,G,DLG = ',6D15.7) CCCCC CALL DPWRST('XXX','BUG ') CCCCC PCALC=(DX**DGAMMA)*(DEXP(-DX))*T/G DLPCAL=DGAMMA*DLX-DX+DLT-DLG PCALC=DEXP(DLPCAL) IF(ILOOP.EQ.1)GOTO360 GOTO560 C 705 FORMAT('*****ERROR IN INTERNAL OPERATIONS IN THE CHSPPF ', 1'SUBROUTINE--THE NUMBER OF ITERATIONS EXCEEDS ',I7) 706 FORMAT(33H THE INPUT VALUE OF P IS ,E15.8) 707 FORMAT(33H THE INPUT VALUE OF NU IS ,I8) 708 FORMAT(48H THE OUTPUT VALUE OF PPF HAS BEEN SET TO 0.0) C END SUBROUTINE CHSRAN(N,ANU,ISEED,X) C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE CHI-SQUARED DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --NU = THE INTEGER DEGREES OF FREEDOM C (PARAMETER) FOR THE CHI-SQUARED C DISTRIBUTION. 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 CHI-SQUARED DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. 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 --NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG, SQRT, SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 34-35. C --MOOD AND GRABLE, INTRODUCTION TO THE C THEORY OF STATISTICS, 1963, PAGES 226-227. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGE 171. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 48. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--FEBRUARY 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C UPDATED --MAY 2004. ALLOW REAL VALUES FOR DEGREES C OF FREEDOM PARAMETER C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) DIMENSION Y(2),Z(2) C CHARACTER*4 ICASE C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----DATA STATEMENTS------------------------------------------------- C DATA PI/3.14159265359/ DATA EPS/0.00001/ C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)THEN WRITE(ICOUT,5) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47)N CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF 5 FORMAT('***** ERROR--THE REQUESTED NUMBER OF CHI-SQUARE ', 1'RANDOM NUMBERS IS NON-POSITIVE.') IF(ANU.LE.0.0)THEN WRITE(ICOUT,15) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,48)ANU CALL DPWRST('XXX','BUG ') GOTO9000 ENDIF 15 FORMAT('***** ERROR--THE DEGREES OF FREEDOM PARAMETER FOR ', 1'CHI-SQUARE RANDOM NUMBERS IS NON-POSITIVE.') 47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8) 48 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7) C NU=INT(ANU+0.1) ANU2=REAL(NU) IF(ABS(ANU-ANU2).LE.EPS)THEN ICASE='INTE' IF(NU.EQ.0)THEN ICASE='REAL' ANU=EPS ENDIF ELSE ICASE='REAL' ENDIF C C CASE 1: INTEGER DEGREES OF FREEDOM C IF(ICASE.EQ.'INTE')THEN C C GENERATE N CHI-SQUARED RANDOM NUMBERS C USING THE DEFINITION THAT C A CHI-SQUARED VARIATE WITH NU DEGREES OF FREEDOM C EQUALS THE SUM OF NU SQUARED NORMAL VARIATES. C FIRST GENERATE 2 UNIFORM (0,1) RANDOM NUMBERS, C THEN GENERATE 2 NORMAL RANDOM NUMBERS, C THEN FORM THE SUM OF SQUARED NORMAL RANDOM NUMBERS. C DO100I=1,N SUM=0.0 DO200J=1,NU,2 CALL UNIRAN(2,ISEED,Y) ARG1=-2.0*ALOG(Y(1)) ARG2=2.0*PI*Y(2) Z(1)=(SQRT(ARG1))*(COS(ARG2)) Z(2)=(SQRT(ARG1))*(SIN(ARG2)) SUM=SUM+Z(1)*Z(1) IF(J.EQ.NU)GOTO200 SUM=SUM+Z(2)*Z(2) 200 CONTINUE X(I)=SUM 100 CONTINUE C C CASE 2: REAL DEGREES OF FREEDOM C C GENERATE CHI-SQUARE RANDOM NUMBERS USING RELATIONSHIP C TO GAMMA DISTRIBUTION. C ELSE GAMMA=ANU/2.0 CALL GAMRAN(N,GAMMA,ISEED,X) DO300I=1,N X(I)=2.0*X(I) 300 CONTINUE C ENDIF C 9000 CONTINUE RETURN END SUBROUTINE CKARIT(IFOUNZ,IBEGIN,IANS,IWIDTH,ICASAR,IBUGA3) C C PURPOSE--FOR THE LET COMMAND, C DETERMINE IF AN ARITHMETIC OPERATOR C EXISTS ANYWHERE FROM THE BEGINNING C OF THE COMMAND LINE TO SUBSET/EXCEPT/FOR OR END OF LINE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--89/1 C ORIGINAL VERSION--JANUARY 1989. C UPDATED --JULY 1989. COMMENT OUT IERROR C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IFOUNZ CHARACTER*4 IANS CHARACTER*4 ICASAR CHARACTER*4 IBUGA3 C C--------------------------------------------------------------------- C INCLUDE 'DPCOPA.INC' C DIMENSION IFOUNZ(*) DIMENSION IBEGIN(*) DIMENSION IANS(*) 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(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPARIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IFOUNZ(11),IBEGIN(11) 52 FORMAT('IFOUNZ(11),IBEGIN(11) = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IFOUNZ(21),IBEGIN(21) 53 FORMAT('IFOUNZ(21),IBEGIN(21) = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IWIDTH 61 FORMAT('IWIDTH = ',I8) CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1) 1WRITE(ICOUT,62)(IANS(I),I=1,80) 62 FORMAT('IANS(.) = ',80A1) IF(IWIDTH.GE.1) 1CALL DPWRST('XXX','BUG ') 90 CONTINUE C CCCCC THE FOLLOWING LINE WAS COMMENTED OUT JULY 1989 CCCCC IERROR='NO' ICASAR='NO' C IMAX=IWIDTH IF(IFOUNZ(11).EQ.'YES')IMAX=IBEGIN(11) IF(IFOUNZ(21).EQ.'YES')IMAX=IBEGIN(21) C IF(IMAX.LE.0)GOTO9000 DO1100I=1,IMAX IF(IANS(I).EQ.'+')GOTO1150 IF(IANS(I).EQ.'-')GOTO1150 IF(IANS(I).EQ.'*')GOTO1150 IF(IANS(I).EQ.'/')GOTO1150 1100 CONTINUE ICASAR='NO' GOTO9000 1150 CONTINUE ICASAR='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPARIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASAR 9012 FORMAT('ICASAR = ',A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CKCPMA(ENGUSL,ENGLSL,TARGET,IBUGG3,ISUBRO,IERROR) C C PURPOSE--CHECK THE PARAMETERS NEEDED C FOR THE CPM STATISTIC. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--98/11 C ORIGINAL VERSION--NOVEMBER 1998. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGG3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 IHP CHARACTER*4 IHP2 CHARACTER*4 IHWUSE CHARACTER*4 MESSAG C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 C C--------------------------------------------------------------------- C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.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='CKCP' ISUBN2='MA ' C IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CPMA')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKCPMA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR 52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C -------------------------- C IHP='USL ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO1110 ENGUSL=VALUE(ILOCP) GOTO1119 C 1110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1111) 1111 FORMAT('***** ERROR IN CKCPMA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1112) 1112 FORMAT(' IN COMPUTING THE CPM,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1114) 1114 FORMAT(' THE VALUE OF THE UPPER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115) 1115 FORMAT(' (PARAMETER USL) MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1116) 1116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE USL,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117) 1117 FORMAT(' AS IN LET USL = 1100') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1119 CONTINUE C C -------------------------- C IHP='LSL ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO2110 ENGLSL=VALUE(ILOCP) GOTO2119 C 2110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2111) 2111 FORMAT('***** ERROR IN CKCPMA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2112) 2112 FORMAT(' IN COMPUTING THE CPM STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2114) 2114 FORMAT(' THE VALUE OF THE LOWER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2115) 2115 FORMAT(' (PARAMETER LSL) MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2116) 2116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE LSL,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2117) 2117 FORMAT(' AS IN LET LSL = 900') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 2119 CONTINUE C C -------------------------- C IHP='TARG' IHP2='ET ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO3110 TARGET=VALUE(ILOCP) GOTO3119 C 3110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3111) 3111 FORMAT('***** ERROR IN CKCPMA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3112) 3112 FORMAT(' IN COMPUTING THE CPM STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3114) 3114 FORMAT(' THE VALUE OF THE TARGET SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3115) 3115 FORMAT(' (PARAMETER TARGET) MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3116) 3116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE TARGET,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3117) 3117 FORMAT(' AS IN LET TARGET = 10000') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 3119 CONTINUE C C -------------------------- C IF(ENGLSL.LT.ENGUSL)GOTO4129 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4111) 4111 FORMAT('***** ERROR IN CKCPMA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4112) 4112 FORMAT(' IN COMPUTING THE CPM STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4114) 4114 FORMAT(' THE VALUE OF THE LOWER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4115) 4115 FORMAT(' (PARAMETER LSL) MUST BE STRICTLY') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4116) 4116 FORMAT(' LESS THAN THE VALUE OF THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4117) 4117 FORMAT(' UPPER SPEC LIMIT (PARAMETER USL).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4118) 4118 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4119)ENGLSL 4119 FORMAT(' LSL = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4120)ENGUSL 4120 FORMAT(' USL = ',E15.7) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 4129 CONTINUE C C ****************** C ** STEP 90-- ** C ** EXIT ** C ****************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ELPA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKCPMA--') 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)ENGUSL,ENGLSL,TARGET 9013 FORMAT('ENGUSL,ENGLSL,TARGET = ',3E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CKCPPA(ENGUSL,ENGLSL,IBUGG3,ISUBRO,IERROR) C C PURPOSE--CHECK THE PARAMETERS NEEDED C FOR THE CP STATISTIC, C FOR THE CPK STATISTIC, AND C FOR THE PERCENT DEFECTIVE STATISTIC.. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--89/6 C ORIGINAL VERSION--MAY 1988. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGG3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 IHP CHARACTER*4 IHP2 CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CCCCC CHARACTER*4 IWRITE C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CCCCC CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.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='CKCP' ISUBN2='PA ' C IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CPPA')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKCPPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR 52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C -------------------------- C IHP='USL ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO1110 ENGUSL=VALUE(ILOCP) GOTO1119 C 1110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1111) 1111 FORMAT('***** ERROR IN CKCPPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1112) 1112 FORMAT(' IN COMPUTING THE CP, THE CPK,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1113) 1113 FORMAT(' AND THE PERCENT DEFECTIVE STATISTICS,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1114) 1114 FORMAT(' THE VALUE OF THE UPPER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115) 1115 FORMAT(' (PARAMETER USL) MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1116) 1116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE USL,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117) 1117 FORMAT(' AS IN LET USL = 1100') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1119 CONTINUE C C -------------------------- C IHP='LSL ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO2110 ENGLSL=VALUE(ILOCP) GOTO2119 C 2110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2111) 2111 FORMAT('***** ERROR IN CKCPPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2112) 2112 FORMAT(' IN COMPUTING THE CP, THE CPK,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2113) 2113 FORMAT(' AND THE PERCENT DEFECTIVE STATISTICS,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2114) 2114 FORMAT(' THE VALUE OF THE LOWER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2115) 2115 FORMAT(' (PARAMETER LSL) MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2116) 2116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE LSL,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2117) 2117 FORMAT(' AS IN LET LSL = 900') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 2119 CONTINUE C C -------------------------- C IF(ENGLSL.LT.ENGUSL)GOTO3129 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3111) 3111 FORMAT('***** ERROR IN CKCPPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3112) 3112 FORMAT(' IN COMPUTING THE CP, THE CPK,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3113) 3113 FORMAT(' AND THE PERCENT DEFECTIVE STATISTICS,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3114) 3114 FORMAT(' THE VALUE OF THE LOWER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3115) 3115 FORMAT(' (PARAMETER LSL) MUST BE STRICTLY') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3116) 3116 FORMAT(' LESS THAN THE VALUE OF THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3117) 3117 FORMAT(' UPPER SPEC LIMIT (PARAMETER USL).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3118) 3118 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3119)ENGLSL 3119 FORMAT(' LSL = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3120)ENGUSL 3120 FORMAT(' USL = ',E15.7) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 3129 CONTINUE C C ****************** C ** STEP 90-- ** C ** EXIT ** C ****************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CPPA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKCPPA--') 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)ENGUSL,ENGLSL 9013 FORMAT('ENGUSL,ENGLSL = ',2E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CKELPA(ENGUSL,ENGLSL,COSUSL,IBUGG3,ISUBRO,IERROR) C C PURPOSE--CHECK THE PARAMETERS NEEDED C FOR THE EXPECTED LOSS STATISTIC. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--89/6 C ORIGINAL VERSION--MAY 1988. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGG3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 IHP CHARACTER*4 IHP2 CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CCCCC CHARACTER*4 IWRITE C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CCCCC CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.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='CKEL' ISUBN2='PA ' C IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ELPA')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKELPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR 52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C -------------------------- C IHP='USL ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO1110 ENGUSL=VALUE(ILOCP) GOTO1119 C 1110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1111) 1111 FORMAT('***** ERROR IN CKELPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1112) 1112 FORMAT(' IN COMPUTING THE EXPECTED LOSS STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1114) 1114 FORMAT(' THE VALUE OF THE UPPER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115) 1115 FORMAT(' (PARAMETER USL) MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1116) 1116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE USL,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117) 1117 FORMAT(' AS IN LET USL = 1100') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1119 CONTINUE C C -------------------------- C IHP='LSL ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO2110 ENGLSL=VALUE(ILOCP) GOTO2119 C 2110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2111) 2111 FORMAT('***** ERROR IN CKELPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2112) 2112 FORMAT(' IN COMPUTING THE EXPECTED LOSS STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2114) 2114 FORMAT(' THE VALUE OF THE LOWER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2115) 2115 FORMAT(' (PARAMETER LSL) MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2116) 2116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE LSL,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2117) 2117 FORMAT(' AS IN LET LSL = 900') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 2119 CONTINUE C C -------------------------- C IHP='COST' IHP2='USL ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO3110 COSUSL=VALUE(ILOCP) GOTO3119 C 3110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3111) 3111 FORMAT('***** ERROR IN CKELPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3112) 3112 FORMAT(' IN COMPUTING THE EXPECTED LOSS STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3114) 3114 FORMAT(' THE VALUE OF THE COST AT UPPER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3115) 3115 FORMAT(' (PARAMETER COSTUSL) MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3116) 3116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE COSTUSL,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3117) 3117 FORMAT(' AS IN LET COSTUSL = 10000') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 3119 CONTINUE C C -------------------------- C IF(ENGLSL.LT.ENGUSL)GOTO4129 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4111) 4111 FORMAT('***** ERROR IN CKELPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4112) 4112 FORMAT(' IN COMPUTING THE EXPECTED LOSS STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4114) 4114 FORMAT(' THE VALUE OF THE LOWER SPEC LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4115) 4115 FORMAT(' (PARAMETER LSL) MUST BE STRICTLY') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4116) 4116 FORMAT(' LESS THAN THE VALUE OF THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4117) 4117 FORMAT(' UPPER SPEC LIMIT (PARAMETER USL).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4118) 4118 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4119)ENGLSL 4119 FORMAT(' LSL = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4120)ENGUSL 4120 FORMAT(' USL = ',E15.7) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 4129 CONTINUE C C ****************** C ** STEP 90-- ** C ** EXIT ** C ****************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ELPA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKELPA--') 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)ENGUSL,ENGLSL,COSUSL 9013 FORMAT('ENGUSL,ENGLSL,COSUSL = ',3E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CKFIT(ICASFI,ILOCFI,IBUGA3,IFOUND,IERROR) C C PURPOSE--CHECK TO SEE THE TYPE OF FIT COMMAND C THAT HAS BEEN GIVEN C (E.G., WHAT DEGREE). C OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO') C --IERROR ('YES' OR 'NO') C --ICASFI ('FIT', '1FIT', '2FIT', '3FIT', ETC.) C --ILOCFI (AN INTEGER VALUE WHICH GIVES C THE ARGUMENT NUMBER (1, 2, 3, ...) C OF THE WORD FIT . C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--AUGUST 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --MAY 1982. C UPDATED --JUNE 1987. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASFI CHARACTER*4 IBUGA3 CHARACTER*4 IFOUND CHARACTER*4 IERROR C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C C ************************* C ** CHECK FOR FITTING ** C ************************* C IFOUND='NO' IERROR='NO' ICASFI='UNKN' ILOCFI=-99 C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKFIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)NUMARG 53 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ICOM,ICOM2 54 FORMAT('ICOM,ICOM2 = ',A4,A4) CALL DPWRST('XXX','BUG ') DO55I=1,NUMARG WRITE(ICOUT,56)I,IHARG(I),IHARG2(I) 56 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,2X,A4) CALL DPWRST('XXX','BUG ') 55 CONTINUE 90 CONTINUE C C ********************************* C ** STEP 1.1-- ** C ** SEARCH FOR FIT ** C ** (WITH UNSPECIFIED DEGREE), ** C ** OR SEARCH FOR ** C ** MULTILINEAR FIT ** C ** FIT COMMAND WITH NO PREFIX ** C ** BUT WITH NO EQUAL SIGNS ** C ** AFTER ** C ********************************* C ICASFI='FIT' C CCCCC IF(ICOM.EQ.'FIT')GOTO110 IF(ICOM.EQ.'FIT')GOTO1100 GOTO1190 C 1100 CONTINUE IF(NUMARG.LE.0)GOTO1190 DO1110I=1,NUMARG IF(IHARG(I).EQ.'=')GOTO1120 IF(IHARG(I).EQ.'SUBS'.AND.IHARG2(I).EQ.'ET ')GOTO1130 IF(IHARG(I).EQ.'EXCE'.AND.IHARG2(I).EQ.'PT ')GOTO1130 IF(IHARG(I).EQ.'FOR '.AND.IHARG2(I).EQ.' ')GOTO1130 1110 CONTINUE GOTO1130 1120 CONTINUE ICASFI='FIT' GOTO110 1130 CONTINUE ICASFI='MFIT' GOTO110 1190 CONTINUE C C ********************************* C ** STEP 1.2-- ** C ** SEARCH FOR ROBUST FITTING ** C ********************************* C ICASFI='RFIT' C IF(NUMARG.GE.2.AND. 1ICOM.EQ.'ROBU'.AND.IHARG(2).EQ.'FIT')GOTO112 C C ******************************************* C ** STEP 1.20-- ** C ** SEARCH FOR 0-TH DEGREE FITTING ** C ******************************************* C ICASFI='0FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'0'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'0TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'ZERO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'0'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'0'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ZERO'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'CONS'.AND.IHARG(1).EQ.'FIT')GOTO111 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'RECT'.AND.IHARG(1).EQ.'FIT')GOTO111 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'FLAT'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.21-- ** C ** SEARCH FOR 1-ST DEGREE FITTING ** C ******************************************* C ICASFI='1FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'1'.AND.IHARG(1).EQ.'ST'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'1ST'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'1'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'ONE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'1'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ONE'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.22-- ** C ** SEARCH FOR 2-ND DEGREE FITTING ** C ******************************************* C ICASFI='2FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'2'.AND.IHARG(1).EQ.'ND'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'2ND'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'2'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'TWO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'2'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TWO'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.23-- ** C ** SEARCH FOR 3-RD DEGREE FITTING ** C ******************************************* C ICASFI='3FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'3'.AND.IHARG(1).EQ.'RD'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'3RD'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'3'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'THRE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'3'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'THRE'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'CUBI'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.24-- ** C ** SEARCH FOR 4-TH DEGREE FITTING ** C ******************************************* C ICASFI='4FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'4'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'4TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'4'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'4'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FOUR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'QUAR'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.25-- ** C ** SEARCH FOR 5-TH DEGREE FITTING ** C ******************************************* C ICASFI='5FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'5'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'5TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FIFT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'5'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FIVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'5'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FIVE'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'QUIN'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.26-- ** C ** SEARCH FOR 6-TH DEGREE FITTING ** C ******************************************* C ICASFI='6FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'6'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'6TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SIXT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'6'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SIX'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'6'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SIX'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'SEXT'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.27-- ** C ** SEARCH FOR 7-TH DEGREE FITTING ** C ******************************************* C ICASFI='7FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'7'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'7TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'7'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'7'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SEVE'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'SEPT'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.28-- ** C ** SEARCH FOR 8-TH DEGREE FITTING ** C ******************************************* C ICASFI='8FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'8'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'8TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'8'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'8'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'EIGH'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'OCTI'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.29-- ** C ** SEARCH FOR 9-TH DEGREE FITTING ** C ******************************************* C ICASFI='9FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'9'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'9TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'NINT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'9'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'NINE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'9'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'NINE'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'NONI'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************* C ** STEP 1.20-- ** C ** SEARCH FOR 10-TH DEGREE FITTING ** C ******************************************* C ICASFI='10FI' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'10'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'FIT')GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'10TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'TENT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'10'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'TEN'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'10'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TEN'.AND.IHARG(2).EQ.'FIT') 1GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'DEXI'.AND.IHARG(1).EQ.'FIT')GOTO111 C C ******************************************** C ** STEP 1.31-- ** C ** SINCE VALID COMMAND NOT FOUND, EXIT. ** C ******************************************** C ICASFI=' ' C IFOUND='NO' GOTO9000 C 110 CONTINUE ILASTC=0 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO180 C 111 CONTINUE ILASTC=1 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO180 C 112 CONTINUE ILASTC=2 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO180 C 113 CONTINUE ILASTC=3 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO180 C 180 CONTINUE ILOCFI=ILASTC IFOUND='YES' GOTO190 C 190 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKFIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IFOUND,IERROR 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)ICASFI,ILOCFI 9013 FORMAT('ICASFI,ILOCFI = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)NUMARG 9016 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)ICOM,ICOM2 9017 FORMAT('ICOM,ICOM2 = ',A4,A4) CALL DPWRST('XXX','BUG ') DO9020I=1,NUMARG WRITE(ICOUT,9021)I,IHARG(I),IHARG2(I) 9021 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9020 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE CKINTE(X,EPS,ONEMEP,ONEPEP,ICINT,IX) C C PURPOSE--GIVEN A FLOATING POINT VALUE X, C (NON-NEGATIVE) C DETERMINE IF IT IS WITHIN EPS OF AN INTEGER. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CHARACTER*4 ICINT CHARACTER*4 ISIGN CHARACTER*4 IPATH C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOBE.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'INTE')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKINTE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)X,EPS,ONEMEP,ONEPEP 52 FORMAT('X,EPS,ONEMEP,ONEPEP = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4 59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C ISIGN='POS' IF(X.LT.0.0)ISIGN='NEG' C ABSX=ABS(X) INT=ABSX AINT=INT REM=ABSX-AINT ABSREM=ABS(REM) IF(ABSREM.LE.EPS)GOTO1110 IF(ONEMEP.LE.ABSREM.AND.ABSREM.LE.ONEPEP)GOTO1120 GOTO1130 C 1110 CONTINUE IPATH='1' ICINT='YES' IX=ABSX GOTO1190 C 1120 CONTINUE IPATH='2' ICINT='YES' IX=ABSX IX=IX+1 GOTO1190 C 1130 CONTINUE IPATH='3' ICINT='NO' IX=ABSX GOTO1190 C 1190 CONTINUE IF(ISIGN.EQ.'NEG')IX=(-IX) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'INTE')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKINTE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)X,EPS,ONEMEP,ONEPEP 9012 FORMAT('X,EPS,ONEMEP,ONEPEP = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)X,ABSX,INT,REM,ABSREM 9013 FORMAT('X,ABSX,INT,REM,ABSREM = ',2E15.7,I8,2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)EPS,ONEMEP,ONEPEP 9014 FORMAT('EPS,ONEMEP,ONEPEP = ',3E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)IPATH,ICINT,ISIGN,IX 9015 FORMAT('IPATH,ICINT,ISIGN,IX = ',A4,2X,A4,2X,A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN CCCCC DEBUG TRACE,INIT CCCCC AT 90 CCCCC TRACE ON END SUBROUTINE CKLIB1(IA,N,I,IFOUND,NCLF,IBUGCK,IERROR) C C PURPOSE--SEARCH THE 1-CHARACTER PER WORD C CHARACTER STRING IN IA(.) C STARTING WITH POSITION I C AND DETERMINE IF THAT C STRING IS A MEMBER OF THE C AUGMENTED LIBRARY FUNCTION SET. C NOTE--THIS IS PART 1 C (SEARCHING FOR LIBRARY FUNCTIONS C WITH STARTING CHARACTERS OF A TO J) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--JANUARY 1979. C UPDATED --FEBRUARY 1981. C UPDATED --JUNE 1981. C UPDATED --NOVEMBER 1981. C UPDATED --MARCH 1982. C UPDATED --MAY 1982. C UPDATED --JUNE 1987. FRACT(.) C UPDATED --SEPTEMBER 1988. IND(.) = INDICATOR FUNCTION C UPDATED --APRIL 1989. JULIA(.) = JULIA IND. FUNC. C UPDATED --MAY 1989. CP(.,.) PROCESS CAPABILITY C UPDATED --MAY 1989. CPK(.,.) PROCESS CAPABILITY C UPDATED --MAY 1989. EXPLOS(.,.,.) EXPECTED LOSS C UPDATED --JANUARY 1990. BINPAT(.,.) BINARY PATTERN C UPDATED --MAY 1990. IGCDF/PDF/PPF (INV GAUS) C UPDATED --MAY 1990. FL-CDF/PDF/PPF (FAT LIFE) C UPDATED --DECEMBER 1993. GEP-CDF/PDF/PPF C (GENERALIZED PARETO) C UPDATED --APRIL 1994. BIN-CDF/PDF/PPF (BINOMIAL) C UPDATED --APRIL 1994. CAU-CDF/PDF/PPF (CAUCHY) C UPDATED --APRIL 1994. DEX-CDF/PDF/PPF (BINOMIAL) C UPDATED --APRIL 1994. EV1-CDF/PDF/PPF (EV1) C UPDATED --APRIL 1994. EV2-CDF/PDF/PPF (EV2) C UPDATED --APRIL 1994. EXP-CDF/PDF/PPF (BINOMIAL) C UPDATED --APRIL 1994. GAM-CDF/PPF (GAMMA) C UPDATED --APRIL 1994. GEO-CDF/PDF/PPF (GEOMETRIC) C UPDATED --APRIL 1994. HFN-CDF/PPF (HALF-NORMAL) C UPDATED --SEPTEMBER 1994. BET-CDF/PDF/PPF (BETA) C UPDATED --SEPTEMBER 1994. DIS-CDF/PDF/PPF (DISCRETE C UNIFORM) C UPDATED --SEPTEMBER 1994. BETA (BETA FUNCTION) C UPDATED --SEPTEMBER 1994. BETAI (INCOMPLETE BETA) C UPDATED --SEPTEMBER 1994. GAMMI (INCOMPLETE GAMMA) C UPDATED --SEPTEMBER 1994. ADDITIONAL BESSEL FUNCTIONS C UPDATED --SEPTEMBER 1994. DAWSON, EXPONENTIAL INTEGRAL C UPDATED --SEPTEMBER 1994. DNF-CDF/PPF (DOUBLY NC F) C UPDATED --SEPTEMBER 1994. DNT-CDF/PPF (DOUBLY NC T) C UPDATED --SEPTEMBER 1994. HYP-CDF/PDF/PPF (HYPERGEOM) C UPDATED --SEPTEMBER 1994. GAMMAR (RECIPROCAL GAMMA) C UPDATED --SEPTEMBER 1994. DIGAMMA (DIGAMMA) C UPDATED --SEPTEMBER 1994. GAMMAIC (COMPLEMENTARY C INCOMPLETE GAMMA) C UPDATED --SEPTEMBER 1994. ELLIPC,ELLIP1,ELLIP2,ELLIP3 C (LEGENDRE FORM OF ELLIPTIC C INTEGRALS) C UPDATED --SEPTEMBER 1994. CHU (LOGARITHMIC CONFLUENT C HYPERGEOMETRIC FUNCTION) C UPDATED --SEPTEMBER 1994. COSINT, COSHINT C UPDATED --OCTOBER 1994. CBESSJR, CBESSJI C UPDATED --OCTOBER 1994. CBESSYR, CBESSYI C UPDATED --OCTOBER 1994. CBESSIR, CBESSII C UPDATED --OCTOBER 1994. CBESSKR, CBESSKI C UPDATED --OCTOBER 1994. CEXP, CLOG, CSQRT, CABS, C CSIN, CCOS C UPDATED --NOVEMBER 1994. FRESNC, FRESNS, FRESNF, C FRESNG (FRESNEL INTEGRALS) C UPDATED --NOVEMBER 1994. CN, DN (JACOBIAN ELLIPTIC C FUNCTIONS) C UPDATED --MARCH 1995. CEIL, FLOOR, GCD, HEAVE C UPDATED --APRIL 1995. COSCDF, COSPDF, COSPPF C UPDATED --APRIL 1995. ALPCDF, ALPPDF, ALPPPF C UPDATED --APRIL 1995. FNRCDF, FNRPDF, FNRPPF C UPDATED --APRIL 1995. CHCDF, CHPDF, CHPPF C UPDATED --APRIL 1995. DLGPDF, DLGCDF, DLGPPF C UPDATED --APRIL 1995. GGDPDF, GGDCDF, GGDPPF C UPDATED --MAY 1995. BVNPDF C UPDATED --JULY 1995. HERMITE, CHEBT, CHEBU, C JACOBIP (POLYNOMIALS) C UPDATED --SEPTEMBER 1995. ANGPDF, ANGCDF, ANGPPF C UPDATED --SEPTEMBER 1995. ARSPDF, ARSCDF, ARSPPF C UPDATED --OCTOBER 1995. DIPPDF, DIPCDF, DIPPPF C UPDATED --OCTOBER 1995. HSEPDF, HSECDF, HSEPPF C UPDATED --OCTOBER 1995. HFCPDF, HFCCDF, HFCPPF C UPDATED --OCTOBER 1995. HFLPDF, HFLCDF, HFLPPF C UPDATED --OCTOBER 1995. GOMPDF, GOMCDF, GOMPPF C UPDATED --OCTOBER 1995. DWEPDF, DWECDF, DWEPPF C UPDATED --OCTOBER 1995. EWEPDF, EWECDF, EWEPPF C UPDATED --DECEMBER 1995. GLOPDF, GLOCDF, GLOPPF C UPDATED --JANUARY 1996. DGAPDF, DGACDF, DGAPPF C UPDATED --JANUARY 1996. FCAPDF, FCACDF, FCAPPF C UPDATED --FEBRUARY 1996. BBNPDF, BBNCDF, BBNPPF C UPDATED --FEBRUARY 1996. BRAPDF, BPACDF, BPAPPF C UPDATED --FEBRUARY 1996. GEXPDF, GEXCDF, GEXPPF C UPDATED --MARCH 1997. STRUVE FUNCTIONS (H0,H1,HV) C UPDATED --JULY 1997. CHM (CONFLUENT M C HYPERGEOMETRIC FUNCTION) C UPDATED --AUGUST 1997. CGAMMA, CGAMMAI C UPDATED --AUGUST 1997. CLNGAM, CLNGAMI C UPDATED --AUGUST 1997. CPSI, CPSII C UPDATED --AUGUST 1997. HYPERGEO (HYPERGEOMETRIC FUNCTION) C UPDATED --AUGUST 1997. CBETA, CLBETA C UPDATED --SEPTEMBER 1997. BER, BERI, BER1, BERI1 C UPDATED --SEPTEMBER 1997. KER, KERI, KER1, KERI1 C UPDATED --SEPTEMBER 1997. BN, EN, ETA, CATLAN, BINOM C UPDATED --APRIL 1998. EXPHAZ, EXPCHA C UPDATED --APRIL 1998. GEPHAZ, GEPCHA C UPDATED --APRIL 1998. EV1HAZ, EV1CHA C UPDATED --APRIL 1998. EV2HAZ, EV2CHA C UPDATED --APRIL 1998. GAMHAZ, GAMCHA C UPDATED --APRIL 1998. GGDHAZ, GGDCHA C UPDATED --APRIL 1998. IGACDF, IGAPDF, IGAPPF C UPDATED --APRIL 1998. IGAHAZ, IGACHA C UPDATED --APRIL 1998. IGHAZ, IGCHA C UPDATED --APRIL 1998. FLHAZ, FLCHA C UPDATED --APRIL 1998. ALPHAZ, ALPCHAZ C UPDATED --MAY 1998. EWEHAZ, EWECHAZ C UPDATED --MARCH 1999. ABRAM C UPDATED --MARCH 1999. CLAUSN C UPDATED --MARCH 1999. DEBYE C UPDATED --MARCH 1999. EXP3 C UPDATED --MARCH 1999. GOODST C UPDATED --AUGUST 2001. GLDCDF, GLDPDF, GLDPPF C GLDCHK, GLDLLM, GLDULM C GLDSGN C UPDATED --SEPTEMBER 2001. IWECDF, IWEPDF, IWEPPF C UPDATED --NOVEMBER 2001. IWEHAZ, IWECHAZ C UPDATED --SEPTEMBER 2001. LDECDF, LDEPDF, LDEPPF C UPDATED --SEPTEMBER 2001. JSBCDF, JSBPDF, JSBPPF C UPDATED --SEPTEMBER 2001. JSUCDF, JSUPDF, JSUPPF C UPDATED --NOVEMBER 2001. GEECDF, GEEPDF, GEEPPF, C GEEHAZ, GEECHAZ C UPDATED --MAY 2002. BWECDF, BWEPDF, BWEPPF, C BWEHAZ, BWECHAZ C UPDATED --JANUARY 2003. GHCDF, GHPDF, GHPPF C UPDATED --MAY 2003. IBCDF, IBPDF, IBPPF C UPDATED --MAY 2003. ERRCDF, ERRPDF, ERRPPF C UPDATED --JUNE 2003. GTRCDF, GTRPDF, GTRPPF C UPDATED --NOVEMBER 2003. FTCDF, FTPDF, FTPPF C UPDATED --DECEMBER 2003. GIGCDF, GIGPDF, GIGPPF C UPDATED --MARCH 2004. HERCDF, HERPDF, HERPPF C UPDATED --MARCH 2004. BU1CDF, BU1PDF, BU1PPF C UPDATED --MARCH 2004. ... C UPDATED --MARCH 2004. B12CDF, B12PDF, B12PPF C UPDATED --APRIL 2004. GWACDF, GWAPDF, GWAPPF C UPDATED --JUNE 2004. ADECDF, ADEPDF, ADEPPF C UPDATED --JUNE 2004. GALCDF, GALPDF, GALPPF C UPDATED --JUNE 2004. FERCDF, FERPDF, FERPPF C UPDATED --AUGUST 2004. BEICDF, BEIPDF, BEIPPF C UPDATED --AUGUST 2004. BEKCDF, BEKPDF, BEKPPF C UPDATED --SEPTEMBER 2004. GMCCDF, GMCPDF, GMCPPF C UPDATED --SEPTEMBER 2004. HBOCDF, HBOPDF, HBOPPF C UPDATED --MARCH 2005. EXPAFR C UPDATED --MAY 2005. GEVCHAZ, GEVHAZ C UPDATED --NOVEMBER 2005. AIRINT C UPDATED --NOVEMBER 2005. AIRYGI C UPDATED --NOVEMBER 2005. AIRYHI C UPDATED --NOVEMBER 2005. ATNINT C UPDATED --NOVEMBER 2005. BIRINT C UPDATED --NOVEMBER 2005. I0INT C UPDATED --NOVEMBER 2005. I0ML0 C UPDATED --NOVEMBER 2005. I1ML1 C UPDATED --NOVEMBER 2005. J0INT C UPDATED --FEBRUARY 2006. GL2CDF, GL2PDF, GL2PPF C UPDATED --FEBRUARY 2006. GL3CDF, GL3PDF, GL3PPF C UPDATED --FEBRUARY 2006. GL4CDF, GL4PDF, GL4PPF C UPDATED --FEBRUARY 2006. GL5CDF, GL5PDF, GL5PPF C UPDATED --MARCH 2006. BNOCDF, BNOPDF, BNOPPF C UPDATED --MARCH 2006. ALDCDF, ALDPDF, ALDPPF C UPDATED --MAY 2006. HARMNUMB C UPDATED --MAY 2006. BGECDF, BGEPDF, BGEPPF C UPDATED --MAY 2006. BNBCDF, BNBPDF, BNBPPF C UPDATED --MAY 2006. BTACDF, BTAPDF, BTAPPF C UPDATED --JUNE 2006. DXGCDF, DXGPDF, DXGPPF C UPDATED --JUNE 2006. GLSCDF, GLSPDF, GLSPPF C UPDATED --JULY 2006. GETCDF, GETPDF, GETPPF C UPDATED --JULY 2006. GNBCDF, GNBPDF, GNBPPF C UPDATED --AUGUST 2006. CONCDF, CONPDF, CONPPF C UPDATED --NOVEMBER 2006. DIWCDF, DIWPDF, DIWPPF C UPDATED --NOVEMBER 2006. GLGCDF, GLGPDF, GLGPPF C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IA CHARACTER*4 IFOUND CHARACTER*4 IBUGCK CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION IA(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IFOUND='NO' IERROR='NO' C NCLF=-99 C NP1=N+1 C IF(IBUGCK.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('AT THE BEGINNING OF CKLIB1--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)N,I,IBUGCK 52 FORMAT('N,I,IBUGCK = ',I8,I8,2X,A4) CALL DPWRST('XXX','BUG ') DO55I2=1,N WRITE(ICOUT,56)I2,IA(I2) 56 FORMAT('I2,IA(I2) = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') 55 CONTINUE 90 CONTINUE C IF(I.GE.NP1)GOTO9000 C C **************************** C ** STEP 1-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH A-- ** C ** ABS ** C ** AINT ** C ** ALOG10 ** C ** ALOGE ** C ** ALOG ** C ** AMOD ** C ** ARCCOSH ** C ** ARCCOS ** C ** ARCCOTH ** C ** ARCCOT ** C ** ARCCSCH ** C ** ARCCSC ** C ** ARCSECH ** C ** ARCSEC ** C ** ARCSINH ** C ** ARCSIN ** C ** ARCTANH ** C ** ARCTAN ** C ** ATAN2 ** C ** ATAN ** C ** SEPTEMBER 1994: ** C ** AIRY ** C ** APRIL 1995: ** C ** ALPCDF ** C ** ALPPDF ** C ** ALPPPF ** C ** SEPTEMBER 1995: ** C ** ANGCDF ** C ** ANGPDF ** C ** ANGPPF ** C ** SEPTEMBER 1995: ** C ** ARSCDF ** C ** ARSPDF ** C ** ARSPPF ** C ** APRIL 1998: ** C ** ALPHAZ, ALPCHAZ ** C ** MARCH 1999: ** C ** ABRAM ** C ** JUNE 2004: ** C ** ADECDF ** C ** ADEPDF ** C ** ADEPPF ** C ** NOVEMBER 2005: ** C ** AIRINT ** C ** MARCH 2006: ** C ** ALDCDF ** C ** ALDPDF ** C ** ALDPPF ** C **************************** C 100 CONTINUE IF(IA(I).EQ.'A')GOTO109 GOTO190 109 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'B')GOTO110 IF(IA(IP1).EQ.'I')GOTO120 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'D')GOTO185 IF(IA(IP1).EQ.'L')GOTO130 IF(IA(IP1).EQ.'M')GOTO140 IF(IA(IP1).EQ.'R')GOTO150 IF(IA(IP1).EQ.'T')GOTO160 IF(IA(IP1).EQ.'N')GOTO170 IF(IA(IP1).EQ.'D')GOTO180 GOTO9000 C 110 CONTINUE IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'A'.AND. 1 IA(IP4).EQ.'M')GOTO7500 IF(IA(IP2).EQ.'S')GOTO7300 GOTO9000 C 120 CONTINUE IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND. 1 IA(IP5).EQ.'T')GOTO7600 IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'Y'.AND.IA(IP4).EQ.'G'.AND. 1 IA(IP5).EQ.'I')GOTO7600 IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'Y'.AND.IA(IP4).EQ.'H'.AND. 1 IA(IP5).EQ.'I')GOTO7600 IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'T')GOTO7400 IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'Y')GOTO7400 GOTO9000 C 130 CONTINUE IF(IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G'.AND.IA(IP4).EQ.'1'.AND. 1IA(IP5).EQ.'0')GOTO7600 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND. 1IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND. 1IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700 IF(IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G'.AND.IA(IP4).EQ.'E')GOTO7500 IF(IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G')GOTO7400 IF(IA(IP2).EQ.'N')GOTO7300 GOTO9000 C 140 CONTINUE IF(IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'D')GOTO7400 GOTO9000 C 150 CONTINUE IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'C')GOTO155 GOTO9000 155 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'S'.AND. 1IA(IP6).EQ.'H')GOTO7700 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'S')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'T'.AND. 1IA(IP6).EQ.'H')GOTO7700 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'T')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'C'.AND. 1IA(IP6).EQ.'H')GOTO7700 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'C')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'C'.AND. 1IA(IP6).EQ.'H')GOTO7700 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'C')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'N'.AND. 1IA(IP6).EQ.'H')GOTO7700 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'N')GOTO7600 IF(IA(IP3).EQ.'T'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'N'.AND. 1IA(IP6).EQ.'H')GOTO7700 IF(IA(IP3).EQ.'T'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'N')GOTO7600 GOTO9000 C 160 CONTINUE IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND. 1 IA(IP5).EQ.'T')GOTO7600 IF(IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'2')GOTO7500 IF(IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'N')GOTO7400 GOTO9000 C 170 CONTINUE IF(IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 GOTO9000 180 CONTINUE IF(IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 GOTO9000 185 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 GOTO9000 190 CONTINUE C C ********************************** C ** STEP 2-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH B-- ** C ** BESS0 ** C ** BESS1 ** C ** JANUARY 1990: ** C ** BINPAT ** C ** APRIL 1994: ** C ** BINCDF, BINPDF, BINPPF ** C ** SEPTEMBER 1994: ** C ** BETCDF, BETPDF, BETPPF ** C ** BETA, BETAF ** C ** BESSY0, BESSY1 ** C ** BESSI0, BESSI1 ** C ** BESSI0E, BESSI1E ** C ** BESSK0E, BESSK1E ** C ** BESSJN, BESSYN ** C ** BESSIN, BESSKN ** C ** BESSINE, BESSKNE ** C ** BAIRY ** C ** OCTOBER 1994: ** C ** BVNCDF ** C ** MAY 1995: ** C ** BVNPDF ** C ** FEBRUARY 1996: ** C ** BBNCDF, BBNPDF, BBNPPF ** C ** BRACDF, BRAPDF, BRAPPF ** C ** SEPTEMBER 1997: ** C ** BER, BERI, BER1, BERI1 ** C ** BN, BINOM, BINOMIAL ** C ** MAY 2002: ** C ** BWECDF, BWEPDF, BWEPPF ** C ** BWEHAZ, BWECHAZ ** C ** MARCH 2004: ** C ** BU1CDF, BU1PDF, BU1PPF ** C ** ... ** C ** B12CDF, B12PDF, B12PPF ** C ** BEICDF, BEIPDF, BEIPPF ** C ** BEKCDF, BEKPDF, BEKPPF ** C ** NOVEMBER 2005: ** C ** BIRINT ** C ** MARCH 2006: ** C ** BNOCDF, BNOPDF, BNOPPF ** C ** MAY 2006: ** C ** BGECDF, BGEPDF, BGEPPF ** C ** BNBCDF, BNBPDF, BNBPPF ** C ** BTACDF, BTAPDF, BTAPPF ** C ********************************** C 200 CONTINUE IF(IA(I).EQ.'B')GOTO209 GOTO290 209 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND. 1IA(IP5).EQ.'T')GOTO7600 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'1')GOTO7500 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'I')GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'1')GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R')GOTO7300 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'O')GOTO221 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'B')GOTO221 IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'A')GOTO221 IF(IA(IP1).EQ.'N')GOTO7200 C IF(IA(IP1).EQ.'E')GOTO210 IF(IA(IP1).EQ.'I')GOTO211 IF(IA(IP1).EQ.'A')GOTO212 IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'E')GOTO250 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'1')GOTO250 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'2')GOTO250 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'3')GOTO250 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'4')GOTO250 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'5')GOTO250 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'6')GOTO250 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'7')GOTO250 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'8')GOTO250 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'9')GOTO250 IF(IA(IP1).EQ.'1'.AND.IA(IP2).EQ.'0')GOTO250 IF(IA(IP1).EQ.'1'.AND.IA(IP2).EQ.'1')GOTO250 IF(IA(IP1).EQ.'1'.AND.IA(IP2).EQ.'2')GOTO250 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'N')GOTO221 IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'E')GOTO221 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A')GOTO221 IF(IA(IP1).EQ.'V'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'C'.AND. 1IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP1).EQ.'V'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'P'.AND. 1IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 210 CONTINUE IF(IA(IP2).EQ.'S')GOTO220 IF(IA(IP2).EQ.'T')GOTO250 IF(IA(IP2).EQ.'I')GOTO250 IF(IA(IP2).EQ.'K')GOTO250 GOTO9000 211 CONTINUE IF(IA(IP2).EQ.'N')GOTO221 GOTO9000 212 CONTINUE IF(IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'R'.AND. 1 IA(IP4).EQ.'Y')GOTO7500 GOTO9000 C 220 CONTINUE IF(IA(IP3).EQ.'S')GOTO230 GOTO9000 221 CONTINUE IF(IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'M'.AND. 1IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'A'.AND.IA(IP7).EQ.'L')GOTO7800 IF(IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'M')GOTO7500 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P')GOTO231 GOTO9000 C 230 CONTINUE IF(IA(IP4).EQ.'0')GOTO7500 IF(IA(IP4).EQ.'1')GOTO7500 IF(IA(IP4).EQ.'J'.AND.IA(IP5).EQ.'0')GOTO7600 IF(IA(IP4).EQ.'J'.AND.IA(IP5).EQ.'1')GOTO7600 IF(IA(IP4).EQ.'J'.AND.IA(IP5).EQ.'N')GOTO7600 IF(IA(IP4).EQ.'Y'.AND.IA(IP5).EQ.'0')GOTO7600 IF(IA(IP4).EQ.'Y'.AND.IA(IP5).EQ.'1')GOTO7600 IF(IA(IP4).EQ.'Y'.AND.IA(IP5).EQ.'N')GOTO7600 IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'0'.AND. 1IA(IP6).EQ.'E')GOTO7700 IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'0')GOTO7600 IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'1'.AND. 1IA(IP6).EQ.'E')GOTO7700 IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'1')GOTO7600 IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'N'.AND. 1IA(IP6).EQ.'E')GOTO7700 IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'N')GOTO7600 IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'0'.AND. 1IA(IP6).EQ.'E')GOTO7700 IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'0')GOTO7600 IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'1'.AND. 1IA(IP6).EQ.'E')GOTO7700 IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'1')GOTO7600 IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'N'.AND. 1IA(IP6).EQ.'E')GOTO7700 IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'N')GOTO7600 GOTO9000 231 CONTINUE IF(IA(IP4).EQ.'A')GOTO240 GOTO9000 C 240 CONTINUE IF(IA(IP5).EQ.'T')GOTO7600 GOTO9000 C 250 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND. 1 IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND. 1 IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700 IF(IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'I')GOTO7500 IF(IA(IP3).EQ.'A')GOTO7400 GOTO9000 C 290 CONTINUE C C **************************** C ** STEP 3-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH C-- ** C ** CHEB10 ** C ** CHEB0 ** C ** CHEB1 ** C ** CHEB2 ** C ** CHEB3 ** C ** CHEB4 ** C ** CHEB5 ** C ** CHEB6 ** C ** CHEB7 ** C ** CHEB8 ** C ** CHEB9 ** C ** CHSCDF ** C ** CHSPDF ** C ** CHSPPF ** C ** COSH ** C ** COS ** C ** COTH ** C ** COT ** C ** CP ** C ** CPK ** C ** CSCH ** C ** CSC ** C ** APRIL 1994. ** C ** CAUCDF ** C ** CAUPDF ** C ** CAUPPF ** C ** CAUSF ** C ** SEPTEMBER 1994. ** C ** CHU ** C ** COSHINT ** C ** COSINT ** C ** OCTOBER 1994. ** C ** CBESSJR, CBESSJI ** C ** CBESSYR, CBESSYI ** C ** CBESSIR, CBESSII ** C ** CBESSKR, CBESSKI ** C ** CABS ** C ** CCOS, CCOSI ** C ** CEXP, CEXPI ** C ** CLOG, CLOGI ** C ** CSIN, CSINI ** C ** CSQRT, CSQRTI ** C ** NOVEMBER 1994. ** C ** CN ** C ** MARCH 1995. ** C ** CEIL ** C ** APRIL 1995. ** C ** COSCDF ** C ** COSPDF ** C ** COSPPF ** C ** CHCDF ** C ** CHPDF ** C ** CHPPF ** C ** JULY 1995. ** C ** CHEBT ** C ** CHEBU ** C ** JULY 1997. ** C ** CHM ** C ** AUGUST 1997. ** C ** CGAMMA ** C ** CGAMMAI ** C ** CLNGAM ** C ** CLNGAMI ** C ** CPSI ** C ** CPSII ** C ** CLNBETA ** C ** CLNBETAI ** C ** CBETA ** C ** CBETAI ** C ** SEPTEMBER 1997. ** C ** CATLAN ** C ** MARCH 1999. ** C ** CLAUSN ** C ** AUGUST 2006. ** C ** CONCDF ** C ** CONPDF ** C ** CONPPF ** C **************************** C CCCCC THE FOLLOWING C SECTION WAS CHANGED FOR CP AND CPK MAY 1989 300 CONTINUE IF(IA(I).EQ.'C')GOTO309 GOTO390 309 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'H')GOTO310 IF(IA(IP1).EQ.'O')GOTO320 IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'I'.AND. 1IA(IP4).EQ.'I')GOTO7500 IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'I')GOTO7400 IF(IA(IP1).EQ.'P')GOTO330 IF(IA(IP1).EQ.'N')GOTO7200 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'B'.AND.IA(IP3).EQ.'S')GOTO7400 IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'S'.AND. 1IA(IP4).EQ.'I')GOTO7500 IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'S')GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'L')GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X'.AND.IA(IP3).EQ.'P'.AND. 1IA(IP4).EQ.'I')GOTO7500 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X'.AND.IA(IP3).EQ.'P')GOTO7400 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'G'.AND. 1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'I')GOTO7700 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'G'.AND. 1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'M')GOTO7600 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'B'.AND. 1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'A'.AND. 1IA(IP7).EQ.'I')GOTO7800 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'B'.AND. 1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'A')GOTO7700 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'T'.AND. 1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'I')GOTO7600 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'T'.AND. 1IA(IP4).EQ.'A')GOTO7500 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G'.AND. 1IA(IP4).EQ.'I')GOTO7500 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G')GOTO7400 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'N'.AND. 1IA(IP4).EQ.'I')GOTO7500 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'N')GOTO7400 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'Q'.AND.IA(IP3).EQ.'R'.AND. 1IA(IP4).EQ.'T'.AND.IA(IP5).EQ.'I')GOTO7600 IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'M'.AND. 1IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'I')GOTO7700 IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'M'.AND. 1IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'A')GOTO7600 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'Q'.AND.IA(IP3).EQ.'R'.AND. 1IA(IP4).EQ.'T')GOTO7500 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'U')GOTO350 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'S'.AND. 1IA(IP4).EQ.'S')GOTO360 IF(IA(IP1).EQ.'S')GOTO340 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'L'.AND. 1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'N')GOTO7600 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'U'.AND. 1IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'N')GOTO7600 GOTO9000 C 310 CONTINUE IF(IA(IP2).EQ.'E')GOTO315 IF(IA(IP2).EQ.'S')GOTO317 IF(IA(IP2).EQ.'U')GOTO7300 IF(IA(IP2).EQ.'M')GOTO7300 IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500 GOTO9000 315 CONTINUE IF(IA(IP3).EQ.'B')GOTO316 GOTO9000 316 CONTINUE IF(IA(IP4).EQ.'1'.AND.IA(IP5).EQ.'0')GOTO7600 IF(IA(IP4).EQ.'0')GOTO7500 IF(IA(IP4).EQ.'1')GOTO7500 IF(IA(IP4).EQ.'2')GOTO7500 IF(IA(IP4).EQ.'3')GOTO7500 IF(IA(IP4).EQ.'4')GOTO7500 IF(IA(IP4).EQ.'5')GOTO7500 IF(IA(IP4).EQ.'6')GOTO7500 IF(IA(IP4).EQ.'7')GOTO7500 IF(IA(IP4).EQ.'8')GOTO7500 IF(IA(IP4).EQ.'9')GOTO7500 IF(IA(IP4).EQ.'T')GOTO7500 IF(IA(IP4).EQ.'U')GOTO7500 GOTO9000 317 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 320 CONTINUE IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'I'.AND. 1IA(IP5).EQ.'N'.AND.IA(IP6).EQ.'T')GOTO7700 IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND. 1IA(IP5).EQ.'T')GOTO7600 IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'H')GOTO7400 IF(IA(IP2).EQ.'S')GOTO7300 IF(IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'H')GOTO7400 IF(IA(IP2).EQ.'T')GOTO7300 GOTO9000 C 330 CONTINUE IF(IA(IP2).EQ.'K')GOTO7300 GOTO7200 C 340 CONTINUE IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H')GOTO7400 IF(IA(IP2).EQ.'C')GOTO7300 GOTO9000 C 350 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500 GOTO9000 C 360 CONTINUE IF(IA(IP5).EQ.'J'.AND.IA(IP6).EQ.'R')GOTO7700 IF(IA(IP5).EQ.'J'.AND.IA(IP6).EQ.'I')GOTO7700 IF(IA(IP5).EQ.'Y'.AND.IA(IP6).EQ.'R')GOTO7700 IF(IA(IP5).EQ.'Y'.AND.IA(IP6).EQ.'I')GOTO7700 IF(IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'R')GOTO7700 IF(IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'I')GOTO7700 IF(IA(IP5).EQ.'K'.AND.IA(IP6).EQ.'R')GOTO7700 IF(IA(IP5).EQ.'K'.AND.IA(IP6).EQ.'I')GOTO7700 GOTO9000 C 390 CONTINUE C C **************************** C ** STEP 4-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH D-- ** C ** DECOCT ** C ** DIM ** C ** APRIL 1994: ** C ** DEXCDF ** C ** DEXPDF ** C ** DEXPPF ** C ** DEXSF ** C ** SEPTEMBER 1994: ** C ** DISCDF ** C ** DISPDF ** C ** DISPPF ** C ** DAWSON ** C ** DNFCDF, DNFPPF ** C ** DNTCDF, DNTPPF ** C ** DIGAMMA ** C ** NOVEMBER 1994: ** C ** DN ** C ** APRIL 1995: ** C ** DLGCDF ** C ** DLGPDF ** C ** DLGPPF ** C ** OCTOBER 1995: ** C ** DWECDF ** C ** DWEPDF ** C ** DWEPPF ** C ** JANUARY 1996: ** C ** DGACDF ** C ** DGAPDF ** C ** DGAPPF ** C ** MARCH 1999: ** C ** DEBYE ** C ** MAY 2004: ** C ** DNFPDF, DNTPDF ** C ** JUNE 2006: ** C ** DXGCDF ** C ** DXGPDF ** C ** DXGPPF ** C ** NOVEMBER 2006: ** C ** DIWCDF ** C ** DIWPDF ** C ** DIWPPF ** C ** DIWHAZ ** C **************************** C 400 CONTINUE IF(IA(I).EQ.'D')GOTO409 GOTO490 409 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X')GOTO410 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'F')GOTO420 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'T')GOTO420 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'C'.AND. 1IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'C'.AND. 1IA(IP5).EQ.'T')GOTO7600 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'W'.AND. 1IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'O'.AND. 1IA(IP5).EQ.'N')GOTO7600 IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'M')GOTO7300 IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'G'.AND. 1IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'M'.AND. 1IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'A')GOTO7700 IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'S')GOTO410 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'G')GOTO410 IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'E')GOTO410 IF(IA(IP1).EQ.'X'.AND.IA(IP2).EQ.'G')GOTO410 IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A')GOTO410 IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'W')GOTO410 IF(IA(IP1).EQ.'N')GOTO7200 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'B'.AND. 1IA(IP3).EQ.'Y'.AND.IA(IP4).EQ.'E')GOTO7500 GOTO9000 C 410 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND. 1IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500 GOTO9000 C 420 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 490 CONTINUE C C **************************** C ** STEP 5-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH E-- ** C ** ERFC ** C ** ERF ** C ** EXP ** C ** EXPLOS ** C ** APRIL 1994: ** C ** EV1CDF ** C ** EV1PDF ** C ** EV1PPF ** C ** EV2CDF ** C ** EV2PDF ** C ** EV2PPF ** C ** EXPCDF ** C ** EXPPDF ** C ** EXPPPF ** C ** EXPSF ** C ** SEPTEMBER 1994: ** C ** EXPINT1 ** C ** EXPINTE ** C ** EXPINTN ** C ** ELLIPC1 ** C ** ELLIP1 ** C ** ELLIPC2 ** C ** ELLIP2 ** C ** ELLIP3 ** C ** OCTOBER 1995: ** C ** EWECDF ** C ** EWEPDF ** C ** EWEPPF ** C ** SEPTEMBER 1997: ** C ** EN ** C ** ETA ** C ** APRIL 1998: ** C ** EXPHAZ, EXPCHA ** C ** EV1HAZ, EV1CHA ** C ** EV2HAZ, EV2CHA ** C ** MAY 1998: ** C ** EWEHAZ, EWECHA ** C ** MAY 2003: ** C ** ERRCDF ** C ** ERRPDF ** C ** ERRPPF ** C ** MARCH 2005: ** C ** EXPAFR ** C **************************** C 500 CONTINUE IF(IA(I).EQ.'E')GOTO509 GOTO590 509 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'N')GOTO7200 IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'A')GOTO7300 IF(IA(IP1).EQ.'V'.AND.IA(IP2).EQ.'1')GOTO510 IF(IA(IP1).EQ.'V'.AND.IA(IP2).EQ.'2')GOTO510 IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'E')GOTO510 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'L'.AND.IA(IP3).EQ.'I'.AND. 1IA(IP4).EQ.'P')GOTO530 C IF(IA(IP1).EQ.'X'.AND.IA(IP2).EQ.'P'.AND. 1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'O'.AND. 1IA(IP5).EQ.'S')GOTO7600 IF(IA(IP1).EQ.'X'.AND.IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'3')GOTO7400 IF(IA(IP1).EQ.'X'.AND.IA(IP2).EQ.'P')GOTO520 C IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'F'.AND. 1IA(IP3).EQ.'C')GOTO7400 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'F')GOTO7300 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'R')GOTO505 GOTO9000 C 505 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 510 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND. 1IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND. 1IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700 GOTO9000 C 520 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND. 1IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND. 1IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700 IF(IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'F'.AND. 1IA(IP5).EQ.'R')GOTO7600 IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND. 1IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'1')GOTO7700 IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND. 1IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'N')GOTO7700 IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND. 1IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'E')GOTO7700 GOTO7300 C 530 CONTINUE IF(IA(IP5).EQ.'1')GOTO7600 IF(IA(IP5).EQ.'2')GOTO7600 IF(IA(IP5).EQ.'3')GOTO7600 IF(IA(IP5).EQ.'C'.AND.IA(IP6).EQ.'1')GOTO7700 IF(IA(IP5).EQ.'C'.AND.IA(IP6).EQ.'2')GOTO7700 GOTO9000 C 590 CONTINUE C C **************************** C ** STEP 6-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH F-- ** C ** FCDF ** C ** FPDF ** C ** FPPF ** C ** FRACT ** C ** FLCDF (MAY 1990) ** C ** FLPDF (MAY 1990) ** C ** FLPPF (MAY 1990) ** C ** NOVEMBER 1994: ** C ** FRESNC, FRESNS ** C ** FRESNF, FRESNG ** C ** MARCH 1995: ** C ** FLOOR ** C ** APRIL 1995: ** C ** FNRCDF ** C ** FNRPDF ** C ** FNRPPF ** C ** JANUARY 1996: ** C ** FCACDF ** C ** FCAPDF ** C ** FCAPPF ** C ** APRIL 1998: ** C ** FLHAZ, FLCHA ** C ** MAY 2002: ** C ** FERMDIRA ** C ** NOVEMBER 2003: ** C ** FERMDIRA ** C ** JUNE 2004: ** C ** FERCDF, FERPDF, FERPPF** C **************************** C 600 CONTINUE IF(IA(I).EQ.'F')GOTO609 GOTO690 609 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C CCCCC THE FOLLOWING LINE WAS ADDED MAY 1990 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'O'.AND. 1IA(IP4).EQ.'R')GOTO7500 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'R')GOTO630 IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'A')GOTO630 IF(IA(IP1).EQ.'L')GOTO610 IF(IA(IP1).EQ.'T')GOTO610 IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'D'.AND.IA(IP3).EQ.'F')GOTO7400 IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'D'.AND.IA(IP3).EQ.'F')GOTO7400 IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'F')GOTO7400 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A'.AND. 1IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'T')GOTO7500 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'E'.AND. 1IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'N')GOTO620 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'I'.AND. 1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'A')GOTO7800 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R')GOTO630 GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 610 CONTINUE IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'Z')GOTO7500 IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND. 1IA(IP5).EQ.'Z')GOTO7600 GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1994 620 CONTINUE IF(IA(IP5).EQ.'C')GOTO7600 IF(IA(IP5).EQ.'S')GOTO7600 IF(IA(IP5).EQ.'F')GOTO7600 IF(IA(IP5).EQ.'G')GOTO7600 GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED APRIL 1995 630 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1994 690 CONTINUE C CCCCC THE FOLLOWING SECTION WAS AUGMENTED DECEMBER 1993 C ******************************* C ** STEP 7-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH G-- ** C ** GAMMA ** C ** GEPCDF (DEC. 1993) ** C ** GEPPDF (DEC. 1993) ** C ** GEPPPF (DEC. 1993) ** C ** APRIL 1994: ** C ** GAMCDF ** C ** GAMPDF ** C ** GAMPPF ** C ** GEOCDF ** C ** GEOPDF ** C ** GEOPPF ** C ** SEPTEMBER 1994: ** C ** GAMMAI ** C ** GAMMAIC ** C ** GAMMAR ** C ** GAMMAIP ** C ** MARCH 1995: ** C ** GCD ** C ** APRIL 1995: ** C ** GGDCDF ** C ** GGDPDF ** C ** GGDPPF ** C ** OCTOBER 1995: ** C ** GEVCDF ** C ** GEVPDF ** C ** GEVPPF ** C ** OCTOBER 1995: ** C ** GOMCDF ** C ** GOMPDF ** C ** GOMPPF ** C ** DECEMBER 1995: ** C ** GLOCDF ** C ** GLOPDF ** C ** GLOPPF ** C ** FEBRUARY 1996: ** C ** GEXCDF ** C ** GEXPDF ** C ** GEXPPF ** C ** APRIL 1998: ** C ** GEPHAZ, GEPCHA ** C ** GAMHAZ, GAMCHA ** C ** MARCH 1999: ** C ** GOODST ** C ** AUGUST 2001: ** C ** GLDCDF, GLDPDF ** C ** GLDPPF, GLDCHK ** C ** GLDLLM, GLDULM ** C ** GLDSGN ** C ** NOVEMBER 2001: ** C ** GEECDF, GEEPDF ** C ** GEEPPF, GEEHAZ ** C ** GEECHAZ ** C ** JANUARY 2003: ** C ** GHCDF, GHPDF, CHPPF ** C ** JULY 2003: ** C ** GTRCDF ** C ** GTRPDF ** C ** GTRPPF ** C ** DECEMBER 2003: ** C ** GIGCDF ** C ** GIGPDF ** C ** GIGPPF ** C ** APRIL 2004: ** C ** GWACDF, GWAPDF, GWAPPF ** C ** JUNE 2004: ** C ** GALCDF, GALPDF, GALPPF ** C ** SEPTEMBER 2004: ** C ** GMCCDF, GMCPDF, GMCPPF ** C ** MAY 2005: ** C ** GMCCDF, GMCPDF, GMCPPF ** C ** FEBRUARY 2006: ** C ** GL2CDF, GL2PDF, GL2PPF ** C ** GL3CDF, GL3PDF, GL3PPF ** C ** GL4CDF, GL4PDF, GL4PPF ** C ** GL5CDF, GL5PDF, GL5PPF ** C ** JUNE 2006: ** C ** GLSCDF, GLSPDF, GLSPPF ** C ** JULY 2006: ** C ** GETCDF, GETPDF, GETPPF ** C ** GNBCDF, GNBPDF, GNBPPF ** C ** NOVEMBER 2006: ** C ** GLGCDF, GLGPDF, GLGPPF ** C ******************************* C 700 CONTINUE IF(IA(I).EQ.'G')GOTO709 GOTO790 709 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'I'.AND. 1IA(IP6).EQ.'C')GOTO7700 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'I'.AND. 1IA(IP6).EQ.'P')GOTO7700 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'I')GOTO7600 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'R')GOTO7600 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A')GOTO7500 IF(IA(IP1).EQ.'H'.AND.IA(IP2).EQ.'C'.AND. 1IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP1).EQ.'H'.AND.IA(IP2).EQ.'P'.AND. 1IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP1).EQ.'H'.AND.IA(IP2).EQ.'P'.AND. 1IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500 C IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'D')GOTO7300 C IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'P')GOTO710 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'V')GOTO710 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X')GOTO710 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'O')GOTO710 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M')GOTO710 IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'D')GOTO710 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'M')GOTO710 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O')GOTO710 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'2')GOTO710 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'3')GOTO710 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'4')GOTO710 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'5')GOTO710 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'D')GOTO710 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'S')GOTO710 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'E')GOTO710 IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'R')GOTO710 IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'G')GOTO710 IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'A')GOTO710 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'L')GOTO710 IF(IA(IP1).EQ.'M'.AND.IA(IP2).EQ.'C')GOTO710 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'T')GOTO710 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'B')GOTO710 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'G')GOTO710 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'O'.AND. 1IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'T') 1GOTO7600 C GOTO9000 C 710 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND. 1 IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND. 1 IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND. 1 IA(IP5).EQ.'K')GOTO7600 IF(IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'L'.AND. 1 IA(IP5).EQ.'M')GOTO7600 IF(IA(IP3).EQ.'U'.AND.IA(IP4).EQ.'L'.AND. 1 IA(IP5).EQ.'M')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'G'.AND. 1 IA(IP5).EQ.'N')GOTO7600 GOTO9000 C 790 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED APRIL 1994 C ******************************* C ** STEP 8-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH H-- ** C ** HFNCDF ** C ** HFNPDF ** C ** HFNPPF ** C ** SEPTEMBER 1994 ** C ** HYPCDF ** C ** HYPPDF ** C ** HYPPPF ** C ** MARCH 1995 ** C ** HEAVE ** C ** JULY 1995 ** C ** HERMITE ** C ** HERMSGN ** C ** OCTOBER 1995 ** C ** HSECDF ** C ** HSEPDF ** C ** HSEPPF ** C ** OCTOBER 1995 ** C ** HFCCDF ** C ** HFCPDF ** C ** HFCPPF ** C ** OCTOBER 1995 ** C ** HFLCDF ** C ** HFLPDF ** C ** HFLPPF ** C ** MARCH 1997 ** C ** H0 ** C ** H1 ** C ** HV ** C ** AUGUST 1997 ** C ** HYPERGEO ** C ** MARCH 2004 ** C ** HERCDF, HERPDF, HERPPF ** C ** SEPTEMBER 2004 ** C ** HBOCDF, HBOPDF, HBOPPF ** C ** MAY 2006 ** C ** HBOCDF, HBOPDF, HBOPPF ** C ******************************* C 800 CONTINUE IF(IA(I).EQ.'H')GOTO809 GOTO890 809 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 IP8=I+8 C IF(IA(IP1).EQ.'F'.AND.IA(IP2).EQ.'N')GOTO810 IF(IA(IP1).EQ.'F'.AND.IA(IP2).EQ.'C')GOTO810 IF(IA(IP1).EQ.'F'.AND.IA(IP2).EQ.'L')GOTO810 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R')GOTO810 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'O')GOTO810 IF(IA(IP1).EQ.'Y'.AND.IA(IP2).EQ.'P'.AND. 1IA(IP3).EQ.'E'.AND.IA(IP4).EQ.'R'.AND. 1IA(IP5).EQ.'G'.AND.IA(IP6).EQ.'E'.AND.IA(IP7).EQ.'O')GOTO7800 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'N'.AND. 1IA(IP5).EQ.'U'.AND.IA(IP6).EQ.'M'.AND.IA(IP7).EQ.'B')GOTO7800 IF(IA(IP1).EQ.'Y'.AND.IA(IP2).EQ.'P')GOTO810 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'E')GOTO810 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'V'.AND. 1IA(IP4).EQ.'E')GOTO7500 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'I'.AND. 1IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'E')GOTO7700 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'S'.AND. 1IA(IP5).EQ.'G'.AND.IA(IP6).EQ.'N')GOTO7700 IF(IA(IP1).EQ.'0')GOTO7200 IF(IA(IP1).EQ.'1')GOTO7200 IF(IA(IP1).EQ.'V')GOTO7200 GOTO9000 C 810 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND. 1 IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND. 1 IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 890 CONTINUE C C C **************************** C ** STEP 9-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH I-- ** C ** INTEGER ** C ** INT ** C ** IND ** C ** IGCDF (MAY 1990) ** C ** IGPDF (MAY 1990) ** C ** IGPPF (MAY 1990) ** C ** IGHAZ (APRIL 1998) ** C ** IGCHA (APRIL 1998) ** C ** IGACDF (APRIL 1998) ** C ** IGAPDF (APRIL 1998) ** C ** IGAPPF (APRIL 1998) ** C ** IGAHAZ (APRIL 1998) ** C ** IGACHA (APRIL 1998) ** C ** SEPTEMBER 2001 ** C ** IWECDF ** C ** IWEPDF ** C ** IWEPPF ** C ** IWEHAZ ** C ** IWECHAZ ** C ** MAY 2003 ** C ** IBCDF ** C ** IBPDF ** C ** IBPPF ** C ** NOVEMBER 2005 ** C ** I0INT ** C ** I0ML0 ** C ** I1ML1 ** C **************************** C 900 CONTINUE IF(IA(I).EQ.'I')GOTO909 GOTO990 909 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C CCCCC THE FOLLOWING LINE WAS ADDED MAY 1990 IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A')GOTO920 IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'E')GOTO920 IF(IA(IP1).EQ.'G')GOTO910 IF(IA(IP1).EQ.'B')GOTO910 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'T'.AND. 1IA(IP3).EQ.'E'.AND.IA(IP4).EQ.'G'.AND. 1IA(IP5).EQ.'E'.AND.IA(IP6).EQ.'R')GOTO7700 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'T')GOTO7300 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'D')GOTO7300 IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'I'.AND. 1IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'T')GOTO7500 IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'0')GOTO7500 IF(IA(IP1).EQ.'1'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'1')GOTO7500 GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 910 CONTINUE IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'Z')GOTO7500 IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND. 1IA(IP5).EQ.'Z')GOTO7600 GOTO9000 C 920 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1IA(IP6).EQ.'Z')GOTO7700 GOTO9000 C 990 CONTINUE C CCCCC THE JULIA FUNCTION WAS ADDED APRIL 1989 C ******************************** C ** STEP 10-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH J-- ** C ** JULIA ** C ** JULY 1995 ** C ** JACOBIP ** C ** SEPTEMBER 2001 ** C ** JSBCDF, JSBPDF, JSBPPF ** C ** JSUCDF, JSUPDF, JSUPPF ** C ** NOVEMBER 2005 ** C ** J0INT ** C ******************************** C 1000 CONTINUE IF(IA(I).EQ.'J')GOTO1009 GOTO1090 1009 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'B')GOTO1020 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'U')GOTO1020 IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'L'.AND. 1IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'A')GOTO7500 IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'I'.AND. 1IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'T')GOTO7500 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'C'.AND. 1IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'B'.AND. 1IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'P') 1GOTO7700 C 1020 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 1090 CONTINUE C C ******************************************** C ** STEP 30-- ** C ** SINCE NO LEAD CHARACTER MATCH FOUND, ** C ** GO TO END OF SUBROUTINE. ** C ******************************************** C GOTO9000 C C ********************************************** C ** STEP 70-- ** C ** CHECK FOR A TRAILING LEFT PARENTHESIS. ** C ********************************************** C C7100 CONTINUE CCCCC IF(IA(IP1).EQ.'(')GOTO7110 CCCCC GOTO9000 C7110 CONTINUE CCCCC IFOUND='YES' CCCCC NCLF=1 CCCCC GOTO9000 C 7200 CONTINUE IF(IA(IP2).EQ.'(')GOTO7210 GOTO9000 7210 CONTINUE IFOUND='YES' NCLF=2 GOTO9000 C 7300 CONTINUE IF(IA(IP3).EQ.'(')GOTO7310 GOTO9000 7310 CONTINUE IFOUND='YES' NCLF=3 GOTO9000 C 7400 CONTINUE IF(IA(IP4).EQ.'(')GOTO7410 GOTO9000 7410 CONTINUE IFOUND='YES' NCLF=4 GOTO9000 C 7500 CONTINUE IF(IA(IP5).EQ.'(')GOTO7510 GOTO9000 7510 CONTINUE IFOUND='YES' NCLF=5 GOTO9000 C 7600 CONTINUE IF(IA(IP6).EQ.'(')GOTO7610 GOTO9000 7610 CONTINUE IFOUND='YES' NCLF=6 GOTO9000 C 7700 CONTINUE IF(IA(IP7).EQ.'(')GOTO7710 GOTO9000 7710 CONTINUE IFOUND='YES' NCLF=7 GOTO9000 C 7800 CONTINUE IP8=I+8 IF(IA(IP8).EQ.'(')GOTO7810 GOTO9000 7810 CONTINUE IFOUND='YES' NCLF=8 GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGCK.EQ.'OFF')GOTO9990 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9911) 9911 FORMAT('AT THE END OF CKLIB1--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9912)IFOUND,IERROR 9912 FORMAT('IFOUND = ',A4,' IERROR = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9913)NCLF 9913 FORMAT('NCLF = ',I8) CALL DPWRST('XXX','BUG ') 9990 CONTINUE C RETURN END SUBROUTINE CKLIB2(IA,N,I,IFOUND,NCLF,IBUGCK,IERROR) C C PURPOSE--SEARCH THE 1-CHARACTER PER WORD C CHARACTER STRING IN IA(.) C STARTING WITH POSITION I C AND DETERMINE IF THAT C STRING IS A MEMBER OF THE C AUGMENTED LIBRARY FUNCTION SET. C NOTE--THIS IS PART 2 C (SEARCHING FOR LIBRARY FUNCTIONS C WITH STARTING CHARACTERS OF K TO Z) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--JANUARY 1979. C UPDATED --FEBRUARY 1981. C UPDATED --JUNE 1981. C UPDATED --NOVEMBER 1981. C UPDATED --MARCH 1982. C UPDATED --MAY 1982. C UPDATED --JUNE 1987. WEICDF, WEIPDF, WEIPPF C UPDATED --SEPTEMBER 1987. LSD (= LEAST SIGNIFICANT DIGIT) C UPDATED --SEPTEMBER 1987. ROUND C UPDATED --DECEMBER 1988. LSD(.) RENAMED AS MSD(.) C UPDATED --MAY 1989. PERDEF(.,.) PERCENT DEFECTIVE C UPDATED --MAY 1990. RIGCDF/PDF/PPF (REV INV GAUS) C UPDATED --MAY 1990. WALCDF/PDF/PPF (WALD) C UPDATED --APRIL 1990. WALCDF/PDF/PPF (WALD) C UPDATED --APRIL 1994. POI-CDF/PDF/PPF (POISSON) C UPDATED --APRIL 1994. SEM-CDF/PPF (SEMI-CIRCULAR) C UPDATED --APRIL 1994. NB-CDF/PDF/PPF C (NEGATIVE BINOMIAL) C UPDATED --APRIL 1994. LAM-CDF/PDF/PPF/SF (LAMBDA) C UPDATED --APRIL 1994. LGN-CDF/PPF (LOG-NORMAL) C UPDATED --APRIL 1994. LOG-CDF/PPF (LOGISTIC) C UPDATED --APRIL 1994. PAR-CDF/PPF (PARETO) C UPDATED --APRIL 1994. UNI-CDF/PDF/PPF/SF (UNIFORM) C UPDATED --SEPTEMBER 1994. NCBCDF (NON-CENTRAL BETA) C UPDATED --SEPTEMBER 1994. NCCCDF (NON-CENTRAL CHISQ) C UPDATED --SEPTEMBER 1994. NCFCDF (NON-CENTRAL F) C UPDATED --SEPTEMBER 1994. NCTCDF (NON-CENTRAL T) C UPDATED --SEPTEMBER 1994. LNBETA (LOG BETA) C UPDATED --SEPTEMBER 1994. TRI-CDF/PDF/PPF (TRIANGULAR) C UPDATED --SEPTEMBER 1994. ELLIPTIC INTEGRALS (RC, ETC.) C UPDATED --SEPTEMBER 1994. TRICOMI (TRICOMI'S INCOMPLETE C GAMMA) C UPDATED --SEPTEMBER 1994. LOGINT (LOGARITHMIC INTEGRAL) C UPDATED --SEPTEMBER 1994. SPENCE (SPENCE DILOGARITHM) C UPDATED --SEPTEMBER 1994. POCH (POCHHAMMER'S C GENERALIZED SYMBOL) C UPDATED --SEPTEMBER 1994. POCH (POCHHAMMER'S C GENERALIZED SYMBOL FROM FIRST C ORDER) C UPDATED --SEPTEMBER 1994. SININT, SINHINT C UPDATED --OCTOBER 1994. VON-CDF/PDF/PPF (VON MISES) C UPDATED --OCTOBER 1994. BVNCDF (BIVARIATE NORMAL) C UPDATED --NOVEMBER 1994. PEQ, PEQ1, PLEM. PLEM1 C PEQI, PEQ1I, PLEMI, PLEM1I C WEIRSTRASS ELLIPTIC FUNCTIONS C UPDATED --NOVEMBER 1994. SN (JACOBIAN ELLIPTIC FUNC) C UPDATED --MARCH 1995. STEP (STEP FUNCTION) C UPDATED --APRIL 1995. PNRCDF, PNRPDF, PNRPPF C (POWER NORMAL DISTRIBUTIONS) C UPDATED --APRIL 1995. PLNCDF, PLNPDF, PLNPPF C (POWER NORMAL DISTRIBUTIONS) C UPDATED --APRIL 1995. POWCDF, POWPDF, POWPPF C UPDATED --APRIL 1995. TNRCDF, TNRPDF, TNRPPF C UPDATED --APRIL 1995. WARCDF, WARPDF, WARPPF C UPDATED --APRIL 1995. LLGCDF, LLGPDF, LLGPPF C UPDATED --APRIL 1995. NCTPDF C UPDATED --JULY 1995. LAGUERRE, LEGENDRE POLYNOMIALS C UPDATED --JULY 1995. NORMLAIZED LAGUERRE POLYNOMIALS C UPDATED --JULY 1995. ULTRASPERICAL POLYNOMIALS C UPDATED --OCTOBER 1995. LGAPDF, LGACDF, LGAPPF C UPDATED --OCTOBER 1995. PA2PDF, PA2CDF, PA2PPF C UPDATED --OCTOBER 1995. WCAPDF, WCACDF, WCAPPF C UPDATED --OCTOBER 1995. TNEPDF, TNECDF, TNEPPF C UPDATED --DECEMBER 1995. PEXPDF, PEXCDF, PEXPPF C UPDATED --JANUARY 1996. KAPPDF, KAPCDF, KAPPPF C UPDATED --MAY 1996. RECPDF, RECCDF, RECPPF C UPDATED --JANUARY 1997. LOGBETA, LNGAMMA C UPDATED --MARCH 1997. LAMBDA, LAMBDAP C UPDATED --MARCH 1997. L0, L1, LV C UPDATED --AUGUST 1997. PBDV, PBDV1 C UPDATED --AUGUST 1997. PBVV, PBVV1 C UPDATED --AUGUST 1997. PBWA, PBWA1 C UPDATED --SEPTEMBER 1997. PSI, ZETA C UPDATED --APRIL 1998. NORHAZ, NORCHAZ C UPDATED --APRIL 1998. PARHAZ, PARCHAZ C UPDATED --APRIL 1998. WEIHAZ, WEICHAZ C UPDATED --APRIL 1998. LGNHAZ, LGNCHAZ C UPDATED --APRIL 1998. LOGHAZ, LOGCHAZ C UPDATED --APRIL 1998. PLNHAZ, PLNCHAZ C UPDATED --APRIL 1998. PNRHAZ, PNRCHAZ C UPDATED --APRIL 1998. RIGHAZ, RIGCHAZ C UPDATED --APRIL 1998. WALHAZ, WALCHAZ C UPDATED --APRIL 1998. PEXHAZ, PEXCHAZ C UPDATED --APRIL 1998. UNIHAZ, UNICHAZ C UPDATED --MARCH 1999. SRACDF, SRAPDF, SRAPPF C UPDATED --MARCH 1999. LOBACH C UPDATED --MARCH 1999. SYNCH1 C UPDATED --MARCH 1999. SYNCH2 C UPDATED --MARCH 1999. STROM C UPDATED --MARCH 1999. TRAN C UPDATED --MAY 2002. TSPCDF, TSPPDF, TSPPPF C UPDATED --JANUARY 2003. SLAPDF C UPDATED --APRIL 2003. LANCDF, LANPDF, LANPPF C UPDATED --APRIL 2003. LANDIF, LANXM1, LANXM2 C UPDATED --JUNE 2003. TRACDF, TRAPDF, TRAPPF C UPDATED --NOVEMBER 2003. SNCDF, SNPDF, SNPPF C UPDATED --NOVEMBER 2003. STCDF, STPDF, STPPF C UPDATED --NOVEMBER 2003. ZIPCDF, ZIPPDF, ZIPPPF C UPDATED --DECEMBER 2003. MAKCDF, MAKPDF, MAKPPF C UPDATED --MARCH 2004. LSNCDF, LSNPDF, LSNPPF C UPDATED --MARCH 2004. LSTCDF, LSTPDF, LSTPPF C UPDATED --MARCH 2004. POLCDF, POLPDF, POLPPF C UPDATED --APRIL 2004. YULCDF, YULPDF, YULPPF C UPDATED --JUNE 2004. SDECDF, SDEPDF, SDEPPF C UPDATED --JUNE 2004. MAXCDF, MAXPDF, MAXPPF C UPDATED --JUNE 2004. RAYCDF, RAYPDF, RAYPPF C UPDATED --AUGUST 2004. MCLCDF, MCLPDF, MCLPPF C UPDATED --MARCH 2005. LGNAFR, WEIAFR C UPDATED --NOVEMBER 2005. K0INT C UPDATED --NOVEMBER 2005. Y0INT C UPDATED --FEBRUARY 2006. WAKCDF, WAKPDF, WAKPPF C UPDATED --MAY 2006. ZETCDF, ZETPDF, ZETPPF C UPDATED --MAY 2006. LBECDF, LBEPDF, LBEPPF C UPDATED --JUNE 2006. LPOCDF, LPOPDF, LPOPPF C UPDATED --JUNE 2006. LCTCDF, LCTPDF, LCTPPF C UPDATED --JUNE 2006. MATCDF, MATPDF, MATPPF C UPDATED --JUNE 2006. OCCCDF, OCCPDF, OCCPPF C UPDATED --JUNE 2006. PAPCDF, PAPPDF, PAPPPF C UPDATED --JUNE 2006. NEYCDF, NEYPDF, NEYPPF C UPDATED --JUNE 2006. LOSCDF, LOSPDF, LOSPPF C UPDATED --JULY 2006. PIGCDF, PIGPDF, PIGPPF C UPDATED --JULY 2006. QBICDF, QBIPDF, QBIPPF C UPDATED --AUGUST 2006. LKCDF, LKPDF, LKPPF C UPDATED --SEPTEMBER 2006. KATCDF, KATPDF, KATPPF C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IA CHARACTER*4 IFOUND CHARACTER*4 IBUGCK CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION IA(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IFOUND='NO' IERROR='NO' C NCLF=-99 C NP1=N+1 C IF(IBUGCK.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('AT THE BEGINNING OF CKLIB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)N,I,IBUGCK 52 FORMAT('N,I,IBUGCK = ',I8,I8,2X,A4) CALL DPWRST('XXX','BUG ') DO55I2=1,N WRITE(ICOUT,56)I2,IA(I2) 56 FORMAT('I2,IA(I2) = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') 55 CONTINUE 90 CONTINUE C IF(I.GE.NP1)GOTO9000 C C ********************************** C ** STEP 11-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH K-- ** C ** KAPCDF ** C ** KAPPDF ** C ** KAPPPF ** C ** SEPTEMBER 1997: ** C ** KER, KERI, KER1, KERI1 ** C ** NOVEMBER 2005: ** C ** K0INT ** C ** SEPTEMBER 2006: ** C ** KAPCDF ** C ** KAPPDF ** C ** KAPPPF ** C ********************************** C 1100 CONTINUE IF(IA(I).EQ.'K')GOTO1109 GOTO1190 1109 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'1')GOTO7500 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'I')GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'1')GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R')GOTO7300 IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'I'.AND. 1IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'T')GOTO7500 C IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'P')GOTO1120 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'T')GOTO1120 GOTO9000 C 1120 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 C 1190 CONTINUE C C C **************************** C ** STEP 12-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH L-- ** C ** LOGGAMMA ** C ** LOG10 ** C ** LOGE ** C ** LOG2 ** C ** LOG ** C ** LN ** C ** ADD: APRIL 1994 ** C ** LAMCDF ** C ** LAMPDF ** C ** LAMPPF ** C ** LAMSF ** C ** LGNCDF ** C ** LGNPDF ** C ** LGNPPF ** C ** LOGCDF ** C ** LOGPDF ** C ** LOGPPF ** C ** LOGSF ** C ** ADD: SEPTEMBER 1994 ** C ** LNBETA ** C ** LOGINT ** C ** ADD: APRIL 1995 ** C ** LLGCDF ** C ** LLGPDF ** C ** LLGPPF ** C ** ADD: JULY 1995 ** C ** LAGUERRE ** C ** LAGUERRL ** C ** LEGENDRE ** C ** LEGP ** C ** LEGQ ** C ** LNHERMIT ** C ** ADD: OCTOBER 1995 ** C ** LGACDF ** C ** LGAPDF ** C ** LGAPPF ** C ** ADD: JANUARY 1997 ** C ** LOGBETA ** C ** LNGAMMA ** C ** LAMBDA ** C ** ADD: MARCH 1997 ** C ** LAMBDA ** C ** LAMBDAP ** C ** L0, L1, LV ** C ** ADD: APRIL 1998 ** C ** LGNHAZ, LGNCHAZ ** C ** LOGHAZ, LLOGHAZ ** C ** ADD: MARCH 1999 ** C ** LOBACH ** C ** ADD: SEPTEMBER 2001 ** C ** LDECDF ** C ** LDEPDF ** C ** LDEPPF ** C ** ADD: APRIL 2003 ** C ** LANCDF ** C ** LANPDF ** C ** LANPPF ** C ** LANXM1 ** C ** LANXM2 ** C ** LANDIF ** C ** ADD: MARCH 2004 ** C ** LSNCDF ** C ** LSNPDF ** C ** LSNPPF ** C ** LSTCDF ** C ** LSTPDF ** C ** LSTPPF ** C ** ADD: MARCH 2005 ** C ** LGNAFR ** C ** ADD: MAY 2006 ** C ** LBECDF ** C ** LBEPDF ** C ** LBEPPF ** C ** ADD: JUNE 2006 ** C ** LPOCDF ** C ** LPOPDF ** C ** LPOPPF ** C ** LCTCDF ** C ** LCTPDF ** C ** LCTPPF ** C ** LOSCDF ** C ** LOSPDF ** C ** LOSPPF ** C ** ADD: AUGUST 2006 ** C ** LKCDF ** C ** LKPDF ** C ** LKPPF ** C **************************** C 1200 CONTINUE IF(IA(I).EQ.'L')GOTO1209 GOTO1290 1209 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'U'.AND. 1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'R'.AND. 1IA(IP7).EQ.'E')GOTO7800 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'U'.AND. 1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'R'.AND. 1IA(IP7).EQ.'L')GOTO7800 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'E'.AND. 1IA(IP4).EQ.'N'.AND.IA(IP5).EQ.'D'.AND.IA(IP6).EQ.'R'.AND. 1IA(IP7).EQ.'E')GOTO7800 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'P') 1GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'Q') 1GOTO7400 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'E'.AND. 1IA(IP4).EQ.'R'.AND.IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'I'.AND. 1IA(IP7).EQ.'T')GOTO7800 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'A'.AND. 1IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'A')GOTO7700 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'B'.AND. 1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'A')GOTO7700 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND.IA(IP3).EQ.'B'.AND. 1IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'P')GOTO7700 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND.IA(IP3).EQ.'B'.AND. 1IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'A')GOTO7600 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'B'.AND.IA(IP3).EQ.'A'.AND. 1IA(IP4).EQ.'C'.AND.IA(IP5).EQ.'H') 1GOTO7600 C IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'S')GOTO1230 IF(IA(IP1).EQ.'N')GOTO1240 IF(IA(IP1).EQ.'O')GOTO1210 IF(IA(IP1).EQ.'K')GOTO1250 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M')GOTO1220 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'N')GOTO1220 IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'N')GOTO1220 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'G')GOTO1220 IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A')GOTO1220 IF(IA(IP1).EQ.'D'.AND.IA(IP2).EQ.'E')GOTO1230 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'N')GOTO1230 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'T')GOTO1230 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'E')GOTO1230 IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'O')GOTO1230 IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'T')GOTO1230 IF(IA(IP1).EQ.'0')GOTO7200 IF(IA(IP1).EQ.'1')GOTO7200 IF(IA(IP1).EQ.'V')GOTO7200 GOTO9000 C 1210 CONTINUE IF(IA(IP2).EQ.'G')GOTO1215 GOTO9000 1215 CONTINUE IF(IA(IP3).EQ.'G'.AND.IA(IP4).EQ.'A'.AND. 1IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'M'.AND. 1IA(IP7).EQ.'A')GOTO7800 IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND. 1IA(IP5).EQ.'T')GOTO7600 IF(IA(IP3).EQ.'1'.AND.IA(IP4).EQ.'0')GOTO7500 IF(IA(IP3).EQ.'E')GOTO7400 IF(IA(IP3).EQ.'2')GOTO7400 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1IA(IP6).EQ.'Z')GOTO7700 GOTO7300 C 1220 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1IA(IP6).EQ.'Z')GOTO7700 IF(IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'F'.AND.IA(IP5).EQ.'R')GOTO7600 IF(IA(IP3).EQ.'X'.AND.IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'1')GOTO7600 IF(IA(IP3).EQ.'X'.AND.IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'2')GOTO7600 IF(IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 1230 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 1240 CONTINUE IF(IA(IP2).EQ.'B'.AND.IA(IP3).EQ.'E'.AND.IA(IP4).EQ.'T' 1.AND.IA(IP5).EQ.'A')GOTO7600 GOTO7200 C 1250 CONTINUE IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500 GOTO9000 C 1290 CONTINUE C C **************************** C ** STEP 13-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH M-- ** C ** MAX ** C ** MIN ** C ** MODULO ** C ** MOD ** C ** MSD ** C ** DECEMBER 2003 ** C ** MAKCDF ** C ** MAKPDF ** C ** MAKPPF ** C ** MAKHAZ ** C ** MAKCHAZ ** C ** JUNE 2004 ** C ** MAXCDF, MAXPDF, MAXPPF** C ** AUGUST 2004 ** C ** MCLCDF, MCLPDF, MCLPPF** C ** JUNE 2006 ** C ** MATCDF, MATPDF, MATPPF** C **************************** C 1300 CONTINUE IF(IA(I).EQ.'M')GOTO1309 GOTO1390 1309 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'N')GOTO7300 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'D'.AND. 1IA(IP3).EQ.'U'.AND.IA(IP4).EQ.'L'.AND. 1IA(IP5).EQ.'O')GOTO7600 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'D')GOTO7300 CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1988 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'D')GOTO7300 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'X')GOTO1330 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'K')GOTO1340 IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'L')GOTO1330 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'T')GOTO1330 GOTO9000 C 1330 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'X')GOTO7300 GOTO9000 C 1340 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1 IA(IP6).EQ.'Z')GOTO7700 GOTO9000 C 1390 CONTINUE C C **************************** C ** STEP 14-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH N-- ** C ** NORCDF ** C ** NORPDF ** C ** NORPPF ** C ** ADD: APRIL 1994 ** C ** NBCDF ** C ** NBPDF ** C ** NBPPF ** C ** NORSF ** C ** ADD: SEPTEMBER 1994 ** C ** NCBCDF ** C ** NCBPDF ** C ** NCBPPF ** C ** NCCCDF ** C ** NCCPDF ** C ** NCCNCP ** C ** NCCPPF ** C ** NCFCDF ** C ** NCFPDF ** C ** NCFPDF ** C ** NCFPPF ** C ** NCTCDF ** C ** NCTPDF ** C ** NCTPPF ** C ** ADD: APRIL 1995 ** C ** NCTPDF ** C ** ADD: JULY 1995 ** C ** NRMLAG ** C ** NRMLEG ** C ** NRMLEGP ** C ** NRMLEGQ ** C ** NRMLAGL ** C ** ADD: JANUARY 1996 ** C ** NCCCDF ** C ** ADD: APRIL 1998 ** C ** NORHAZ, NORCHAZ ** C ** ADD: JUNE 2006 ** C ** NEYCDF ** C ** NEYPDF ** C ** NEYPPF ** C **************************** C 1400 CONTINUE IF(IA(I).EQ.'N')GOTO1409 GOTO1490 1409 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'O')GOTO1410 IF(IA(IP1).EQ.'B')GOTO1420 IF(IA(IP1).EQ.'C')GOTO1430 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Y')GOTO1460 C IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'G') 1GOTO7600 CCCCC IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND. CCCCC1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'G'.AND. CCCCC1IA(IP6).EQ.'P')GOTO7700 CCCCC IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND. CCCCC1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'G'.AND. CCCCC1IA(IP6).EQ.'Q')GOTO7700 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'G') 1GOTO7600 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND. 1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'G'.AND. 1IA(IP6).EQ.'L') 1GOTO7700 C GOTO9000 C 1410 CONTINUE IF(IA(IP2).EQ.'R')GOTO1415 GOTO9000 1415 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1IA(IP6).EQ.'Z')GOTO7700 IF(IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'X'.AND.IA(IP5).EQ.'C'.AND. 1IA(IP6).EQ.'D'.AND.IA(IP7).EQ.'F')GOTO7800 IF(IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'X'.AND.IA(IP5).EQ.'P'.AND. 1IA(IP6).EQ.'D'.AND.IA(IP7).EQ.'F')GOTO7800 IF(IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'X'.AND.IA(IP5).EQ.'P'.AND. 1IA(IP6).EQ.'P'.AND.IA(IP7).EQ.'F')GOTO7800 GOTO9000 C 1420 CONTINUE IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500 GOTO9000 C 1430 CONTINUE IF(IA(IP2).EQ.'B')GOTO1460 IF(IA(IP2).EQ.'C')GOTO1470 IF(IA(IP2).EQ.'F')GOTO1460 IF(IA(IP2).EQ.'T')GOTO1480 GOTO9000 C 1460 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 1470 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'C'.AND.IA(IP5).EQ.'P')GOTO7600 GOTO9000 C 1480 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 1490 CONTINUE C C ******************************** C ** STEP 15-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH O-- ** C ** OCTAL ** C ** OCTDEC ** C ** OCCCDF, OCCPDF, OCCPPF ** C ******************************** C 1500 CONTINUE IF(IA(I).EQ.'O')GOTO1509 GOTO1590 1509 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'C')GOTO1580 IF(IA(IP1).EQ.'C')GOTO1510 GOTO9000 C 1510 CONTINUE IF(IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'L')GOTO7500 IF(IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'E'.AND. 1IA(IP5).EQ.'C')GOTO7600 C 1580 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C GOTO9000 C 1590 CONTINUE C C **************************** C ** STEP 16-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH P-- ** C ** PERDEF ** C ** ADD: APRIL 1994 ** C ** POICDF ** C ** POIPDF ** C ** POIPPF ** C ** PARCDF ** C ** PARPDF ** C ** PARPPF ** C ** ADD: SEPTEMBER 1994 ** C ** POCH ** C ** POCH1 ** C ** ADD: NOVEMBER 1994 ** C ** PEQ, PEQ1 ** C ** PLEM, PLEM1 ** C ** PEQI, PEQ1I ** C ** PLEMI, PLEM1I ** C ** ADD: APRIL 1995 ** C ** PNRCDF ** C ** PNRPDF ** C ** PNRPPF ** C ** ADD: APRIL 1995 ** C ** PLNCDF ** C ** PLNPDF ** C ** PLNPPF ** C ** ADD: APRIL 1995 ** C ** POWCDF ** C ** POWPDF ** C ** POWPPF ** C ** ADD: OCTOBER 1995 ** C ** PA2CDF ** C ** PA2PDF ** C ** PA2PPF ** C ** ADD: DECEMBER 1995 ** C ** PEXCDF ** C ** PEXPDF ** C ** PEXPPF ** C ** ADD: AUGUST 1997 ** C ** PBDV ** C ** PBDV1 ** C ** PBVV ** C ** PBVV1 ** C ** PBWA ** C ** PBWA1 ** C ** ADD: SEPTEMBER 1997 ** C ** PSI ** C ** ADD: OCTOBER 1997 ** C ** PSIFN ** C ** ADD: APRIL 1998 ** C ** PARHAZ, PARCHAZ ** C ** PNRHAZ, PNRCHAZ ** C ** PLNHAZ, PLNCHAZ ** C ** PEXHAZ, PEXCHAZ ** C ** ADD: MARCH 2004 ** C ** POLCDF ** C ** POLPDF ** C ** POLPPF ** C ** ADD: JUNE 2006 ** C ** PAPCDF ** C ** PAPPDF ** C ** PAPPPF ** C ** ADD: JULY 2006 ** C ** PIGCDF ** C ** PIGPDF ** C ** PIGPPF ** C **************************** C CCCCC THE ENTIRE P SECTION IS NEW MAY 1989 1600 CONTINUE IF(IA(I).EQ.'P')GOTO1609 GOTO1690 1609 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'D'.AND. 1IA(IP3).EQ.'V'.AND.IA(IP4).EQ.'1')GOTO7500 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'D'.AND. 1IA(IP3).EQ.'V')GOTO7400 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'V'.AND. 1IA(IP3).EQ.'V'.AND.IA(IP4).EQ.'1')GOTO7500 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'V'.AND. 1IA(IP3).EQ.'V')GOTO7400 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'W'.AND. 1IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'1')GOTO7500 IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'W'.AND. 1IA(IP3).EQ.'A')GOTO7400 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'F'.AND. 1IA(IP4).EQ.'N')GOTO7500 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'I')GOTO7300 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Q'.AND. 1IA(IP3).EQ.'1'.AND.IA(IP4).EQ.'I')GOTO7500 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Q'.AND. 1IA(IP3).EQ.'1')GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Q'.AND. 1IA(IP3).EQ.'I')GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Q')GOTO7300 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'M'.AND. 1IA(IP4).EQ.'1'.AND.IA(IP5).EQ.'I')GOTO7600 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'E'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'1')GOTO7500 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'E'.AND. 1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'I')GOTO7500 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'E'.AND. 1IA(IP3).EQ.'M')GOTO7400 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND. 1IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'E'.AND. 1IA(IP5).EQ.'F')GOTO7600 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'I')GOTO1610 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'W')GOTO1610 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'L')GOTO1610 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'P')GOTO1610 IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'G')GOTO1610 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H'.AND. 1IA(IP4).EQ.'1')GOTO7500 IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H')GOTO7400 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'R')GOTO1620 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'2')GOTO1620 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'R')GOTO1620 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N')GOTO1620 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X')GOTO1620 GOTO9000 C 1610 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 1620 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1IA(IP6).EQ.'Z')GOTO7700 GOTO9000 C 1690 CONTINUE C C ******************************* C ** STEP 17-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH Q-- ** C ** ADD: JULY 2006 ** C ** QBICDF, QBIPDF, QBIPPF ** C ******************************* C 1700 CONTINUE IF(IA(I).EQ.'Q')GOTO1709 GOTO1790 1709 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'I')GOTO1710 GOTO9000 C 1710 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 1790 CONTINUE C C **************************** C ** STEP 18-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH R-- ** C ** ROUND ** C ** RIGCDF (MAY 1990)** C ** RIGPDF (MAY 1990)** C ** RIGPPF (MAY 1990)** C ** SEPTEMBER 1994 ** C ** RC, RD, RF, RJ ** C ** MAY 1996 ** C ** RECCDF, RECPDF,RECPPF ** C ** APRIL 1998 ** C ** RIGHAZ, RIGCHAZ ** C ** JUNE 2004 ** C ** RAYCDF, RAYPDF,RAYPPF ** C **************************** C 1800 CONTINUE IF(IA(I).EQ.'R')GOTO1809 GOTO1890 1809 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'O')GOTO1810 IF(IA(IP1).EQ.'I')GOTO1820 IF(IA(IP1).EQ.'C')GOTO7200 IF(IA(IP1).EQ.'D')GOTO7200 IF(IA(IP1).EQ.'F')GOTO7200 IF(IA(IP1).EQ.'J')GOTO7200 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'C')GOTO1825 IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'Y')GOTO1825 CCCCC THE FOLLOWING LINE WAS ADDED MAY 1990 GOTO9000 C 1810 CONTINUE IF(IA(IP2).EQ.'U'.AND.IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'D')GOTO7500 GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 1820 CONTINUE IF(IA(IP2).EQ.'G')GOTO1825 GOTO9000 1825 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1IA(IP6).EQ.'Z')GOTO7700 GOTO9000 C 1890 CONTINUE C C **************************** C ** STEP 19-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH S-- ** C ** SECH ** C ** SEC ** C ** SIGN ** C ** SINH ** C ** SIN ** C ** SQRT ** C ** ADD: APRIL 1994 ** C ** SEMCDF ** C ** SEMPDF ** C ** SEMPPF ** C ** SEPTEMBER 1994 ** C ** SPENCE ** C ** SININT, SINHINT ** C ** NOVEMBER 1994 ** C ** SN ** C ** MARCH 1995 ** C ** STEP ** C ** JULY 1995 ** C ** SPHRHRMR ** C ** SPHRHRMC ** C ** MARCH 1999 ** C ** SRACDF ** C ** SRAPDF ** C ** SRAPPF ** C ** STROM ** C ** SYNCH1 ** C ** SYNCH2 ** C ** JANUARY 2003 ** C ** SLACDF ** C ** SLAPDF ** C ** NOVEMBER 2003 ** C ** SNCDF ** C ** SNPDF ** C ** SNPPF ** C ** STCDF ** C ** STPDF ** C ** STPPF ** C ** JUNE 2004 ** C ** SDECDF ** C ** SDEPDF ** C ** SDEPPF ** C **************************** C 1900 CONTINUE IF(IA(I).EQ.'S')GOTO1909 GOTO1990 1909 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'E')GOTO1910 IF(IA(IP1).EQ.'I')GOTO1920 IF(IA(IP1).EQ.'Q')GOTO1930 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A')GOTO1940 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'A')GOTO1940 IF(IA(IP1).EQ.'D'.AND.IA(IP2).EQ.'E')GOTO1940 IF(IA(IP1).EQ.'Y'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'C'.AND. 1IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'1')GOTO7600 IF(IA(IP1).EQ.'Y'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'C'.AND. 1IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'2')GOTO7600 IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'N'.AND. 1IA(IP4).EQ.'C'.AND.IA(IP5).EQ.'E')GOTO7600 IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'R'.AND. 1IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'M'.AND. 1IA(IP7).EQ.'R')GOTO7800 IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'R'.AND. 1IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'M'.AND. 1IA(IP7).EQ.'C')GOTO7800 IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'P')GOTO7400 IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'O'.AND. 1IA(IP4).EQ.'M')GOTO7500 IF(IA(IP1).EQ.'N')GOTO1950 IF(IA(IP1).EQ.'T')GOTO1950 GOTO9000 C 1910 CONTINUE IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H')GOTO7400 IF(IA(IP2).EQ.'C')GOTO7300 IF(IA(IP2).EQ.'M')GOTO1940 GOTO9000 C 1920 CONTINUE IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'I'.AND. 1IA(IP5).EQ.'N'.AND.IA(IP6).EQ.'T')GOTO7700 IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND. 1IA(IP5).EQ.'T')GOTO7600 IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'H')GOTO7400 IF(IA(IP2).EQ.'N')GOTO7300 IF(IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'N')GOTO7400 GOTO9000 C 1930 CONTINUE IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'T')GOTO7400 GOTO9000 C 1940 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 1950 CONTINUE IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP1).EQ.'N')GOTO7200 GOTO7200 C 1990 CONTINUE C C **************************** C ** STEP X.20-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH T-- ** C ** TANH ** C ** TAN ** C ** TCDF ** C ** TPDF ** C ** TPPF ** C ** SEPTEMBER 1994: ** C ** TRICDF ** C ** TRIPDF ** C ** TRIPPF ** C ** TRICOMI ** C ** APRIL 1995: ** C ** TNRCDF ** C ** TNRPDF ** C ** TNRPPF ** C ** OCTOBER 1995: ** C ** TNECDF ** C ** TNEPDF ** C ** TNEPPF ** C ** MARCH 1999: ** C ** TRAN ** C ** MAY 2002: ** C ** TSPCDF ** C ** TSPPDF ** C ** TSPPPF ** C ** JUNE 2003: ** C ** TRACDF ** C ** TRAPDF ** C ** TRAPPF ** C **************************** C 2000 CONTINUE IF(IA(I).EQ.'T')GOTO2009 GOTO2090 2009 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'A')GOTO2010 IF(IA(IP1).EQ.'C')GOTO2020 IF(IA(IP1).EQ.'P')GOTO2030 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A'.AND. 1IA(IP3).EQ.'N')GOTO7400 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A')GOTO2040 IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'I')GOTO2040 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'R')GOTO2050 IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'E')GOTO2050 IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'P')GOTO2040 GOTO9000 C 2010 CONTINUE IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'H')GOTO7400 IF(IA(IP2).EQ.'N')GOTO7300 GOTO9000 C 2020 CONTINUE IF(IA(IP2).EQ.'D'.AND.IA(IP3).EQ.'F')GOTO7400 GOTO9000 C 2030 CONTINUE IF(IA(IP2).EQ.'D'.AND.IA(IP3).EQ.'F')GOTO7400 IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'F')GOTO7400 GOTO9000 C 2040 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP2).EQ.'A')GOTO9000 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'M'.AND. 1IA(IP6).EQ.'I')GOTO7700 GOTO9000 C 2050 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 2090 CONTINUE C CCCCC THIS SECTION ADDED APRIL, 1994. C **************************** C ** STEP 21-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH U-- ** C ** UNICDF ** C ** UNIPDF ** C ** UNIPPF ** C ** UNISF ** C ** JULY 1995 ** C ** ULTRASPH ** C ** STARTING WITH U-- ** C ** UNIHAZ, UNICHAZ ** C **************************** 2100 CONTINUE IF(IA(I).EQ.'U')GOTO2109 GOTO2190 2109 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'I')GOTO2110 IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'R'.AND. 1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'S'.AND.IA(IP6).EQ.'P'.AND. 1IA(IP7).EQ.'H')GOTO7800 GOTO9000 C 2110 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1IA(IP6).EQ.'Z')GOTO7700 GOTO9000 C 2190 CONTINUE C CCCCC THIS SECTION ADDED OCTOBER, 1994. C **************************** C ** STEP 22-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH V-- ** C ** VONCDF ** C ** VONPDF ** C ** VONPPF ** C **************************** 2200 CONTINUE IF(IA(I).EQ.'V')GOTO2209 GOTO2290 2209 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'N')GOTO2210 GOTO9000 C 2210 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 C 2290 CONTINUE C C C **************************** C ** STEP 23-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH W-- ** C ** WEICDF ** C ** WEIPDF ** C ** WEIPPF ** C ** WALCDF (MAY 1990)** C ** WALPDF (MAY 1990)** C ** WALPPF (MAY 1990)** C ** APRIL 1995 ** C ** WARCDF ** C ** WARPDF ** C ** WARPPF ** C ** OCTOBER 1995 ** C ** WCACDF ** C ** WCAPDF ** C ** WCAPPF ** C ** APRIL 1998 ** C ** WEIHAZ, WEICHAZ ** C ** MARCH 2005 ** C ** WEIAFR ** C ** FEBRUARY 2006 ** C ** WAKCDF, WAKPDF, WAKPPF** C **************************** C 2300 CONTINUE IF(IA(I).EQ.'W')GOTO2309 GOTO2390 2309 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'E')GOTO2310 CCCCC THE FOLLOWING LINE WAS ADDED MAY 1990 IF(IA(IP1).EQ.'A')GOTO2320 IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'A')GOTO2315 GOTO9000 C 2310 CONTINUE IF(IA(IP2).EQ.'I')GOTO2315 GOTO9000 2315 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1IA(IP6).EQ.'Z')GOTO7700 IF(IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'F'.AND.IA(IP5).EQ.'R')GOTO7600 GOTO9000 C CCCCC THE FOLLOWING 8 LINES WERE ADDED MAY 1990 2320 CONTINUE IF(IA(IP2).EQ.'L')GOTO2328 IF(IA(IP2).EQ.'R')GOTO2325 IF(IA(IP2).EQ.'K')GOTO2325 GOTO9000 2325 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 GOTO9000 2328 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600 IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND. 1IA(IP6).EQ.'Z')GOTO7700 GOTO9000 C 2390 CONTINUE C CCCCC THIS SECTION ADDED APRIL 2004 C ****************************** C ** STEP 24-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH Y-- ** C ** YULCDF, YULPDF, YULPPF ** C ** NOVEMBER 2005: ** C ** Y0INT ** C ****************************** 2400 CONTINUE IF(IA(I).EQ.'Y')GOTO2409 GOTO2490 2409 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'L')GOTO2420 IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'I'.AND. 1IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'T')GOTO7500 GOTO9000 C 2420 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 C 2490 CONTINUE C CCCCC THIS SECTION ADDED SEPTEMBER, 1997. C **************************** C ** STEP 25-- ** C ** SEARCH FOR FUNCTIONS ** C ** STARTING WITH Z-- ** C ** ZETA ** C **************************** 2500 CONTINUE IF(IA(I).EQ.'Z')GOTO2509 GOTO2590 2509 CONTINUE C IP1=I+1 IP2=I+2 IP3=I+3 IP4=I+4 IP5=I+5 IP6=I+6 IP7=I+7 C IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'A')GOTO7400 IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'P')GOTO2520 IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'T')GOTO2520 GOTO9000 2520 CONTINUE IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600 IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600 C 2590 CONTINUE C C ******************************************** C ** STEP 30-- ** C ** SINCE NO LEAD CHARACTER MATCH FOUND, ** C ** GO TO END OF SUBROUTINE. ** C ******************************************** C GOTO9000 C C ********************************************** C ** STEP 70-- ** C ** CHECK FOR A TRAILING LEFT PARENTHESIS. ** C ********************************************** C C7100 CONTINUE CCCCC IF(IA(IP1).EQ.'(')GOTO7110 CCCCC GOTO9000 C7110 CONTINUE CCCCC IFOUND='YES' CCCCC NCLF=1 CCCCC GOTO9000 C 7200 CONTINUE IF(IA(IP2).EQ.'(')GOTO7210 GOTO9000 7210 CONTINUE IFOUND='YES' NCLF=2 GOTO9000 C 7300 CONTINUE IF(IA(IP3).EQ.'(')GOTO7310 GOTO9000 7310 CONTINUE IFOUND='YES' NCLF=3 GOTO9000 C 7400 CONTINUE IF(IA(IP4).EQ.'(')GOTO7410 GOTO9000 7410 CONTINUE IFOUND='YES' NCLF=4 GOTO9000 C 7500 CONTINUE IF(IA(IP5).EQ.'(')GOTO7510 GOTO9000 7510 CONTINUE IFOUND='YES' NCLF=5 GOTO9000 C 7600 CONTINUE IF(IA(IP6).EQ.'(')GOTO7610 GOTO9000 7610 CONTINUE IFOUND='YES' NCLF=6 GOTO9000 C 7700 CONTINUE IF(IA(IP7).EQ.'(')GOTO7710 GOTO9000 7710 CONTINUE IFOUND='YES' NCLF=7 GOTO9000 C 7800 CONTINUE IP8=I+8 IF(IA(IP8).EQ.'(')GOTO7810 GOTO9000 7810 CONTINUE IFOUND='YES' NCLF=8 GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGCK.EQ.'OFF')GOTO9990 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9911) 9911 FORMAT('AT THE END OF CKLIB2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9912)IFOUND,IERROR 9912 FORMAT('IFOUND = ',A4,' IERROR = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9913)NCLF 9913 FORMAT('NCLF = ',I8) CALL DPWRST('XXX','BUG ') 9990 CONTINUE C RETURN END SUBROUTINE CKLOSC(X,N,ISORSW,ICASAX, 1ISUBG4,IBUGG4,IERRG4) C C PURPOSE--CHECK THAT ALL DATA IN X(.) ARE VALID C (IN THIS CASE, MEANING POSITIVE) C IN PREPARATION FOR A LOG SCALE TRANSFORMATION. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--88.10 C ORIGINAL VERSION--MAY 1983. C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1988. C UPDATED --DECEMBER 1988. IBUGG4 FOR IBUGPL C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CHARACTER*4 ISORSW CHARACTER*4 ICASAX C CHARACTER*4 ISUBG4 CHARACTER*4 IBUGG4 CHARACTER*4 IERRG4 C C--------------------------------------------------------------------- C DIMENSION X(*) 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 IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LOSC')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKLOSC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG4,ISUBG4,IERRG4 52 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)ISORSW,ICASAX 53 FORMAT('ISORSW,ICASAX = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)N 61 FORMAT('N = ',I8) CALL DPWRST('XXX','BUG ') DO62I=1,N WRITE(ICOUT,63)I,X(I) 63 FORMAT('I,X(I) = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 62 CONTINUE 90 CONTINUE C C ************************************************** C ** STEP 11-- ** C ** CHECK THAT ALL X(.) ARE > 0 ** C ************************************************** C IF(ISORSW.EQ.'ON')GOTO1120 GOTO1130 C 1120 CONTINUE J=1 IF(X(J).LE.0.0)GOTO1150 GOTO9000 C 1130 CONTINUE DO1135I=1,N J=I IF(X(J).LE.0.0)GOTO1150 1135 CONTINUE GOTO9000 C 1150 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1151) 1151 FORMAT('***** ERROR IN CKLOSC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1152) 1152 FORMAT(' THE LOG OF A NON-POSITIVE DATA VALUE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1153) 1153 FORMAT(' WAS ENCOUNTERED IN FORMING A PLOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1154) 1154 FORMAT(' DATA MAY NOT BE ZERO OR NEGATIVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1155) 1155 FORMAT(' WHEN A LOG SCALE PLOT IS USED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1156)X(J) 1156 FORMAT(' THE VALUE = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1160) 1160 FORMAT(' THIS VALUE CAME FROM THE ') CALL DPWRST('XXX','BUG ') IF(ICASAX.EQ.'2DHO')WRITE(ICOUT,1161) 1161 FORMAT(' 2-D HORIZONTAL AXIS VARIABLE.') IF(ICASAX.EQ.'2DHO')CALL DPWRST('XXX','BUG ') IF(ICASAX.EQ.'2DVE')WRITE(ICOUT,1162) 1162 FORMAT(' 2-D VERTICAL AXIS VARIABLE.') IF(ICASAX.EQ.'2DVE')CALL DPWRST('XXX','BUG ') IF(ICASAX.EQ.'3DH1')WRITE(ICOUT,1163) 1163 FORMAT(' FIRST 3-D HORIZONTAL AXIS VARIABLE.') IF(ICASAX.EQ.'3DH1')CALL DPWRST('XXX','BUG ') IF(ICASAX.EQ.'3DH2')WRITE(ICOUT,1164) 1164 FORMAT(' 2ND 3-D HORIZONTAL AXIS VARIABLE.') IF(ICASAX.EQ.'3DH2')CALL DPWRST('XXX','BUG ') IF(ICASAX.EQ.'3DVE')WRITE(ICOUT,1165) 1165 FORMAT(' 3-D VERTICAL AXIS VARIABLE.') IF(ICASAX.EQ.'3DVE')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1171) 1171 FORMAT(' CORRECTIVE ACTION--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1172) 1172 FORMAT(' CHANGE DATA OR CHANGE LIMITS.') CALL DPWRST('XXX','BUG ') IERRG4='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LOSC')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKLOSC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGG4,ISUBG4,IERRG4 9012 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)ISORSW,ICASAX 9013 FORMAT('ISORSW,ICASAX = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)N,J 9021 FORMAT('N,J = ',2I8) CALL DPWRST('XXX','BUG ') DO9022I=1,N WRITE(ICOUT,9023)I,X(I) 9023 FORMAT('I,X(I) = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 9022 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE CKMATH(IBUGA3,ISUBRO,IFOUN7,ICASL7,ICASS7,IMSUBC,ILOCV) C C PURPOSE--CHECK TO SEE IF A TYPE 7 LET C COMMAND HAS BEEN GIVEN-- C SORT C SORTC (= SORT AND CARRY) C COCODE (= CORANK) C COCOPY C RANK C CODE C CODEH C CODE2 C CODE4 C CODE8 C CODE10 C C DISTINCT C SEQUENTIAL DIFFERENCE C INTERARRIVAL TIMES C CUMULATIVE AVERAGE C CUMULATIVE SUM C CUMULATIVE INTEGRAL C CUMULATIVE PRODUCT C CONVOLUTION C DECONVOLUTION C INTERPOLATE C LINEAR INTERPOLATE C 2D INTERPOLATE (SCATTERED TO RECTANGULAR GRID) C BILINEAR INTERPOLATE (FROM RECTANGULAR GRID) C BIVARIATE INTERPOLATE (FROM RECTANGULAR GRID) C C SINE TRANSFORM C COSINE TRANSFORM C LAPLACE TRANSFORM (NOT IMPLEMENTED) C INVERSE LAPLACE TRANSFORM (NOT IMPLEMENTED) C C FOURIER TRANSFORM C INVERSE FOURIER TRANSFORM C FFT C INVERSE FFT C C COMPLEX ADDITION C COMPLEX SUBTRACTION C COMPLEX MULTIPLICATION C COMPLEX DIVISION C COMPLEX EXPONENTIATION C COMPLEX SQUARE ROOT C COMPLEX ROOT (OF A POLYNOMIAL) (2 OR 1 ARGUMENTS) C COMPLEX CONJUGATE C C POLYNOMIAL ADDITION C POLYNOMIAL SUBTRACTION C POLYNOMIAL MULTIPLICATION C POLYNOMIAL DIVISION C POLYNOMIAL SQUARE C POLYNOMIAL SQUARE ROOT (FUTURE--NOT YET IMPLEMENTED) C POLYNOMIAL GCD (FUTURE--NOT YET IMPLEMENTED) C POLYNOMIAL LCM (FUTURE--NOT YET IMPLEMENTED) C POLYNOMIAL EVALUATION C C VECTOR ADDITION C VECTOR SUBTRACTION C VECTOR DOT PRODUCT (OR INNER PRODUCT) C VECTOR CROSS PRODUCT (FUTURE--NOT YET IMPLEMENTED) C VECTOR LENGTH (OR MAGNITUDE) C VECTOR DISTANCE C VECTOR ANGLE C C SET UNION (OR ADDITION) C SET INTERSECTION C SET COMPLEMENT C SET CARDINALITY C SET CARTESIAN PRODUCT C SET ELEMENTS (DISTINCT) C C LOGICAL AND (OR CONJUNCTION OR MULTIPLICATION) C LOGICAL OR (OR DISJUNCTION OR ADDITION) C LOGICAL NAND C LOGICAL NOR C LOGICAL IFTHEN (OR IMPLICATION) C LOGICAL IFF (OR EQUIVALENCE) C LOGICAL NOT (OR NEGATION OR NOT OR COMPLEMENT) C LOGICAL XOR (OR EXCLUSIVE OR OR EXCL. DISJ.) C C MATRIX DEFINITION C MATRIX SUBMATRIX C CREATE MATRIX C MATRIX TRANSPOSE C MATRIX NUMBER OF ROWS C MATRIX NUMBER OF COLUMNS C MATRIX ROW C MATRIX ELEMENT C MATRIX REPLACE ROW C MATRIX ADD ROW C MATRIX DELETE ROW C MATRIX REPLACE ELEMENT C MATRIX AUGMENT C MATRIX DIAGONAL C DIAGONAL MATRIX C C MATRIX ADDITION C MATRIX SUBTRACTION C MATRIX MULTIPLICATION C C MATRIX INVERSE C MATRIX SOLUTION C MATRIX ITERATIVE SOLUTION C TRIDIAGONAL SOLVE C TRIANGULAR SOLVE C TRIANGULAR INVERSE C MATRIX CHOLESKY DECOMP C MATRIX SIMPLEX SOLUTION C PSUEDO INVERSE (NOT IMPLEMENTED) C QR DECOMPOSITION (NOT DONE) C C MATRIX EIGENVALUES C MATRIX EIGENVECTORS C MATRIX SINGULAR VALUES C MATRIX SINGULAR VALUE DECOMPOSITION C MATRIX SINGULAR VALUE FACTORIZATION C C MATRIX DETERMINANT C MATRIX ADJOINT C MATRIX MINOR C MATRIX COFACTOR C MATRIX CHARACTERISTIC EQ. (FUTURE--NOT YET IMP.) C MATRIX PERMANENT (FUTURE--NOT YET IMP.) C C MATRIX RANK C MATRIX TRACE C MATRIX SPECTRAL NORM C MATRIX SPECTRAL RADIUS C MATRIX EUCLIDEAN NORM C C VARIANCE-COVARIANCE MATRIX C CORRELATION MATRIX C POOLED VARIANCE-COVARIANCE MATRIX C PRINCIPLE COMPONENTS C PRINCIPLE COMPONENTS EIGENVECTORS C PRINCIPLE COMPONENTS EIGENVALUES C ... PRINCIPLE COMPONENT C ... PRINCIPLE COMPONENTS EIGENVECTORS C ... PRINCIPLE COMPONENTS EIGENVALUES C C CATCHER MATRIX C XTXINV MATRIX C VARIANCE INFLATION FACTORS C CONDITION INDICES C QUADRATIC FORM C LINEAR COMBINATION C VECTOR TIMES TRANSPOSE C C HOTELLING 1-SAMPLE T-SQUARE C HOTELLING 2-SAMPLE T-SQUARE C MATRIX MEAN C MATRIX SUM C DISTANCE FROM MEAN C MATRIX ROW C MATRIX COLUMN C MATRIX PARTITION C MATRIX GRAND C MATRIX BIN C MATRIX GROUP MEANS C MATRIX GROUP STANDARD DEVIATIONS C MATRIX ROW SCALE C MATRIX COLUMN SCALE C EUCLIDEAN ROW DISTANCE C EUCLIDEAN COLUMN DISTANCE C MAHALANOBIS ROW DISTANCE C MAHALANOBIS COLUMN DISTANCE C MINKOWSKY ROW DISTANCE C MINKOWSKY COLUMN DISTANCE C CHEBYCHEV ROW DISTANCE C CHEBYCHEV COLUMN DISTANCE C BLOCK ROW DISTANCE C BLOCK COLUMN DISTANCE C C MULTIVARIATE NORMAL RANDOM NUMBERS C INDEPENDENT UNIFORM RANDOM NUMBERS C CORRELATED UNIFORM RANDOM NUMBERS C MULTIVARIATE T RANDOM NUMBERS C MULTINOMIAL RANDOM NUMBERS C MULTINOMIAL PDF C WISHART RANDOM NUMBERS C DIRICHLET RANDOM NUMBERS C DIRICHLET PDF C DIRICHLET LOG PDF C MULTIVARIATE NORMAL CDF C MULTIVARIATE T CDF C C MATRIX BIN C MATRIX SUBTRACT C C FRACTAL C BOOTSTRAP SAMPLE C RANDOM SAMPLE = BOOTSTRAP SAMPLE C JACKNIFE SAMPLE = BOOTSTRAP SAMPLE C JACKNIFE INDEX C RANDOM SAMPLE C REVERSE C CUMULATIVE HAZARD C HAZARD C EXPONENTIAL SMOOTHING C C BINNED (= FREQUENCY TABLE) C RELATIVE BINNED (= RELATIVE FREQUENCY TABLE) C ASH BINNED C COUNTS ASH BINNED C FREQUENCY TO RAW C COMBINE FREQUENCY TABLE C INTEGER FREQUENCY TABLE C C CUSUM ARL (= TWO SIDED CUSUM ARL) C ONE-SIDED CUSUM ARL C TWO-SIDED CUSUM ARL C C STANDARDIZE C LOCATION STANDARDIZE C SCALE STANDARDIZE C ZSCORE C USCORE C C CROSS TABULATE C C SORT BY C C MATCH C REPLACE C STACK C REPLICATED STACK C C WINSOR C C H CONSISTENCY STATISTIC C K CONSISTENCY STATISTIC C C PROBABILITY WEIGHTED MOMENTS C BETA PROBABILITY WEIGHTED MOMENTS C L MOMENTS C C GENERATOR MULTIPLICATION C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--87/10 C ORIGINAL VERSION--JULY 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --NOVEMBER 1981. C UPDATED --MAY 1982. C UPDATED --JANUARY 1987. C UPDATED --APRIL 1987. C UPDATED --AUGUST 1987. COMPLEX SQUARE ROOT C UPDATED --AUGUST 1987. COMPLEX ROOTS (OF POLYNOMIAL) C UPDATED --AUGUST 1987. POLYNOMIAL ARITHMETIC C UPDATED --AUGUST 1987. VECTOR ARITHMETIC C UPDATED --AUGUST 1987. SET ARITHMETIC C UPDATED --AUGUST 1987. LOGICAL ARITHMETIC C UPDATED --SEPTEMBER 1987. FFT AND INVERSE FFT C UPDATED --SEPTEMBER 1987. MATRIX OPERATIONS C UPDATED --SEPTEMBER 1987. COMPLEX CONJUGATE C UPDATED --FEBRUARY 1988. BIWEIGHT AND TRICUBE C UPDATED --JULY 1988. FRACTAL C UPDATED --JANUARY 1989. BOOTSTRAP SAMPLE C UPDATED --JANUARY 1989. BOOTSTRAP SAMPLE C UPDATED --JANUARY 1989. JACKNIFE SAMPLE = BOOTSTRAP SAMPLE C UPDATED --JANUARY 1990. RANDOM (SUB)SAMPLE (GENERALIZE) C C UPDATED --AUGUST 1988 (VARIANCE-COVARIANCE MATRIX) C UPDATED --AUGUST 1988 (CORRELATION MATRIX) C UPDATED --AUGUST 1988 (PRINCIPLE COMPONENTS ...) C UPDATED --AUGUST 1988 (... PRINCIPLE COMPONENTS ...) C C UPDATED --DECEMBER 1989. GENERATOR MULTIPLICATION C UPDATED --JULY 1991. COCODE ('COCD') C UPDATED --JULY 1991. COCOPY ('COCP') C UPDATED --OCTOBER 1991. CORANK SYNONYM FOR COCODE C UPDATED --MARCH 1992. RECOGNIZE SORT & CARRY C UPDATED --JULY 1993. MATRIX SINGULAR VALUES AND C MATRIX SING VALUE DECOMP C UPDATED --SEPTEMBER 1993. MATRIX ROW C MATRIX ELEMENT C UPDATED --OCTOBER 1993. JACKNIFE INDEX C UPDATED --OCTOBER 1993. CHOLESKY DECOMP, MATRIX C REPLACE ROW, MATRIX REPLACE C ELEMENT, MATRIX AUGMENT, MATRIX C DIAGONAL, DIAGONAL MATRIX, C TRIDIAGONAL SOLVE C UPDATED --MAY 1994. LINEAR INTERPOLATE, 2D C INTERPOLATE, BILINEAR INTERPOL C UPDATED --FEBRUARY 1998. CODED AS SYNONYM FOR CODE C UPDATED --MAY 1998. INTERARRIVAL TIMES C UPDATED --MAY 1998. CUMULATIVE AVERAGE C UPDATED --MAY 1998. REVERSE (OR FLIP) C UPDATED --MAY 1998. HAZARD C UPDATED --MAY 1998. CUMULATIVE HAZARD C UPDATED --JUNE 1998. SOME NEW MATRIX COMMANDS C UPDATED --AUGUST 1998. MATRIX MEAN C UPDATED --AUGUST 1998. MATRIX ADD ROW C UPDATED --AUGUST 1998. MATRIX DELETE ROW C UPDATED --SEPTEMBER 1998. MATRIX GROUP MEAN C UPDATED --SEPTEMBER 1998. MATRIX GROUP STANDARD DEVIATION C UPDATED --NOVEMBER 1998. BINNED, RELATIVE BINNED C UPDATED --MARCH 1999. CUSUM ARL C UPDATED --MARCH 2001. STANDARDIZE C UPDATED --MARCH 2001. LOCATION STANDARDIZE C UPDATED --SEPTEMBER 2001. FIXES TO STANDARDIZE C UPDATED --SEPTEMBER 2001. LOCATION STANDARDIZE C UPDATED --OCTOBER 2001. MATCH C UPDATED --MAY 2002. MULTIVARIATE NORM RAND NUMB C UPDATED --MAY 2002. MULTINOMIAL RAND NUMB C UPDATED --MAY 2002. WISHART RAND NUMB C UPDATED --MAY 2002. FERMDIRA C UPDATED --JUNE 2002. CATCHER MATRIX C UPDATED --JUNE 2002. XTXINV MATRIX C UPDATED --JUNE 2002. VARIANCE INFLATION FACTORS C UPDATED --JUNE 2002. CONDITION INDICES C UPDATED --JUNE 2002. CREATE MATRIX C UPDATED --JULY 2002. WINSORIZE C UPDATED --AUGUST 2002. UPDATE SUPPORTED STATISTICS C FOR CROSS TABULATE AND C MATRIX C UPDATED --MARCH 2003. ADD 35 "DIFFERENCE OF" C STATISTICS TO CROSS TABULATE C UPDATED --APRIL 2003. MULTIVARIATE T RAND NUMB C UPDATED --APRIL 2003. MULTIVARIATE INDE UNIF RAND NUMB C UPDATED --APRIL 2003. MULTIVARIATE DIRE RAND NUMB C UPDATED --APRIL 2003. MULTIVARIATE NORM CDF C UPDATED --APRIL 2003. MULTIVARIATE NORM PDF C UPDATED --APRIL 2003. ADD SN SCALE AND QN SCALE TO C CROSS TABULATE AND C MATRIX ROW/COLUMN STAT C UPDATED --MAY 2003. STACK COMMAND C UPDATED --MAY 2003. MULTINOMIAL PDF C UPDATED --OCTOBER 2004. ASH BIN C UPDATED --OCTOBER 2004. COUNTS ASH BIN C UPDATED --OCTOBER 2004. COMBINE FREQUENCY TABLE C UPDATED --FEBRUARY 2005. REPLICATED STACK C UPDATED --FEBRUARY 2005. H CONSISTENCY STATISTIC C UPDATED --FEBRUARY 2005. K CONSISTENCY STATISTIC C UPDATED --JUNE 2005. L MOMENTS C UPDATED --JUNE 2005. PROBABILITY WEIGHTED MOMENTS C UPDATED --JUNE 2005. MATRIX C UPDATED --JUNE 2005. MATRIX PARTITION C UPDATED --SEPTEMBER 2005. CROSS TABULATE RATIO C UPDATED --DECEMBER 2005. BETA PROBABILITY WEIGHTED C MOMENTS C UPDATED --DECEMBER 2005. SORT BY C UPDATED --MARCH 2006. MATRIX BIN C UPDATED --MARCH 2006. MATRIX LOWER TRUNCATE C UPDATED --MARCH 2006. MATRIX UPPER TRUNCATE C UPDATED --MAY 2006. INTEGER FREQUENCY TABLE C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGA3 CHARACTER*4 ISUBRO CHARACTER*4 IFOUN7 CHARACTER*4 ICASL7 CHARACTER*4 ICASS7 CHARACTER*4 IMSUBC C CHARACTER*4 IERROR CHARACTER*4 IH CHARACTER*4 IH2 C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 C IERROR='NO' C C ********************************************* C ** CHECK FOR A DATA MANIPULATION SUBCASE ** C ********************************************* C IFOUN7='NO' ICASL7='UNKN' ICASS7='UNKN' ILOCV=-1 C IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MATH')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKMATH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3,ISUBRO 52 FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)NUMARG 53 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') DO54I=1,NUMARG WRITE(ICOUT,55)I,IHARG(I) 55 FORMAT('I,IHARG(I) = ',I8,1X,A4) CALL DPWRST('XXX','BUG ') 54 CONTINUE 90 CONTINUE C C ********************************* C ** STEP 1-- ** C ** DETERMINE IF OF THIS TYPE ** C ** AND BRANCH ACCORDINGLY. ** C ********************************* C IF(NUMARG.LE.3)GOTO9000 C CCCCC THE FOLLOWING SECTION WERE ADDED MARCH 1992 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'SORT'.AND.IHARG2(3).EQ.' '.AND. 1IHARG(4).EQ.'AND '.AND.IHARG2(4).EQ.' '.AND. 1IHARG(5).EQ.'CARR'.AND.IHARG2(5).EQ.'Y ')GOTO1110 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SORT'.AND.IHARG2(3).EQ.' '.AND. 1IHARG(4).EQ.'CARR'.AND.IHARG2(4).EQ.'Y ')GOTO1120 GOTO1190 1110 CONTINUE ISHIFT=2 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1IBUGA3,IERROR) IHARG(3)='SORT' IHARG2(3)='C ' GOTO1190 1120 CONTINUE ISHIFT=1 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1IBUGA3,IERROR) IHARG(3)='SORT' IHARG2(3)='C ' GOTO1190 1190 CONTINUE C C ************************************** C ** CHECK FOR SORT BY ** C ************************************** C CCCCC DECEMBER 2005: SORT BY CCCCC ONLY SUPPORT FOR STATISTICS WITH A SINGLE VARIABLE (I.E., CCCCC NO "DIFFERENCE OF", "WEIGHTED", OR 2-VARIABLE STATISTICS). CCCCC PARSE HERE TO DISTINGUISH FROM SORT COMMAND. CCCCC SET ICASS7 FOR SUBSEQUENT USE IN DPMATC SUBROUTINE. C IF(NUMARG.GE.6.AND.IHARG(4).EQ.'SORT'.AND.IHARG(5).EQ.'BY ')THEN IF(IHARG(6).EQ.'MEAN')GOTO13002 IF(IHARG(6).EQ.'MIDM')GOTO13004 IF(IHARG(6).EQ.'MEDI'.AND. 1 IHARG(7).EQ.'ABSO'.AND.IHARG(8).EQ.'DEVI')GOTO13006 IF(IHARG(6).EQ.'MAD')GOTO13008 IF(IHARG(6).EQ.'SN'.AND.IHARG(7).EQ.'SCAL')GOTO13010 IF(IHARG(6).EQ.'QN'.AND.IHARG(7).EQ.'SCAL')GOTO13012 IF(IHARG(6).EQ.'MEDI')GOTO13014 IF(IHARG(6).EQ.'TRIM'.AND. 1 IHARG(7).EQ.'MEAN'.AND.IHARG(8).EQ.'STAN'.AND. 1 IHARG(9).EQ.'ERRO')GOTO13016 IF(IHARG(6).EQ.'TRIM'.AND.IHARG(7).EQ.'MEAN')GOTO13018 IF(IHARG(6).EQ.'WINS'.AND.IHARG(7).EQ.'MEAN')GOTO13020 IF(IHARG(6).EQ.'SUM ')GOTO13022 IF(IHARG(6).EQ.'PROD')GOTO13024 IF(IHARG(6).EQ.'SD '.AND. 1 IHARG(7).EQ.'OF '.AND.IHARG(8).EQ.'MEAN')GOTO13026 IF(IHARG(6).EQ.'SD ')GOTO13028 IF(IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI'.AND. 1 IHARG(8).EQ.'OF '.AND.IHARG(9).EQ.'MEAN')GOTO13030 IF(IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO13032 IF(IHARG(6).EQ.'VARI'.AND.IHARG(7).EQ.'OF '.AND. 1 IHARG(8).EQ.'MEAN')GOTO13034 IF(IHARG(6).EQ.'VARI')GOTO13036 IF(IHARG(6).EQ.'RELA'.AND.IHARG(7).EQ.'VARI')GOTO13038 IF(IHARG(6).EQ.'RELA'.AND.IHARG(7).EQ.'SD ')GOTO13040 IF(IHARG(6).EQ.'RELA'.AND.IHARG(7).EQ.'STAN'.AND. 1 IHARG(8).EQ.'DEVI')GOTO13042 IF(IHARG(6).EQ.'COEF'.AND.IHARG(7).EQ.'OF '.AND. 1 IHARG(8).EQ.'VARI')GOTO13044 IF(IHARG(6).EQ.'AVER'.AND.IHARG(7).EQ.'ABSO'.AND. 1 IHARG(8).EQ.'DEVI')GOTO13046 IF(IHARG(6).EQ.'RANG')GOTO13048 IF(IHARG(6).EQ.'MIDR')GOTO13050 IF(IHARG(6).EQ.'MAXI')GOTO13052 IF(IHARG(6).EQ.'MINI')GOTO13054 IF(IHARG(6).EQ.'EXTR')GOTO13056 C IF(IHARG(6).EQ.'LOWE'.AND.IHARG(7).EQ.'HING')GOTO13058 IF(IHARG(6).EQ.'UPPE'.AND.IHARG(7).EQ.'HING')GOTO13060 IF(IHARG(6).EQ.'LOWE'.AND.IHARG(7).EQ.'QUAR')GOTO13062 IF(IHARG(6).EQ.'UPPE'.AND.IHARG(7).EQ.'QUAR')GOTO13064 IF(IHARG(6).EQ.'SKEW')GOTO13066 IF(IHARG(6).EQ.'KURT')GOTO13068 IF(IHARG(6).EQ.'AUTO'.AND.IHARG2(6).EQ.'CORR')GOTO13070 IF(IHARG(6).EQ.'AUTO'.AND.IHARG2(6).EQ.'COVA')GOTO13072 IF(IHARG(6).EQ.'INTE'.AND.IHARG(7).EQ.'RANG')GOTO13074 IF(IHARG(6).EQ.'IQ '.AND.IHARG(7).EQ.'RANG')GOTO13074 IF(IHARG(6).EQ.'BIWE'.AND.IHARG(7).EQ.'LOCA')GOTO13078 IF(IHARG(6).EQ.'BIWE'.AND.IHARG(7).EQ.'SCAL')GOTO13080 IF(IHARG(6).EQ.'BIWE'.AND.IHARG(7).EQ.'MIDV')GOTO13082 IF(IHARG(6).EQ.'WINS'.AND.IHARG(7).EQ.'SD')GOTO13084 IF(IHARG(6).EQ.'WINS'.AND.IHARG(7).EQ.'STAN'.AND. 1 IHARG(8).EQ.'DEVI')GOTO13086 IF(IHARG(6).EQ.'WINS'.AND.IHARG(7).EQ.'VARI')GOTO13088 IF(IHARG(6).EQ.'PERC'.AND. 1 IHARG(7).EQ.'BEND'.AND.IHARG(8).EQ.'MIDV')GOTO13090 IF(IHARG(6).EQ.'HODG'.AND.IHARG(7).EQ.'LEHM')GOTO13092 IF(IHARG(6).EQ.'QUAN'.AND. 1 IHARG(7).EQ.'STAN'.AND.IHARG(8).EQ.'ERRO')GOTO13094 IF(IHARG(6).EQ.'QUAN')GOTO13096 IF(IHARG(6).EQ.'CP')GOTO13098 IF(IHARG(6).EQ.'CPK')GOTO13100 IF(IHARG(6).EQ.'CPM')GOTO13102 IF(IHARG(6).EQ.'CPL')GOTO13104 IF(IHARG(6).EQ.'CPU')GOTO13106 IF(IHARG(6).EQ.'CNPK')GOTO13108 IF(IHARG(6).EQ.'CC')GOTO13110 IF(IHARG(6).EQ.'PERC'.AND.IHARG(7).EQ.'DEFE')GOTO13112 IF(IHARG(6).EQ.'EXPE'.AND.IHARG(7).EQ.'LOSS')GOTO13114 IF(IHARG(6).EQ.'PERC')GOTO13116 IF(IHARG(6).EQ.'HARM'.AND.IHARG(7).EQ.'MEAN')GOTO13118 IF(IHARG(6).EQ.'GEOM'.AND.IHARG(7).EQ.'MEAN')GOTO13120 IF(IHARG(6).EQ.'GEOM'.AND.IHARG(7).EQ.'SD')GOTO13122 IF(IHARG(6).EQ.'GEOM'.AND. 1 IHARG(7).EQ.'STAN'.AND.IHARG(8).EQ.'DEVI')GOTO13124 IF(IHARG(6).EQ.'NORM'.AND.IHARG(7).EQ.'PPCC')GOTO13126 IF(IHARG(6).EQ.'FIRS'.AND.IHARG(7).EQ.'DECI')GOTO13128 IF(IHARG(6).EQ.'SECO'.AND.IHARG(7).EQ.'DECI')GOTO13130 IF(IHARG(6).EQ.'THIR'.AND.IHARG(7).EQ.'DECI')GOTO13132 IF(IHARG(6).EQ.'FOUR'.AND.IHARG(7).EQ.'DECI')GOTO13134 IF(IHARG(6).EQ.'FIFT'.AND.IHARG(7).EQ.'DECI')GOTO13136 IF(IHARG(6).EQ.'SIXT'.AND.IHARG(7).EQ.'DECI')GOTO13138 IF(IHARG(6).EQ.'SEVE'.AND.IHARG(7).EQ.'DECI')GOTO13140 IF(IHARG(6).EQ.'EIGH'.AND.IHARG(7).EQ.'DECI')GOTO13142 IF(IHARG(6).EQ.'NINT'.AND.IHARG(7).EQ.'DECI')GOTO13144 IF(IHARG(6).EQ.'TAGU'.AND.IHARG(7).EQ.'SN00')GOTO13146 IF(IHARG(6).EQ.'TAGU'.AND.IHARG(7).EQ.'SN0')GOTO13148 IF(IHARG(6).EQ.'TAGU'.AND.IHARG(7).EQ.'SN+')GOTO13150 IF(IHARG(6).EQ.'TAGU'.AND.IHARG(7).EQ.'SN-')GOTO13152 IF(IHARG(6).EQ.'SN00')GOTO13154 IF(IHARG(6).EQ.'SN0')GOTO13156 IF(IHARG(6).EQ.'SN+')GOTO13158 IF(IHARG(6).EQ.'SN-')GOTO13160 IF(IHARG(6).EQ.'SINE'.AND.IHARG(7).EQ.'FREQ')GOTO13162 IF(IHARG(6).EQ.'SIN'.AND.IHARG(7).EQ.'FREQ')GOTO13162 IF(IHARG(6).EQ.'SINE'.AND.IHARG(7).EQ.'AMPL')GOTO13164 IF(IHARG(6).EQ.'SIN'.AND.IHARG(7).EQ.'AMPL')GOTO13164 ENDIF C IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SORT'.AND.IHARG2(3).EQ.' ')GOTO1201 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'RANK'.AND.IHARG2(3).EQ.' ')GOTO1202 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.' ')GOTO1203 CCCCC ADD FOLLOWING 2 LINES FEBRUARY 1998. IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'D ')GOTO1203 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'DIST'.AND.IHARG2(3).EQ.'INCT')GOTO1204 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'DIFF'.AND.IHARG2(3).EQ.'EREN')GOTO1205 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SEQU'.AND.IHARG(4).EQ.'DIFF')GOTO1206 CCCCC ADD FOLLOWING 2 LINES MAY 1998. IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'TIME')GOTO11206 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'DIFF')GOTO1206 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'SUM ')GOTO1207 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'AVER')GOTO11207 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'HAZA')GOTO11209 IF(NUMARG.GE.3.AND.IHARG(3).EQ.'HAZA')GOTO11210 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'MEAN')GOTO11207 CCCCC ADD FOLLOWING 2 LINES OCTOBER 2001. IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MATC')GOTO11213 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'REPL')GOTO11214 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'EXPO'.AND.IHARG(4).EQ.'SMOO')GOTO11211 C IF(NUMARG.GE.3.AND.IHARG(3).EQ.'REVE')GOTO11208 IF(NUMARG.GE.3.AND.IHARG(3).EQ.'FLIP')GOTO11208 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'PROD')GOTO1208 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'INTE')GOTO1209 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CONV'.AND.IHARG2(3).EQ.'OLUT')GOTO1210 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'DECO'.AND.IHARG2(3).EQ.'NVOL')GOTO1211 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SORT'.AND.IHARG2(3).EQ.'C ')GOTO1212 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'FREQ'.AND.IHARG(4).EQ.'TO '.AND. 1IHARG(5).EQ.'RAW ')GOTO5190 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'FREQ'.AND.IHARG2(3).EQ.'UENC')GOTO1213 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SUMD'.AND.IHARG2(3).EQ.' ')GOTO1216 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'INTE'.AND.IHARG2(3).EQ.'RPOL')GOTO1217 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'INTE')GOTO1218 CCCCC FOLLOWING 8 LINES ADDED MAY, 1994. IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'INTE'.AND.IHARG2(4).NE.'RCEP') 1GOTO1219 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'2D '.AND.IHARG(4).EQ.'INTE')GOTO1249 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'BILI'.AND.IHARG(4).EQ.'INTE')GOTO1248 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'BIVA'.AND.IHARG(4).EQ.'INTE')GOTO1250 C IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'H ')GOTO1220 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'1 ')GOTO1221 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'2 ')GOTO1222 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'3 ')GOTO1223 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'4 ')GOTO1224 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'5 ')GOTO1225 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'6 ')GOTO1226 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'7 ')GOTO1227 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'8 ')GOTO1228 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'9 ')GOTO1229 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'10 ')GOTO1230 C IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'BIWE'.AND.IHARG2(3).EQ.'IGHT'.AND. 1IHARG(4).NE.'LOCA'.AND.IHARG(4).NE.'SCAL')GOTO1241 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'TRIC'.AND.IHARG2(3).EQ.'UBE')GOTO1242 C IF(NUMARG.GE.4.AND. 1IHARG(4).EQ.'FRAC'.AND.IHARG2(4).EQ.'TAL')GOTO1243 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SINE'.AND.IHARG(4).EQ.'TRAN')GOTO1251 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SIN'.AND.IHARG(4).EQ.'TRAN')GOTO1251 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'COSI'.AND.IHARG(4).EQ.'TRAN')GOTO1252 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'COS'.AND.IHARG(4).EQ.'TRAN')GOTO1252 C IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'FOUR'.AND.IHARG(5).EQ.'TRAN')GOTO1253 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'INVE'.AND.IHARG(5).EQ.'FOUR'.AND. 1IHARG(6).EQ.'TRAN')GOTO1254 IF(NUMARG.GE.4.AND. 1IHARG(4).EQ.'FFT '.AND.IHARG2(4).EQ.' ')GOTO1255 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'INVE'.AND.IHARG(5).EQ.'FFT')GOTO1256 C IF(NUMARG.GE.4.AND. 1IHARG(4).EQ.'BINN')GOTO5110 IF(NUMARG.GE.4.AND. 1IHARG(4).EQ.'BIN ')GOTO5110 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'FREQ'.AND.IHARG(5).EQ.'TABL')GOTO5112 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'RELA'.AND.IHARG(5).EQ.'BINN')GOTO5114 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'RELA'.AND.IHARG(5).EQ.'BIN ')GOTO5114 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'RELA'.AND.IHARG(5).EQ.'FREQ'.AND. 1IHARG(6).EQ.'TABL')GOTO5116 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LAPL'.AND.IHARG(4).EQ.'TRAN')GOTO1261 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'INVE'.AND.IHARG(4).EQ.'LAPL'.AND. 1IHARG(5).EQ.'TRAN')GOTO1262 C CCCCC THE FOLLOWING 6 LINES WERE ADDED JANUARY 1989 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'BOOT'.AND.IHARG(4).EQ.'SAMP')GOTO1271 CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT JANUARY 1990 CCCCC IF(NUMARG.GE.4.AND. CCCCC1IHARG(3).EQ.'RAND'.AND.IHARG(4).EQ.'SAMP')GOTO1271 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'JACK'.AND.IHARG(4).EQ.'SAMP')GOTO1271 C CCCCC THE FOLLOWING 6 LINES WERE ADDED JANUARY 1990 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SUBS')GOTO1272 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'RAND'.AND.IHARG(4).EQ.'SAMP')GOTO1273 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'RAND'.AND.IHARG(4).EQ.'SUBS')GOTO1273 CCCCC THE FOLLOWING 2 LINES WERE ADDED OCTOBER 1993 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'JACK'.AND.IHARG(4).EQ.'INDE')GOTO1274 C C *********************************************** C ** CHECK FOR COMPLEX ARITHMETIC SUBCASES ** C *********************************************** C IF(NUMARG.GE.5.AND.IHARG(4).EQ.'COMP')GOTO1010 GOTO1019 C 1010 CONTINUE IF(IHARG(5).EQ.'ADDI')GOTO2101 IF(IHARG(5).EQ.'SUBT')GOTO2102 IF(IHARG(5).EQ.'MULT')GOTO2103 IF(IHARG(5).EQ.'DIVI')GOTO2104 IF(IHARG(5).EQ.'EXPO')GOTO2105 IF(NUMARG.GE.6.AND. 1 IHARG(5).EQ.'SQUA'.AND.IHARG(6).EQ.'ROOT')GOTO2106 IF(IHARG(5).EQ.'ROOT')GOTO2107 IF(IHARG(5).EQ.'ZERO')GOTO2107 IF(IHARG(5).EQ.'CONJ')GOTO2108 1019 CONTINUE C C ************************************************** C ** CHECK FOR POLYNOMIAL ARITHMETIC SUBCASES ** C ************************************************** C IF(NUMARG.GE.4.AND.IHARG(3).EQ.'POLY')GOTO1020 IF(NUMARG.GE.5.AND.IHARG(4).EQ.'POLY'.AND. 1 IHARG(5).EQ.'DIVI')GOTO2204 GOTO1029 C 1020 CONTINUE IF(IHARG(4).EQ.'ADDI')GOTO2201 IF(IHARG(4).EQ.'SUBT')GOTO2202 IF(IHARG(4).EQ.'MULT')GOTO2203 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'SQUA'.AND.IHARG(5).NE.'ROOT')GOTO2205 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'SQUA'.AND.IHARG(5).EQ.'ROOT')GOTO2206 IF(IHARG(4).EQ.'GCD')GOTO2207 IF(IHARG(4).EQ.'LCM')GOTO2208 IF(IHARG(4).EQ.'EVAL')GOTO2209 IF(IHARG(4).EQ.'ADDI')GOTO2210 1029 CONTINUE C C ************************************************** C ** CHECK FOR VECTOR ARITHMETIC SUBCASES ** C ************************************************** C IF(NUMARG.GE.4.AND.IHARG(3).EQ.'VECT')GOTO1030 GOTO1039 C 1030 CONTINUE IF(IHARG(4).EQ.'ADDI')GOTO2301 IF(IHARG(4).EQ.'SUBT')GOTO2302 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'DOT'.AND.IHARG(5).EQ.'PROD')GOTO2303 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'INNE'.AND.IHARG(5).EQ.'PROD')GOTO2303 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'CROS'.AND.IHARG(5).EQ.'PROD')GOTO2304 IF(IHARG(4).EQ.'LENG')GOTO2305 IF(IHARG(4).EQ.'MAGN')GOTO2305 IF(IHARG(4).EQ.'DIST')GOTO2306 IF(IHARG(4).EQ.'ANGL')GOTO2307 1039 CONTINUE C C ************************************************** C ** CHECK FOR SET ARITHMETIC SUBCASES ** C ************************************************** C IF(NUMARG.GE.4.AND.IHARG(3).EQ.'SET ')GOTO1040 IF(NUMARG.GE.6.AND.IHARG(4).EQ.'SET '.AND. 1 IHARG(5).EQ.'CART'.AND.IHARG(6).EQ.'PROD')GOTO2405 GOTO1049 C 1040 CONTINUE IF(IHARG(4).EQ.'UNIO')GOTO2401 IF(IHARG(4).EQ.'ADDI')GOTO2401 IF(IHARG(4).EQ.'INTE')GOTO2402 IF(IHARG(4).EQ.'COMP')GOTO2403 IF(IHARG(4).EQ.'CARD')GOTO2404 IF(IHARG(4).EQ.'ELEM')GOTO2406 IF(IHARG(4).EQ.'DIST')GOTO2406 1049 CONTINUE C C ************************************************** C ** CHECK FOR LOGICAL ARITHMETIC SUBCASES ** C ************************************************** C IF(NUMARG.GE.4.AND.IHARG(3).EQ.'LOGI')GOTO1050 IF(NUMARG.GE.4.AND.IHARG(3).EQ.'BOOL')GOTO1050 GOTO1059 C 1050 CONTINUE IF(IHARG(4).EQ.'AND')GOTO2501 IF(IHARG(4).EQ.'CONJ')GOTO2501 IF(IHARG(4).EQ.'MULT')GOTO2501 IF(IHARG(4).EQ.'OR')GOTO2502 IF(IHARG(4).EQ.'DISJ')GOTO2502 IF(IHARG(4).EQ.'ADDI')GOTO2502 IF(IHARG(4).EQ.'NAND')GOTO2503 IF(IHARG(4).EQ.'NOR')GOTO2504 IF(IHARG(4).EQ.'IMPL')GOTO2505 IF(IHARG(4).EQ.'IFTH')GOTO2505 IF(IHARG(4).EQ.'EQUI')GOTO2506 IF(IHARG(4).EQ.'IFF')GOTO2506 IF(IHARG(4).EQ.'NOT')GOTO2507 IF(IHARG(4).EQ.'NEGA')GOTO2507 IF(IHARG(4).EQ.'COMP')GOTO2507 IF(IHARG(4).EQ.'XOR')GOTO2508 1059 CONTINUE C C ************************************************** C ** CHECK FOR MATRIX ARITHMETIC SUBCASES ** C ************************************************** C IF(NUMARG.GE.4.AND.IHARG(3).EQ.'MATR')GOTO1060 GOTO1065 C 1060 CONTINUE IF(IHARG(4).EQ.'ADDI')GOTO2601 IF(IHARG(4).EQ.'SUBT')GOTO2602 IF(IHARG(4).EQ.'MULT')GOTO2603 IF(IHARG(4).EQ.'SOLU')GOTO2604 IF(IHARG(4).EQ.'INVE')GOTO2605 IF(IHARG(4).EQ.'TRAN')GOTO2606 IF(IHARG(4).EQ.'ADJO')GOTO2607 IF(IHARG(4).EQ.'TRUN')GOTO2668 IF(IHARG(4).EQ.'LOWE'.AND.IHARG(5).EQ.'TRUN')GOTO2669 IF(IHARG(4).EQ.'UPPE'.AND.IHARG(5).EQ.'TRUN')GOTO2670 CCCCC OCTOBER 1993. ADD FOLLOWING LINE IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ITER'.AND.IHARG(5).EQ.'SOLU')GOTO2962 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'CHAR'.AND.IHARG(5).EQ.'EQUA')GOTO2608 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'CHAR'.AND.IHARG(5).EQ.'FUNC')GOTO2608 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'CHAR'.AND.IHARG(5).EQ.'POLY')GOTO2608 IF(IHARG(4).EQ.'EIGE'.AND.IHARG2(4).EQ.'NVAL')GOTO2609 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'CHAR'.AND.IHARG(5).EQ.'VALU')GOTO2610 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'LATE'.AND.IHARG(5).EQ.'ROOT')GOTO2610 IF(IHARG(4).EQ.'EIGE'.AND.IHARG2(4).EQ.'NVEC')GOTO2611 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'PRIN'.AND.IHARG(5).EQ.'AXES')GOTO2612 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'PRIN'.AND.IHARG(5).EQ.'AXIS')GOTO2612 IF(IHARG(4).EQ.'RANK')GOTO2613 IF(IHARG(4).EQ.'DETE')GOTO2614 IF(IHARG(4).EQ.'PERM')GOTO2615 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'SPEC'.AND.IHARG(5).EQ.'NORM')GOTO2616 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'SPEC'.AND.IHARG(5).EQ.'RADI')GOTO2617 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'ROWS')GOTO2618 IF(NUMARG.GE.6.AND. 1 IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'OF'.AND. 1 IHARG(6).EQ.'ROWS')GOTO2619 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'COLU')GOTO2620 IF(NUMARG.GE.6.AND. 1 IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'OF'.AND. 1 IHARG(6).EQ.'COLU')GOTO2621 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'SIMP'.AND.IHARG(5).EQ.'SOLU')GOTO2622 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'SIMP'.AND.IHARG(5).EQ.'METH')GOTO2622 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'LINE'.AND.IHARG(5).EQ.'PROG')GOTO2622 IF(NUMARG.GE.4.AND. 1 IHARG(4).EQ.'LP'.AND.IHARG2(4).EQ.' ')GOTO2623 IF(IHARG(4).EQ.'TRAC')GOTO2631 IF(IHARG(4).EQ.'SUBM')GOTO2632 IF(IHARG(4).EQ.'MINO')GOTO2633 IF(IHARG(4).EQ.'COFA')GOTO2634 IF(IHARG(4).EQ.'DEFI')GOTO2635 IF(NUMARG.GE.5.AND. 1 IHARG(4).EQ.'EUCL'.AND.IHARG(5).EQ.'NORM')GOTO2636 IF(IHARG(4).EQ.'NORM')GOTO2637 CCCCC OCTOBER 1993. ADD FOLLOWING LINES. IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'CHOL'.AND.IHARG(5).EQ.'DECO')GOTO2651 IF(IHARG(4).EQ.'CHOL')GOTO2652 IF(IHARG(4).EQ.'AUGM')GOTO2902 IF(IHARG(4).EQ.'DIAG')GOTO2912 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'REPL'.AND.IHARG(5).EQ.'ROW ')GOTO2922 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'REPL'.AND.IHARG(5).EQ.'ELEM')GOTO2932 CCCCC FOLLOWING SECTION AUGUST 1998. IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ADD '.AND.IHARG(5).EQ.'ROW ')GOTO5088 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'DELE'.AND.IHARG(5).EQ.'ROW ')GOTO5090 IF(NUMARG.GE.4.AND.IHARG(4).EQ.'MEAN')GOTO5092 IF(NUMARG.GE.4.AND.IHARG(4).EQ.'SUM ')GOTO5093 CCCCC END CHANGE CCCCC FOLLOWING SECTION SEPTEMBER 1998. IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GROU'.AND.IHARG(5).EQ.'MEAN')GOTO5102 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GROU'.AND.IHARG(5).EQ.'SD ')GOTO5104 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GROU'.AND.IHARG(5).EQ.'STAN'.AND. 1IHARG(6).EQ.'DEVI')GOTO5106 CCCCC JUNE 1998. ADD FOLLOWING LINES. IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MEAN')GOTO2992 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MIDM')GOTO3002 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MEDI')GOTO3012 IF(NUMARG.GE.8.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'TRIM'.AND. 1IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND. 1IHARG(8).EQ.'ERRO')GOTO3024 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'TRIM'.AND. 1IHARG(6).EQ.'MEAN')GOTO3022 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'MEAN')GOTO3032 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'HODG'.AND. 1IHARG(6).EQ.'LEHM')GOTO3034 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'LOCA')GOTO3036 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'SCAL')GOTO3038 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SUM ')GOTO3042 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'PROD')GOTO3045 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SD ')GOTO3052 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'STAN'.AND. 1IHARG(6).EQ.'DEVI')GOTO3062 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'MIDV')GOTO3063 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'PERC'.AND. 1IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO3064 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'VARI')GOTO3065 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'SD')GOTO3066 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO3067 IF(NUMARG.GE.8.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'STAN'.AND. 1IHARG(6).EQ.'DEVI'.AND.IHARG(7).EQ.'OF '.AND. 1IHARG(8).EQ.'MEAN')GOTO3072 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SD '.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'MEAN')GOTO3082 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'VARI')GOTO3092 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'VARI'.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'MEAN')GOTO3102 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'VARI')GOTO3112 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'SD ')GOTO3122 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO3132 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'COEF'.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'VARI')GOTO3142 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'AVER'.AND. 1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO3152 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MEDI'.AND. 1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO3162 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'RANG')GOTO3172 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MIDR')GOTO3182 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MAXI')GOTO3192 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MINI')GOTO3202 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'EXTR')GOTO3212 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'LOWE'.AND. 1IHARG(6).EQ.'HING')GOTO3222 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'UPPE'.AND. 1IHARG(6).EQ.'HING')GOTO3232 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'LOWE'.AND. 1IHARG(6).EQ.'QUAR')GOTO3242 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'UPPE'.AND. 1IHARG(6).EQ.'QUAR')GOTO3252 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SKEW')GOTO3262 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'KURT')GOTO3272 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'AUTO'.AND. 1IHARG2(5).EQ.'CORR')GOTO3282 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'AUTO'.AND. 1IHARG2(5).EQ.'COVA')GOTO3292 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'QUAN'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO3303 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'QUAN')GOTO3304 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CP')GOTO3311 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CPK')GOTO3312 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CPM')GOTO3313 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CPL')GOTO3314 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CPU')GOTO3315 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CNPK')GOTO3316 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CC')GOTO3317 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'PERC'.AND. 1IHARG(6).EQ.'DEFE')GOTO3318 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'EXPE'.AND. 1IHARG(6).EQ.'LOSS')GOTO3319 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'PERC')GOTO3321 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'HARM'.AND. 1IHARG(6).EQ.'MEAN')GOTO3322 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'MEAN')GOTO3323 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'SD')GOTO3324 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO3325 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'NORM'.AND. 1IHARG(6).EQ.'PPCC')GOTO3326 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'FIRS'.AND. 1IHARG(6).EQ.'DECI')GOTO3331 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SECO'.AND. 1IHARG(6).EQ.'DECI')GOTO3332 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'THIR'.AND. 1IHARG(6).EQ.'DECI')GOTO3333 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'FOUR'.AND. 1IHARG(6).EQ.'DECI')GOTO3334 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'FIFT'.AND. 1IHARG(6).EQ.'DECI')GOTO3335 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SIXT'.AND. 1IHARG(6).EQ.'DECI')GOTO3336 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SEVE'.AND. 1IHARG(6).EQ.'DECI')GOTO3337 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'EIGH'.AND. 1IHARG(6).EQ.'DECI')GOTO3338 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'NINT'.AND. 1IHARG(6).EQ.'DECI')GOTO3339 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN'.AND. 1IHARG(6).EQ.'SCAL')GOTO3354 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'QN'.AND. 1IHARG(6).EQ.'SCAL')GOTO3356 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN00')GOTO3341 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN0')GOTO3342 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN+')GOTO3343 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN-')GOTO3344 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN00')GOTO3346 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN0')GOTO3347 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN+')GOTO3348 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN-')GOTO3349 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SINE'.AND. 1IHARG(6).EQ.'FREQ')GOTO3351 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SIN'.AND. 1IHARG(6).EQ.'FREQ')GOTO3351 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SINE'.AND. 1IHARG(6).EQ.'AMPL')GOTO3352 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SIN'.AND. 1IHARG(6).EQ.'AMPL')GOTO3352 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SCAL')GOTO3302 C IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MEAN')GOTO3992 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MIDM')GOTO4002 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MEDI')GOTO4012 IF(NUMARG.GE.8.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TRIM'.AND. 1IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND. 1IHARG(8).EQ.'ERRO')GOTO4024 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TRIM'.AND. 1IHARG(6).EQ.'MEAN')GOTO4022 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'MEAN')GOTO4032 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'HODG'.AND. 1IHARG(6).EQ.'LEHM')GOTO4034 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'LOCA')GOTO4036 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'SCAL')GOTO4038 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SUM ')GOTO4042 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'PROD')GOTO4045 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SD ')GOTO4052 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'STAN'.AND. 1IHARG(6).EQ.'DEVI')GOTO4062 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'MIDV')GOTO4063 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'PERC'.AND. 1IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO4064 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'VARI')GOTO4065 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'SD')GOTO4066 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4067 IF(NUMARG.GE.8.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'STAN'.AND. 1IHARG(6).EQ.'DEVI'.AND.IHARG(7).EQ.'OF '.AND. 1IHARG(8).EQ.'MEAN')GOTO4072 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SD '.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'MEAN')GOTO4082 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'VARI')GOTO4092 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'VARI'.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'MEAN')GOTO4102 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'VARI')GOTO4112 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'SD ')GOTO4122 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4142 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'COEF'.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'VARI')GOTO4142 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'AVER'.AND. 1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO4152 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MEDI'.AND. 1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO4162 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'RANG')GOTO4172 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MIDR')GOTO4182 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MAXI')GOTO4192 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MINI')GOTO4202 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'EXTR')GOTO4212 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'LOWE'.AND. 1IHARG(6).EQ.'HING')GOTO4222 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'UPPE'.AND. 1IHARG(6).EQ.'HING')GOTO4232 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'LOWE'.AND. 1IHARG(6).EQ.'QUAR')GOTO4242 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'UPPE'.AND. 1IHARG(6).EQ.'QUAR')GOTO4252 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SKEW')GOTO4262 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'KURT')GOTO4272 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'AUTO'.AND. 1IHARG2(5).EQ.'CORR')GOTO4282 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'AUTO'.AND. 1IHARG2(5).EQ.'COVA')GOTO4292 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'QUAN'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO4302 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'QUAN')GOTO4304 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CP')GOTO4311 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CPK')GOTO4312 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CPM')GOTO4313 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CPL')GOTO4314 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CPU')GOTO4315 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CNPK')GOTO4316 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CC')GOTO4317 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'PERC'.AND. 1IHARG(6).EQ.'DEFE')GOTO4318 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'EXPE'.AND. 1IHARG(6).EQ.'LOSS')GOTO4319 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'PERC')GOTO4321 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'HARM'.AND. 1IHARG(6).EQ.'MEAN')GOTO4322 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'MEAN')GOTO4323 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'SD')GOTO4324 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4325 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'NORM'.AND. 1IHARG(6).EQ.'PPCC')GOTO4326 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'FIRS'.AND. 1IHARG(6).EQ.'DECI')GOTO4331 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SECO'.AND. 1IHARG(6).EQ.'DECI')GOTO4332 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'THIR'.AND. 1IHARG(6).EQ.'DECI')GOTO4333 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'FOUR'.AND. 1IHARG(6).EQ.'DECI')GOTO4334 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'FIFT'.AND. 1IHARG(6).EQ.'DECI')GOTO4335 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SIXT'.AND. 1IHARG(6).EQ.'DECI')GOTO4336 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SEVE'.AND. 1IHARG(6).EQ.'DECI')GOTO4337 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'EIGH'.AND. 1IHARG(6).EQ.'DECI')GOTO4338 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'NINT'.AND. 1IHARG(6).EQ.'DECI')GOTO4339 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN'.AND. 1IHARG(6).EQ.'SCAL')GOTO4354 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'QN'.AND. 1IHARG(6).EQ.'SCAL')GOTO4356 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN00')GOTO4341 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN0')GOTO4342 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN+')GOTO4343 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN-')GOTO4344 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN00')GOTO4346 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN0')GOTO4347 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN+')GOTO4348 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN-')GOTO4349 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SINE'.AND. 1IHARG(6).EQ.'FREQ')GOTO4351 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SIN'.AND. 1IHARG(6).EQ.'FREQ')GOTO4351 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SINE'.AND. 1IHARG(6).EQ.'AMPL')GOTO4352 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SIN'.AND. 1IHARG(6).EQ.'AMPL')GOTO4352 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SCAL')GOTO4302 C CCCCC JUNE 2005: MATRIX PARTITION IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MEAN')GOTO4500 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MIDM')GOTO4502 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MEDI')GOTO4512 IF(NUMARG.GE.8.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TRIM'.AND. 1IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND. 1IHARG(8).EQ.'ERRO')GOTO4524 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TRIM'.AND. 1IHARG(6).EQ.'MEAN')GOTO4522 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'MEAN')GOTO4532 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'HODG'.AND. 1IHARG(6).EQ.'LEHM')GOTO4534 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'LOCA')GOTO4536 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'SCAL')GOTO4538 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SUM ')GOTO4542 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'PROD')GOTO4545 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SD ')GOTO4552 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'STAN'.AND. 1IHARG(6).EQ.'DEVI')GOTO4562 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'MIDV')GOTO4563 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'PERC'.AND. 1IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO4564 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'VARI')GOTO4565 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'SD')GOTO4566 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4567 IF(NUMARG.GE.8.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'STAN'.AND. 1IHARG(6).EQ.'DEVI'.AND.IHARG(7).EQ.'OF '.AND. 1IHARG(8).EQ.'MEAN')GOTO4572 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SD '.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'MEAN')GOTO4582 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'VARI')GOTO4592 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'VARI'.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'MEAN')GOTO4602 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'VARI')GOTO4612 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'SD ')GOTO4622 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4652 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'COEF'.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'VARI')GOTO4652 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'AVER'.AND. 1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO4652 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MEDI'.AND. 1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO4662 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'RANG')GOTO4672 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MIDR')GOTO4682 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MAXI')GOTO4692 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MINI')GOTO4702 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'EXTR')GOTO4712 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'LOWE'.AND. 1IHARG(6).EQ.'HING')GOTO4722 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'UPPE'.AND. 1IHARG(6).EQ.'HING')GOTO4732 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'LOWE'.AND. 1IHARG(6).EQ.'QUAR')GOTO4742 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'UPPE'.AND. 1IHARG(6).EQ.'QUAR')GOTO4752 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SKEW')GOTO4762 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'KURT')GOTO4772 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'AUTO'.AND. 1IHARG2(5).EQ.'CORR')GOTO4782 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'AUTO'.AND. 1IHARG2(5).EQ.'COVA')GOTO4792 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'QUAN'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO4802 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'QUAN')GOTO4804 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CP')GOTO4811 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CPK')GOTO4812 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CPM')GOTO4813 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CPL')GOTO4814 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CPU')GOTO4815 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CNPK')GOTO4816 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CC')GOTO4817 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'PERC'.AND. 1IHARG(6).EQ.'DEFE')GOTO4818 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'EXPE'.AND. 1IHARG(6).EQ.'LOSS')GOTO4819 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'PERC')GOTO4821 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'HARM'.AND. 1IHARG(6).EQ.'MEAN')GOTO4822 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'MEAN')GOTO4823 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'SD')GOTO4824 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4825 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'NORM'.AND. 1IHARG(6).EQ.'PPCC')GOTO4826 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'FIRS'.AND. 1IHARG(6).EQ.'DECI')GOTO4831 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SECO'.AND. 1IHARG(6).EQ.'DECI')GOTO4832 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'THIR'.AND. 1IHARG(6).EQ.'DECI')GOTO4833 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'FOUR'.AND. 1IHARG(6).EQ.'DECI')GOTO4834 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'FIFT'.AND. 1IHARG(6).EQ.'DECI')GOTO4835 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SIXT'.AND. 1IHARG(6).EQ.'DECI')GOTO4836 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SEVE'.AND. 1IHARG(6).EQ.'DECI')GOTO4837 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'EIGH'.AND. 1IHARG(6).EQ.'DECI')GOTO4838 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'NINT'.AND. 1IHARG(6).EQ.'DECI')GOTO4839 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN'.AND. 1IHARG(6).EQ.'SCAL')GOTO4854 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'QN'.AND. 1IHARG(6).EQ.'SCAL')GOTO4856 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN00')GOTO4851 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN0')GOTO4852 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN+')GOTO4843 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN-')GOTO4844 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN00')GOTO4846 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN0')GOTO4847 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN+')GOTO4848 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN-')GOTO4849 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SINE'.AND. 1IHARG(6).EQ.'FREQ')GOTO4851 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SIN'.AND. 1IHARG(6).EQ.'FREQ')GOTO4851 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SINE'.AND. 1IHARG(6).EQ.'AMPL')GOTO4852 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SIN'.AND. 1IHARG(6).EQ.'AMPL')GOTO4852 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SCAL')GOTO4802 C CCCCC JUNE 2005: MATRIX GRAND IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MEAN')GOTO6500 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MIDM')GOTO6502 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MEDI')GOTO6512 IF(NUMARG.GE.8.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TRIM'.AND. 1IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND. 1IHARG(8).EQ.'ERRO')GOTO6524 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TRIM'.AND. 1IHARG(6).EQ.'MEAN')GOTO6522 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'MEAN')GOTO6532 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'HODG'.AND. 1IHARG(6).EQ.'LEHM')GOTO6534 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'LOCA')GOTO6536 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'SCAL')GOTO6538 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SUM ')GOTO6542 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'PROD')GOTO6545 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SD ')GOTO6552 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'STAN'.AND. 1IHARG(6).EQ.'DEVI')GOTO6562 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'BIWE'.AND. 1IHARG(6).EQ.'MIDV')GOTO6563 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'PERC'.AND. 1IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO6564 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'VARI')GOTO6565 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'SD')GOTO6566 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'WINS'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO6567 IF(NUMARG.GE.8.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'STAN'.AND. 1IHARG(6).EQ.'DEVI'.AND.IHARG(7).EQ.'OF '.AND. 1IHARG(8).EQ.'MEAN')GOTO6572 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SD '.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'MEAN')GOTO6582 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'VARI')GOTO6592 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'VARI'.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'MEAN')GOTO6602 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'VARI')GOTO6612 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'SD ')GOTO6622 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO6652 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'COEF'.AND. 1IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'VARI')GOTO6652 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'AVER'.AND. 1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO6652 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MEDI'.AND. 1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO6662 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'RANG')GOTO6672 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MIDR')GOTO6682 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MAXI')GOTO6692 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MINI')GOTO6702 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'EXTR')GOTO6712 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'LOWE'.AND. 1IHARG(6).EQ.'HING')GOTO6722 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'UPPE'.AND. 1IHARG(6).EQ.'HING')GOTO6732 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'LOWE'.AND. 1IHARG(6).EQ.'QUAR')GOTO6742 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'UPPE'.AND. 1IHARG(6).EQ.'QUAR')GOTO6752 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SKEW')GOTO6762 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'KURT')GOTO6772 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'AUTO'.AND. 1IHARG2(5).EQ.'CORR')GOTO6782 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'AUTO'.AND. 1IHARG2(5).EQ.'COVA')GOTO6792 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'QUAN'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO6802 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'QUAN')GOTO6804 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CP')GOTO6811 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CPK')GOTO6812 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CPM')GOTO6813 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CPL')GOTO6814 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CPU')GOTO6815 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CNPK')GOTO6816 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CC')GOTO6817 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'PERC'.AND. 1IHARG(6).EQ.'DEFE')GOTO6818 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'EXPE'.AND. 1IHARG(6).EQ.'LOSS')GOTO6819 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'PERC')GOTO6821 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'HARM'.AND. 1IHARG(6).EQ.'MEAN')GOTO6822 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'MEAN')GOTO6823 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'SD')GOTO6824 IF(NUMARG.GE.7.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'GEOM'.AND. 1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO6825 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'NORM'.AND. 1IHARG(6).EQ.'PPCC')GOTO6826 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'FIRS'.AND. 1IHARG(6).EQ.'DECI')GOTO6831 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SECO'.AND. 1IHARG(6).EQ.'DECI')GOTO6832 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'THIR'.AND. 1IHARG(6).EQ.'DECI')GOTO6833 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'FOUR'.AND. 1IHARG(6).EQ.'DECI')GOTO6834 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'FIFT'.AND. 1IHARG(6).EQ.'DECI')GOTO6835 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SIXT'.AND. 1IHARG(6).EQ.'DECI')GOTO6836 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SEVE'.AND. 1IHARG(6).EQ.'DECI')GOTO6837 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'EIGH'.AND. 1IHARG(6).EQ.'DECI')GOTO6838 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'NINT'.AND. 1IHARG(6).EQ.'DECI')GOTO6839 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN'.AND. 1IHARG(6).EQ.'SCAL')GOTO6854 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'QN'.AND. 1IHARG(6).EQ.'SCAL')GOTO6856 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN00')GOTO6851 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN0')GOTO6852 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN+')GOTO6843 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TAGU'.AND. 1IHARG(6).EQ.'SN-')GOTO6844 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN00')GOTO6846 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN0')GOTO6847 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN+')GOTO6848 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN-')GOTO6849 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SINE'.AND. 1IHARG(6).EQ.'FREQ')GOTO6851 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SIN'.AND. 1IHARG(6).EQ.'FREQ')GOTO6851 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SINE'.AND. 1IHARG(6).EQ.'AMPL')GOTO6852 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SIN'.AND. 1IHARG(6).EQ.'AMPL')GOTO6852 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SCAL')GOTO6802 C CCCCC END CHANGE CCCCC SEPTEMBER 1993. ADD FOLLOWING LINES. IF(IHARG(4).EQ.'ROW ')GOTO2649 IF(IHARG(4).EQ.'ELEM')GOTO2650 CCCCC END CHANGE 1065 CONTINUE IF(NUMARG.GE.5.AND.IHARG(3).EQ.'VARI'.AND. 1 IHARG(4).EQ.'COVA'.AND.IHARG(5).EQ.'MATR')GOTO2641 IF(NUMARG.GE.4.AND.IHARG(3).EQ.'CORR'.AND. 1 IHARG(4).EQ.'MATR')GOTO2642 C IF(NUMARG.GE.5.AND.IHARG(3).EQ.'PRIN'.AND. 1 IHARG(4).EQ.'COMP'.AND. 1 IHARG(5).EQ.'EIGE'.AND.IHARG2(5).EQ.'NVEC')GOTO2643 IF(NUMARG.GE.5.AND.IHARG(3).EQ.'PRIN'.AND. 1 IHARG(4).EQ.'COMP'.AND. 1 IHARG(5).EQ.'EIGE'.AND.IHARG2(5).EQ.'NVAL')GOTO2644 IF(NUMARG.GE.4.AND.IHARG(3).EQ.'PRIN'.AND. 1 IHARG(4).EQ.'COMP')GOTO2645 C IF(NUMARG.GE.6.AND.IHARG(4).EQ.'PRIN'.AND. 1 IHARG(5).EQ.'COMP'.AND. 1 IHARG(6).EQ.'EIGE'.AND.IHARG2(6).EQ.'NVEC')GOTO2653 IF(NUMARG.GE.6.AND.IHARG(4).EQ.'PRIN'.AND. 1 IHARG(5).EQ.'COMP'.AND. 1 IHARG(6).EQ.'EIGE'.AND.IHARG2(6).EQ.'NVAL')GOTO2654 IF(NUMARG.GE.5.AND.IHARG(4).EQ.'PRIN'.AND. 1 IHARG(5).EQ.'COMP')GOTO2655 C IF(IHARG(3).EQ.'EIGE'.AND.IHARG2(3).EQ.'NVEC')GOTO2661 IF(IHARG(3).EQ.'EIGE'.AND.IHARG2(3).EQ.'NVAL')GOTO2662 CCCCC JULY 1993. FOLLOWING LINES ADDED FOR MATRIX SINGULAR VALUES AND CCCCC MATRIX SINGULAR VALUE DECOMPOSITION. IF(NUMARG.GE.7.AND. 1 IHARG(5).EQ.'SING'.AND.IHARG(6).EQ.'VALU'.AND. 1 IHARG(7).EQ.'DECO')GOTO2646 IF(NUMARG.GE.7.AND. 1 IHARG(5).EQ.'SING'.AND.IHARG(6).EQ.'VALU'.AND. 1 IHARG(7).EQ.'FACT')GOTO2648 IF(NUMARG.GE.4.AND. 1 IHARG(3).EQ.'SING'.AND.IHARG(4).EQ.'VALU')GOTO2647 CCCCC OCTOBER 1993. ADD FOLLOWING LINES. IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CHOL'.AND.IHARG(4).EQ.'DECO')GOTO2652 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CHOL')GOTO2666 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'DIAG'.AND.IHARG(4).EQ.'MATR')GOTO2942 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TRID'.AND.IHARG(4).EQ.'SOLV')GOTO2952 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TRID'.AND.IHARG(4).EQ.'SOLU')GOTO2952 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TRIA'.AND.IHARG(4).EQ.'SOLV')GOTO2972 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TRIA'.AND.IHARG(4).EQ.'SOLU')GOTO2972 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TRIA'.AND.IHARG(4).EQ.'INVE')GOTO2982 CCCCC END CHANGE CCCCC JUNE 1998. ADD FOLLOWING LINES. IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'PSUE'.AND.IHARG(4).EQ.'INVE')GOTO5002 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'QUAD'.AND.IHARG(4).EQ.'FORM')GOTO5012 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'COMB')GOTO5096 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'VECT'.AND.IHARG(4).EQ.'TIME'.AND. 1IHARG(5).EQ.'TRAN')GOTO5098 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'1 '.AND. 1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'T2 ')GOTO5022 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'1 '.AND. 1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'TSQU')GOTO5022 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'ONE '.AND. 1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'TSQU')GOTO5022 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'ONE '.AND. 1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'T2 ')GOTO5022 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'2 '.AND. 1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'TSQU')GOTO5023 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'2 '.AND. 1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'T2 ')GOTO5023 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'TWO '.AND. 1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'TSQU')GOTO5023 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'TWO '.AND. 1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'T2 ')GOTO5023 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'EUCL'.AND.IHARG(4).EQ.'ROW '.AND. 1IHARG(5).EQ.'DIST')GOTO5032 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'EUCL'.AND.IHARG(4).EQ.'COLU'.AND. 1IHARG(5).EQ.'DIST')GOTO5034 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'MAHA'.AND.IHARG(4).EQ.'ROW '.AND. 1IHARG(5).EQ.'DIST')GOTO5042 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'MAHA'.AND.IHARG(4).EQ.'COLU'.AND. 1IHARG(5).EQ.'DIST')GOTO5044 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'MINK'.AND.IHARG(4).EQ.'ROW '.AND. 1IHARG(5).EQ.'DIST')GOTO5062 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'MINK'.AND.IHARG(4).EQ.'COLU'.AND. 1IHARG(5).EQ.'DIST')GOTO5064 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'BLOC'.AND.IHARG(4).EQ.'ROW '.AND. 1IHARG(5).EQ.'DIST')GOTO5072 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'BLOC'.AND.IHARG(4).EQ.'COLU'.AND. 1IHARG(5).EQ.'DIST')GOTO5074 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'CHEB'.AND.IHARG(4).EQ.'ROW '.AND. 1IHARG(5).EQ.'DIST')GOTO5082 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'CHEB'.AND.IHARG(4).EQ.'COLU'.AND. 1IHARG(5).EQ.'DIST')GOTO5084 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'POOL'.AND.IHARG(4).EQ.'VARI'.AND. 1IHARG(5).EQ.'COVA'.AND.IHARG(6).EQ.'MATR')GOTO5086 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'POOL'.AND.IHARG(4).EQ.'COVA'.AND. 1IHARG(5).EQ.'MATR')GOTO5087 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'QR '.AND.IHARG(4).EQ.'DECO')GOTO5052 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'DIST'.AND.IHARG(4).EQ.'FROM'.AND. 1IHARG(5).EQ.'MEAN')GOTO5094 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'NORM'.AND. 1IHARG(5).EQ.'RAND'.AND.IHARG(6).EQ.'NUMB')GOTO5118 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'T '.AND. 1IHARG(5).EQ.'RAND'.AND.IHARG(6).EQ.'NUMB')GOTO5119 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CATC'.AND.IHARG(4).EQ.'MATR')GOTO5120 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'RAND'.AND. 1IHARG(5).EQ.'NUMB')GOTO5122 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'PDF')GOTO5123 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'WISH'.AND.IHARG(4).EQ.'RAND'.AND. 1IHARG(5).EQ.'NUMB')GOTO5124 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'DIRI'.AND.IHARG(4).EQ.'RAND'.AND. 1IHARG(5).EQ.'NUMB')GOTO5125 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'DIRI'.AND.IHARG(4).EQ.'PDF')GOTO15125 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'DIRI'.AND.IHARG(4).EQ.'LOG'.AND. 1IHARG(5).EQ.'PDF')GOTO15127 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'INFL'.AND. 1IHARG(5).EQ.'FACT')GOTO5126 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'COND'.AND.IHARG(4).EQ.'INDI')GOTO5128 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'XTXI'.AND.IHARG(4).EQ.'MATR')GOTO5130 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CREA'.AND.IHARG(4).EQ.'MATR')GOTO5132 CCCCC END CHANGE IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'WINS')GOTO5152 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'NORM'.AND. 1IHARG(5).EQ.'CDF')GOTO5154 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'T'.AND. 1IHARG(5).EQ.'CDF')GOTO5156 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'INDE'.AND.IHARG(4).EQ.'UNIF'.AND. 1IHARG(5).EQ.'RAND'.AND.IHARG(6).EQ.'NUMB')GOTO5158 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'CORR'.AND.IHARG(4).EQ.'UNIF'.AND. 1IHARG(5).EQ.'RAND'.AND.IHARG(6).EQ.'NUMB')GOTO5160 C IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'MATR'.AND.IHARG(5)(1:3).EQ.'BIN')GOTO5197 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'MATR'.AND.IHARG(5).EQ.'COUN'.AND. 1IHARG(6)(1:3).EQ.'BIN')GOTO5198 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'MATR'.AND.IHARG(5).EQ.'RELA'.AND. 1IHARG(6)(1:3).EQ.'BIN')GOTO5199 C CCCCC OCTOBER 2004. ADD FOLLOWING SECTION. IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'ASH '.AND.IHARG(5)(1:3).EQ.'BIN')GOTO5192 IF(NUMARG.GE.4.AND.IHARG(4).EQ.'ASH ')GOTO5193 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'COUN'.AND.IHARG(5).EQ.'ASH '.AND. 1IHARG(6)(1:3).EQ.'BIN')GOTO5194 IF(NUMARG.GE.7.AND. 1IHARG(5).EQ.'COMB'.AND.IHARG(6).EQ.'FREQ'.AND. 1IHARG(7).EQ.'TABL')GOTO5196 IF(NUMARG.GE.7.AND. 1IHARG(5).EQ.'INTE'.AND.IHARG(6).EQ.'FREQ'.AND. 1IHARG(7).EQ.'TABL')GOTO5195 C CCCCC FEBRAURY 2005. ADD FOLLOWING SECTION. IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'H '.AND.IHARG(4).EQ.'CONS'.AND. 1IHARG(5).EQ.'STAT')GOTO5202 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'H '.AND.IHARG(4).EQ.'CONS')GOTO5203 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'K '.AND.IHARG(4).EQ.'CONS'.AND. 1IHARG(5).EQ.'STAT')GOTO5204 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'K '.AND.IHARG(4).EQ.'CONS')GOTO5205 C IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'H '.AND.IHARG(5).EQ.'CONS'.AND. 1IHARG(6).EQ.'STAT')GOTO5206 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'H '.AND.IHARG(5).EQ.'CONS')GOTO5207 IF(NUMARG.GE.6.AND. 1IHARG(4).EQ.'K '.AND.IHARG(5).EQ.'CONS'.AND. 1IHARG(6).EQ.'STAT')GOTO5208 IF(NUMARG.GE.5.AND. 1IHARG(4).EQ.'K '.AND.IHARG(5).EQ.'CONS')GOTO5209 C CCCCC JUNE 2005. ADD FOLLOWING SECTION. IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'L '.AND.IHARG(4).EQ.'MOME')GOTO5211 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'PROB'.AND.IHARG(4).EQ.'WEIG'.AND. 1IHARG(5).EQ.'MOME')GOTO5213 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'BETA'.AND. 1IHARG(4).EQ.'PROB'.AND.IHARG(5).EQ.'WEIG'.AND. 1IHARG(6).EQ.'MOME')GOTO5215 C 1069 CONTINUE C CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1989 C ************************************************** C ** CHECK FOR (DEX) GENERATOR ARITHMETIC SUBCASES ** C ************************************************** C IF(NUMARG.GE.4.AND.IHARG(3).EQ.'GENE')GOTO1070 GOTO1079 C 1070 CONTINUE IF(IHARG(4).EQ.'ADDI')GOTO2701 IF(IHARG(4).EQ.'SUBT')GOTO2702 IF(IHARG(4).EQ.'MULT')GOTO2703 1079 CONTINUE C CCCCC THE FOLLOWING 4 LINES WERE ADDED JULY 1991 C ************************ C ** CHECK FOR COCODE (= CORANK) C ************************ C IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'COCO'.AND.IHARG2(3).EQ.'DE ')GOTO2801 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'COCO'.AND.IHARG2(3).EQ.'DED ')GOTO2801 CCCCC THE FOLLOWING 4 LINES WERE ADDED OCTOBER 1991 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CORA'.AND.IHARG2(3).EQ.'NK ')GOTO2801 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CORA'.AND.IHARG2(3).EQ.'NKED')GOTO2801 C CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1991 C ************************ C ** CHECK FOR COCOPY C ************************ C IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'COCO'.AND.IHARG2(3).EQ.'PY ')GOTO2802 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'COCO'.AND.IHARG2(3).EQ.'PIED')GOTO2802 C C ************************************** C ** CHECK FOR CUSUM ARL ** C ** CHECK FOR ONE-SIDED CUSUM ARL ** C ** CHECK FOR TWO-SIDED CUSUM ARL ** C ************************************** IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CUSU'.AND.IHARG(4).EQ.'ARL ')GOTO2806 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'TWO'.AND.IHARG(4).EQ.'SIDE'.AND. 1IHARG(5).EQ.'CUSU'.AND.IHARG(6).EQ.'ARL ')GOTO2808 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'2'.AND.IHARG(4).EQ.'SIDE'.AND. 1IHARG(5).EQ.'CUSU'.AND.IHARG(6).EQ.'ARL ')GOTO2808 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'ONE'.AND.IHARG(4).EQ.'SIDE'.AND. 1IHARG(5).EQ.'CUSU'.AND.IHARG(6).EQ.'ARL ')GOTO2810 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'1'.AND.IHARG(4).EQ.'SIDE'.AND. 1IHARG(5).EQ.'CUSU'.AND.IHARG(6).EQ.'ARL ')GOTO2810 C C ************************************** C ** CHECK FOR STANDARDIZE ** C ** CHECK FOR LOCATION STANDARDIZE** C ** CHECK FOR ZSCORE STANDARDIZE ** C ** CHECK FOR ZSCORE ** C ** CHECK FOR USCORE ** C ************************************** C IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'STAN')GOTO2812 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'ZSCO')GOTO2818 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'USCO')GOTO2820 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'ZSCO'.AND.IHARG(4).EQ.'STAN')GOTO2814 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LOCA'.AND.IHARG(4).EQ.'STAN')GOTO2816 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SCAL'.AND.IHARG(4).EQ.'STAN')GOTO2822 C IF(NUMARG.GE.4.AND. 1IHARG(4).EQ.'STAC')GOTO2824 IF(NUMARG.GE.6.AND. 1IHARG(5).EQ.'REPL'.AND.IHARG(6).EQ.'STAC')GOTO2825 C C ************************************** C ** CHECK FOR CROSS TABULATE ** C ** ** C ************************************** C CCCCC SEPTEMBER 2001: CROSS TABULATE CCCCC AUGUST 2002: ADD ADDITIONAL STATISTICS, ALSO SET CCCCC ICASS7 FOR SUBSEQUENT USE IN DPMATC, DPMAT2 C IF(NUMARG.GE.4.AND.IHARG(3).EQ.'CROS'.AND.IHARG(4).EQ.'TABU')THEN IF(IHARG(5).EQ.'MEAN')GOTO2832 IF(IHARG(5).EQ.'MIDM')GOTO2834 IF(IHARG(5).EQ.'MEDI'.AND. 1 IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO2868 IF(IHARG(5).EQ.'MAD')GOTO2869 IF(IHARG(5).EQ.'SN'.AND.IHARG(6).EQ.'SCAL')GOTO12962 IF(IHARG(5).EQ.'QN'.AND.IHARG(6).EQ.'SCAL')GOTO12964 IF(IHARG(5).EQ.'MEDI')GOTO2836 IF(IHARG(5).EQ.'TRIM'.AND. 1 IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND. 1 IHARG(8).EQ.'ERRO')GOTO12908 IF(IHARG(5).EQ.'TRIM'.AND.IHARG(6).EQ.'MEAN')GOTO2838 IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'MEAN')GOTO2840 IF(IHARG(5).EQ.'SUM ')GOTO2842 IF(IHARG(5).EQ.'PROD')GOTO2844 IF(IHARG(5).EQ.'SD ')GOTO2846 IF(IHARG(5).EQ.'STAN'.AND.IHARG(6).EQ.'DEVI')GOTO2848 IF(IHARG(5).EQ.'STAN'.AND.IHARG(6).EQ.'DEVI'.AND. 1 IHARG(7).EQ.'OF '.AND.IHARG(8).EQ.'MEAN')GOTO2850 IF(IHARG(5).EQ.'SD '.AND. 1 IHARG(6).EQ.'OF '.AND.IHARG(7).EQ.'MEAN')GOTO2852 IF(IHARG(5).EQ.'VARI'.AND.IHARG(6).EQ.'OF '.AND. 1 IHARG(7).EQ.'MEAN')GOTO2856 IF(IHARG(5).EQ.'VARI')GOTO2854 IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'VARI')GOTO2858 IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'SD ')GOTO2860 IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'STAN'.AND. 1 IHARG(7).EQ.'DEVI')GOTO2862 IF(IHARG(5).EQ.'COEF'.AND.IHARG(6).EQ.'OF '.AND. 1 IHARG(7).EQ.'VARI')GOTO2864 IF(IHARG(5).EQ.'AVER'.AND.IHARG(6).EQ.'ABSO'.AND. 1 IHARG(7).EQ.'DEVI')GOTO2866 IF(IHARG(5).EQ.'RANG')GOTO2870 IF(IHARG(5).EQ.'MIDR')GOTO2872 IF(IHARG(5).EQ.'MAXI')GOTO2874 IF(IHARG(5).EQ.'MINI')GOTO2876 IF(IHARG(5).EQ.'EXTR')GOTO2878 C IF(IHARG(5).EQ.'LOWE'.AND.IHARG(6).EQ.'HING')GOTO2880 IF(IHARG(5).EQ.'UPPE'.AND.IHARG(6).EQ.'HING')GOTO2882 IF(IHARG(5).EQ.'LOWE'.AND.IHARG(6).EQ.'QUAR')GOTO2884 IF(IHARG(5).EQ.'UPPE'.AND.IHARG(6).EQ.'QUAR')GOTO2886 IF(IHARG(5).EQ.'SKEW')GOTO2888 IF(IHARG(5).EQ.'KURT')GOTO2890 IF(IHARG(5).EQ.'AUTO'.AND.IHARG2(5).EQ.'CORR')GOTO2892 IF(IHARG(5).EQ.'AUTO'.AND.IHARG2(5).EQ.'COVA')GOTO2894 IF(IHARG(5).EQ.'INTE'.AND.IHARG(6).EQ.'RANG')GOTO2896 IF(IHARG(5).EQ.'IQ '.AND.IHARG(6).EQ.'RANG')GOTO2896 IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'LOCA')GOTO2898 IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'SCAL')GOTO2899 IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'MIDV')GOTO12900 IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'SD')GOTO12901 IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'STAN'.AND. 1 IHARG(7).EQ.'DEVI')GOTO12902 IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'VARI')GOTO12903 IF(IHARG(5).EQ.'PERC'.AND. 1 IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO12904 IF(IHARG(5).EQ.'HODG'.AND.IHARG(6).EQ.'LEHM')GOTO12905 IF(IHARG(5).EQ.'QUAN'.AND. 1 IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO12906 IF(IHARG(5).EQ.'QUAN')GOTO12907 IF(IHARG(5).EQ.'CP')GOTO12911 IF(IHARG(5).EQ.'CPK')GOTO12912 IF(IHARG(5).EQ.'CPM')GOTO12913 IF(IHARG(5).EQ.'CPL')GOTO12914 IF(IHARG(5).EQ.'CPU')GOTO12915 IF(IHARG(5).EQ.'CNPK')GOTO12916 IF(IHARG(5).EQ.'CC')GOTO12917 IF(IHARG(5).EQ.'PERC'.AND.IHARG(6).EQ.'DEFE')GOTO12918 IF(IHARG(5).EQ.'EXPE'.AND.IHARG(6).EQ.'LOSS')GOTO12919 IF(IHARG(5).EQ.'PERC')GOTO12921 IF(IHARG(5).EQ.'HARM'.AND.IHARG(6).EQ.'MEAN')GOTO12922 IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'MEAN')GOTO12923 IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'SD')GOTO12924 IF(IHARG(5).EQ.'GEOM'.AND. 1 IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO12925 IF(IHARG(5).EQ.'NORM'.AND.IHARG(6).EQ.'PPCC')GOTO12926 IF(IHARG(5).EQ.'FIRS'.AND.IHARG(6).EQ.'DECI')GOTO12931 IF(IHARG(5).EQ.'SECO'.AND.IHARG(6).EQ.'DECI')GOTO12932 IF(IHARG(5).EQ.'THIR'.AND.IHARG(6).EQ.'DECI')GOTO12933 IF(IHARG(5).EQ.'FOUR'.AND.IHARG(6).EQ.'DECI')GOTO12934 IF(IHARG(5).EQ.'FIFT'.AND.IHARG(6).EQ.'DECI')GOTO12935 IF(IHARG(5).EQ.'SIXT'.AND.IHARG(6).EQ.'DECI')GOTO12936 IF(IHARG(5).EQ.'SEVE'.AND.IHARG(6).EQ.'DECI')GOTO12937 IF(IHARG(5).EQ.'EIGH'.AND.IHARG(6).EQ.'DECI')GOTO12938 IF(IHARG(5).EQ.'NINT'.AND.IHARG(6).EQ.'DECI')GOTO12939 IF(IHARG(5).EQ.'TAGU'.AND.IHARG(6).EQ.'SN00')GOTO12941 IF(IHARG(5).EQ.'TAGU'.AND.IHARG(6).EQ.'SN0')GOTO12942 IF(IHARG(5).EQ.'TAGU'.AND.IHARG(6).EQ.'SN+')GOTO12943 IF(IHARG(5).EQ.'TAGU'.AND.IHARG(6).EQ.'SN-')GOTO12944 IF(IHARG(5).EQ.'SN00')GOTO12946 IF(IHARG(5).EQ.'SN0')GOTO12947 IF(IHARG(5).EQ.'SN+')GOTO12948 IF(IHARG(5).EQ.'SN-')GOTO12949 IF(IHARG(5).EQ.'SINE'.AND.IHARG(6).EQ.'FREQ')GOTO12951 IF(IHARG(5).EQ.'SIN'.AND.IHARG(6).EQ.'FREQ')GOTO12951 IF(IHARG(5).EQ.'SINE'.AND.IHARG(6).EQ.'AMPL')GOTO12952 IF(IHARG(5).EQ.'SIN'.AND.IHARG(6).EQ.'AMPL')GOTO12952 IF(IHARG(5).EQ.'WEIG'.AND.IHARG(6).EQ.'MEAN')GOTO12954 IF(IHARG(5).EQ.'WEIG'.AND.IHARG(6).EQ.'VARI')GOTO12956 IF(IHARG(5).EQ.'WEIG'.AND.IHARG(6).EQ.'SD')GOTO12958 IF(IHARG(5).EQ.'WEIG'.AND.IHARG(6).EQ.'STAN'.AND. 1 IHARG(7).EQ.'DEVI')GOTO12960 IF(IHARG(5).EQ.'RATI')GOTO12961 C C IMPLEMENT "DIFFERENCE OF" STATISTICS C IF(NUMARG.GE.6.AND. 1 IHARG(5).EQ.'DIFF'.AND.IHARG(6).EQ.'OF')THEN IF(IHARG(7).EQ.'MEAN' .OR. IHARG(7).EQ.'AVER')GOTO12501 IF(IHARG(7).EQ.'MIDM')GOTO12502 IF(IHARG(7).EQ.'MEDI')GOTO12503 IF(IHARG(7).EQ.'TRIM'.AND.IHARG(8).EQ.'MEAN')GOTO12504 IF(IHARG(7).EQ.'WINS'.AND.IHARG(8).EQ.'MEAN')GOTO12505 IF(IHARG(7).EQ.'GEOM'.AND.IHARG(8).EQ.'MEAN')GOTO12506 IF(IHARG(7).EQ.'HARM'.AND.IHARG(8).EQ.'MEAN')GOTO12507 IF(IHARG(7).EQ.'HODG'.AND.IHARG(8).EQ.'LEHM')GOTO12508 IF(IHARG(7).EQ.'BIWE'.AND.IHARG(8).EQ.'LOCA')GOTO12509 IF(IHARG(7).EQ.'SD')GOTO12520 IF(IHARG(7).EQ.'STAN'.AND.IHARG(8).EQ.'DEVI')GOTO12521 IF(IHARG(7).EQ.'VARI')GOTO12522 IF(IHARG(7).EQ.'AVER'.AND.IHARG(8).EQ.'ABSO'.AND. 1 IHARG(9).EQ.'DEVI')GOTO12623 IF(IHARG(7).EQ.'AAD')GOTO12523 IF(IHARG(7).EQ.'MEDI'.AND.IHARG(8).EQ.'ABSO'.AND. 1 IHARG(9).EQ.'DEVI')GOTO12624 IF(IHARG(7).EQ.'MAD')GOTO12524 IF(IHARG(7).EQ.'INTE'.AND.IHARG(8).EQ.'RANG')GOTO12525 IF(IHARG(7).EQ.'IQ '.AND.IHARG(8).EQ.'RANG')GOTO12525 IF(IHARG(7).EQ.'WINS'.AND.IHARG(8).EQ.'SD')GOTO12526 IF(IHARG(7).EQ.'WINS'.AND.IHARG(8).EQ.'VARI')GOTO12527 IF(IHARG(7).EQ.'BIWE'.AND.IHARG(8).EQ.'MIDV')GOTO12528 IF(IHARG(7).EQ.'BIWE'.AND.IHARG(8).EQ.'SCAL')GOTO12529 IF(IHARG(7).EQ.'PERC'.AND.IHARG(8).EQ.'BEND'.AND. 1 IHARG(9).EQ.'MIDV')GOTO12530 IF(IHARG(7).EQ.'GEOM'.AND.IHARG(8).EQ.'SD')GOTO12531 IF(IHARG(7).EQ.'RANG')GOTO12532 IF(IHARG(7).EQ.'MIDR')GOTO12533 IF(IHARG(7).EQ.'QUAN')GOTO12534 IF(IHARG(7).EQ.'SKEW')GOTO12535 IF(IHARG(7).EQ.'KURT')GOTO12536 IF(IHARG(7).EQ.'RELA'.AND.IHARG(8).EQ.'SD')GOTO12537 IF(IHARG(7).EQ.'SD'.AND.IHARG(8).EQ.'OF'.AND. 1 IHARG(9).EQ.'THE'.AND.IHARG(10).EQ.'MEAN')GOTO12738 IF(IHARG(7).EQ.'SD'.AND.IHARG(8).EQ.'OF'.AND. 1 IHARG(9).EQ.'MEAN')GOTO12638 IF(IHARG(7).EQ.'SD'.AND.IHARG(8).EQ.'MEAN')GOTO12538 IF(IHARG(7).EQ.'RELA'.AND.IHARG(8).EQ.'VARI')GOTO12539 IF(IHARG(7).EQ.'VARI'.AND.IHARG(8).EQ.'OF'.AND. 1 IHARG(9).EQ.'THE'.AND.IHARG(10).EQ.'MEAN')GOTO12740 IF(IHARG(7).EQ.'VARI'.AND.IHARG(8).EQ.'OF'.AND. 1 IHARG(9).EQ.'MEAN')GOTO12640 IF(IHARG(7).EQ.'VARI'.AND.IHARG(8).EQ.'MEAN')GOTO12540 IF(IHARG(7).EQ.'MINI')GOTO12541 IF(IHARG(7).EQ.'MAXI')GOTO12542 IF(IHARG(7).EQ.'EXTR')GOTO12543 IF(IHARG(7).EQ.'COEF'.AND.IHARG(8).EQ.'OF'.AND. 1 IHARG(9).EQ.'VARI')GOTO12554 IF(IHARG(7).EQ.'COEF'.AND.IHARG(8).EQ.'VARI')GOTO12544 IF(IHARG(7).EQ.'SN')GOTO12545 IF(IHARG(7).EQ.'QN')GOTO12546 IF(IHARG(7).EQ.'SUM')GOTO12551 IF(IHARG(7).EQ.'SUMS')GOTO12551 IF(IHARG(7).EQ.'SIZE')GOTO12552 IF(IHARG(7).EQ.'NUMB')GOTO12552 IF(IHARG(7).EQ.'COUN')GOTO12552 ENDIF ENDIF C C ******************************** C ** IF NO MATCH, THEN RETURN ** C ******************************** C IFOUN7='NO' GOTO9000 C C ********************** C ** STEP 2-- ** C ** DEFINE ICASL7. ** C ********************** C 1201 CONTINUE ICASL7='SORT' GOTO8004 C 1202 CONTINUE ICASL7='RANK' GOTO8004 C 1203 CONTINUE ICASL7='CODE' GOTO8004 C 1204 CONTINUE ICASL7='DIST' GOTO8004 C C --------------- C 1205 CONTINUE ICASL7='SEQD' GOTO8004 C 1206 CONTINUE ICASL7='SEQD' GOTO8005 C 11206 CONTINUE ICASL7='IART' GOTO8005 C 1207 CONTINUE ICASL7='CUMS' GOTO8005 C 11207 CONTINUE ICASL7='CUMA' GOTO8005 C 11208 CONTINUE ICASL7='FLIP' GOTO8004 C 11209 CONTINUE ICASL7='CUMH' GOTO8005 C 11211 CONTINUE ICASL7='EXPS' GOTO8005 C 11210 CONTINUE ICASL7='HAZA' GOTO8004 C 1208 CONTINUE ICASL7='CUMP' GOTO8005 C 1209 CONTINUE ICASL7='CUMI' GOTO8005 C 11213 CONTINUE ICASL7='MTCH' GOTO8004 C 11214 CONTINUE ICASL7='REPL' GOTO8004 C C --------------- C 1210 CONTINUE ICASL7='CONV' GOTO8004 C 1211 CONTINUE ICASL7='DECO' GOTO8004 C 1212 CONTINUE ICASL7='SORC' GOTO8004 C 1213 CONTINUE ICASL7='FREQ' GOTO8004 C 1216 CONTINUE ICASL7='SUMD' GOTO8004 C 1217 CONTINUE ICASL7='INTR' GOTO8004 C 1218 CONTINUE ICASL7='INTR' GOTO8005 C CCCCC FOLLOWING SECTION ADDED MAY 1995. 1219 CONTINUE ICASL7='LINT' GOTO8005 C C -----CODINGS----- C 1220 CONTINUE ICASL7='CODH' GOTO8004 C 1221 CONTINUE ICASL7='COD1' GOTO8004 C 1222 CONTINUE ICASL7='COD2' GOTO8004 C 1223 CONTINUE ICASL7='COD3' GOTO8004 C 1224 CONTINUE ICASL7='COD4' GOTO8004 C 1225 CONTINUE ICASL7='COD5' GOTO8004 C 1226 CONTINUE ICASL7='COD6' GOTO8004 C 1227 CONTINUE ICASL7='COD7' GOTO8004 C 1228 CONTINUE ICASL7='COD8' GOTO8004 C 1229 CONTINUE ICASL7='COD9' GOTO8004 C 1230 CONTINUE ICASL7='CO10' GOTO8004 C 1241 CONTINUE ICASL7='BIWE' GOTO8004 C 1242 CONTINUE ICASL7='TRIC' GOTO8004 C 1243 CONTINUE ICASL7='FRAC' GOTO8005 C CCCCC FOLLOWING SECTION ADDED MAY 1994. 1248 CONTINUE ICASL7='BILI' GOTO8005 C CCCCC FOLLOWING SECTION ADDED MAY 1994. 1249 CONTINUE ICASL7='2DIN' GOTO8005 C CCCCC FOLLOWING SECTION ADDED MAY 1994. 1250 CONTINUE ICASL7='BIVA' GOTO8005 C C -----TRANSFORMS----- C 1251 CONTINUE ICASL7='SINT' GOTO8005 C 1252 CONTINUE ICASL7='COST' GOTO8005 C 1253 CONTINUE ICASL7='FOUT' IF(NUMARG.LE.6)ICASL7='FOU1' IF(NUMARG.GE.7.AND. 1 IHARG(7).EQ.'SUBS'.AND.IHARG2(7).EQ.'ET ')ICASL7='FOU1' IF(NUMARG.GE.7.AND. 1 IHARG(7).EQ.'EXCE'.AND.IHARG2(7).EQ.'PT ')ICASL7='FOU1' IF(NUMARG.GE.7.AND. 1 IHARG(7).EQ.'FOR '.AND.IHARG2(7).EQ.' ')ICASL7='FOU1' GOTO8006 C 1254 CONTINUE ICASL7='IFOU' IF(NUMARG.LE.7)ICASL7='IFO1' IF(NUMARG.GE.8.AND. 1 IHARG(8).EQ.'SUBS'.AND.IHARG2(8).EQ.'ET ')ICASL7='IFO1' IF(NUMARG.GE.8.AND. 1 IHARG(8).EQ.'EXCE'.AND.IHARG2(8).EQ.'PT ')ICASL7='IFO1' IF(NUMARG.GE.8.AND. 1 IHARG(8).EQ.'FOR '.AND.IHARG2(8).EQ.' ')ICASL7='IFO1' GOTO8007 C 1255 CONTINUE ICASL7='FFT' IF(NUMARG.LE.5)ICASL7='FFT1' IF(NUMARG.GE.6.AND. 1 IHARG(6).EQ.'SUBS'.AND.IHARG2(6).EQ.'ET ')ICASL7='FFT1' IF(NUMARG.GE.6.AND. 1 IHARG(6).EQ.'EXCE'.AND.IHARG2(6).EQ.'PT ')ICASL7='FFT1' IF(NUMARG.GE.6.AND. 1 IHARG(6).EQ.'FOR '.AND.IHARG2(6).EQ.' ')ICASL7='FFT1' GOTO8005 C 1256 CONTINUE ICASL7='IFFT' IF(NUMARG.LE.6)ICASL7='IFF1' IF(NUMARG.GE.7.AND. 1 IHARG(7).EQ.'SUBS'.AND.IHARG2(7).EQ.'ET ')ICASL7='IFF1' IF(NUMARG.GE.7.AND. 1 IHARG(7).EQ.'EXCE'.AND.IHARG2(7).EQ.'PT ')ICASL7='IFF1' IF(NUMARG.GE.7.AND. 1 IHARG(7).EQ.'FOR '.AND.IHARG2(7).EQ.' ')ICASL7='IFF1' GOTO8006 C 1261 CONTINUE ICASL7='LAPT' GOTO8005 C 1262 CONTINUE ICASL7='ILAT' GOTO8006 C CCCCC THE FOLLOWING SECTION WAS ADDED JANUARY 1989 1271 CONTINUE ICASL7='BOOT' GOTO8005 C CCCCC THE FOLLOWING SECTION WAS ADDED JANUARY 1990 1272 CONTINUE ICASL7='SUBS' GOTO8004 C CCCCC THE FOLLOWING SECTION WAS ADDED JANUARY 1990 1273 CONTINUE ICASL7='SUBS' GOTO8005 CCCCC THE FOLLOWING SECTION WAS ADDED OCTOBER 1993 1274 CONTINUE ICASL7='JAIN' GOTO8005 C C -----COMPLEX NUMBERS----- C 2101 CONTINUE ICASL7='COAD' GOTO8006 C 2102 CONTINUE ICASL7='COSU' GOTO8006 C 2103 CONTINUE ICASL7='COMU' GOTO8006 C 2104 CONTINUE ICASL7='CODI' GOTO8006 C 2105 CONTINUE ICASL7='COEX' GOTO8006 C 2106 CONTINUE ICASL7='COSR' GOTO8007 C 2107 CONTINUE ICASL7='CORO' IF(NUMARG.LE.6)ICASL7='COR1' IF(NUMARG.GE.7.AND. 1 IHARG(7).EQ.'SUBS'.AND.IHARG2(7).EQ.'ET ')ICASL7='COR1' IF(NUMARG.GE.7.AND. 1 IHARG(7).EQ.'EXCE'.AND.IHARG2(7).EQ.'PT ')ICASL7='COR1' IF(NUMARG.GE.7.AND. 1 IHARG(7).EQ.'FOR '.AND.IHARG2(7).EQ.' ')ICASL7='COR1' GOTO8006 C 2108 CONTINUE ICASL7='COCO' GOTO8006 C C -----POLYNOMIALS----- C 2201 CONTINUE ICASL7='POAD' GOTO8005 C 2202 CONTINUE ICASL7='POSU' GOTO8005 C 2203 CONTINUE ICASL7='POMU' GOTO8005 C 2204 CONTINUE ICASL7='PODI' GOTO8006 C 2205 CONTINUE ICASL7='POSQ' GOTO8005 C 2206 CONTINUE ICASL7='POSR' GOTO8006 C 2207 CONTINUE ICASL7='POGC' GOTO8005 C 2208 CONTINUE ICASL7='POLC' GOTO8005 C 2209 CONTINUE ICASL7='POEV' GOTO8005 C 2210 CONTINUE ICASL7='PODI' GOTO8005 C C -----VECTORS----- C 2301 CONTINUE ICASL7='VEAD' GOTO8005 C 2302 CONTINUE ICASL7='VESU' GOTO8005 C 2303 CONTINUE ICASL7='VEDP' GOTO8006 C 2304 CONTINUE ICASL7='VECP' GOTO8006 C 2305 CONTINUE ICASL7='VELE' GOTO8005 C 2306 CONTINUE ICASL7='VEDI' GOTO8005 C 2307 CONTINUE ICASL7='VEAN' GOTO8005 C C -----SETS----- C 2401 CONTINUE ICASL7='SEUN' GOTO8005 C 2402 CONTINUE ICASL7='SEIN' GOTO8005 C 2403 CONTINUE ICASL7='SECO' GOTO8005 C 2404 CONTINUE ICASL7='SECA' GOTO8005 C 2405 CONTINUE ICASL7='SECP' GOTO8007 C 2406 CONTINUE ICASL7='SEEL' GOTO8005 C C -----LOGICALS----- C 2501 CONTINUE ICASL7='LOAN' GOTO8005 C 2502 CONTINUE ICASL7='LOOR' GOTO8005 C 2503 CONTINUE ICASL7='LONA' GOTO8005 C 2504 CONTINUE ICASL7='LONO' GOTO8005 C 2505 CONTINUE ICASL7='LOIM' GOTO8005 C 2506 CONTINUE ICASL7='LOEQ' GOTO8005 C 2507 CONTINUE ICASL7='LONT' GOTO8005 C 2508 CONTINUE ICASL7='LOXO' GOTO8005 C C -----MATRICES----- C 2601 CONTINUE ICASL7='MAAD' GOTO8005 C 2602 CONTINUE ICASL7='MASU' GOTO8005 C 2603 CONTINUE ICASL7='MAMU' GOTO8005 C 2604 CONTINUE ICASL7='MASO' GOTO8005 C 2605 CONTINUE ICASL7='MAIN' GOTO8005 C 2606 CONTINUE ICASL7='MATR' GOTO8005 C 2607 CONTINUE ICASL7='MAAJ' GOTO8005 C 2608 CONTINUE ICASL7='MACE' GOTO8006 C 2609 CONTINUE ICASL7='MAEA' GOTO8005 C 2610 CONTINUE ICASL7='MAEA' GOTO8006 C 2611 CONTINUE ICASL7='MAEE' GOTO8005 C 2612 CONTINUE ICASL7='MAEE' GOTO8006 C 2613 CONTINUE ICASL7='MARA' GOTO8005 C 2614 CONTINUE ICASL7='MADE' GOTO8005 C 2615 CONTINUE ICASL7='MAPE' GOTO8005 C 2616 CONTINUE ICASL7='MASN' GOTO8006 C 2617 CONTINUE ICASL7='MASR' GOTO8006 C 2618 CONTINUE ICASL7='MANR' GOTO8006 C 2619 CONTINUE ICASL7='MANR' GOTO8007 C 2620 CONTINUE ICASL7='MANC' GOTO8006 C 2621 CONTINUE ICASL7='MANC' GOTO8007 C 2622 CONTINUE ICASL7='MASS' GOTO8006 C 2623 CONTINUE ICASL7='MASS' GOTO8005 C 2631 CONTINUE ICASL7='MATC' GOTO8005 C 2632 CONTINUE ICASL7='MASM' GOTO8005 C 2633 CONTINUE ICASL7='MAMI' GOTO8005 C 2634 CONTINUE ICASL7='MACF' GOTO8005 C 2635 CONTINUE ICASL7='MADF' GOTO8005 C 2636 CONTINUE ICASL7='MAEN' GOTO8006 C 2637 CONTINUE ICASL7='MAEN' GOTO8005 C 2641 CONTINUE ICASL7='MAVC' GOTO8006 C 2642 CONTINUE ICASL7='MACO' GOTO8005 C 2643 CONTINUE ICASL7='MAPC' IMSUBC='EVEC' GOTO8006 2644 CONTINUE ICASL7='MAPC' IMSUBC='EVAL' GOTO8006 2645 CONTINUE ICASL7='MAPC' IMSUBC='PC' GOTO8005 CCCCC JULY 1993. FOLLOWING LINES ADDED FOR SINGULAR VALUE DECOMP. 2646 CONTINUE ICASL7='MASD' GOTO8008 2647 CONTINUE ICASL7='MASV' GOTO8005 2648 CONTINUE ICASL7='MASF' GOTO8008 CCCCC END CHANGE CCCCC SEPTEMBER 1993. FOLLOWING LINES ADDED FOR MATRIX ROW, CCCCC MATRIX ELEMENT. 2649 CONTINUE ICASL7='MARW' GOTO8005 2650 CONTINUE ICASL7='MAEL' GOTO8005 CCCCC END CHANGE CCCCC OCTOBER 1993. FOLLOWING SECTION ADDED FOR CHOLESKY DECOMP 2651 CONTINUE ICASL7='MACH' GOTO8006 2652 CONTINUE ICASL7='MACH' GOTO8005 C 2653 CONTINUE IMSUBC='EVEC' ICASL7='MAP1' IF(IHARG(3).EQ.'SECO')ICASL7='MAP2' IF(IHARG(3).EQ.'THIR')ICASL7='MAP3' IF(IHARG(3).EQ.'FOUR')ICASL7='MAP4' IF(IHARG(3).EQ.'FIFT')ICASL7='MAP5' IF(IHARG(3).EQ.'SIXT')ICASL7='MAP6' IF(IHARG(3).EQ.'SEVE')ICASL7='MAP7' IF(IHARG(3).EQ.'EIGH')ICASL7='MAP8' IF(IHARG(3).EQ.'NINT')ICASL7='MAP9' IF(IHARG(3).EQ.'TENT')ICASL7='MA10' GOTO8007 2654 CONTINUE IMSUBC='EVAL' ICASL7='MAP1' IF(IHARG(3).EQ.'SECO')ICASL7='MAP2' IF(IHARG(3).EQ.'THIR')ICASL7='MAP3' IF(IHARG(3).EQ.'FOUR')ICASL7='MAP4' IF(IHARG(3).EQ.'FIFT')ICASL7='MAP5' IF(IHARG(3).EQ.'SIXT')ICASL7='MAP6' IF(IHARG(3).EQ.'SEVE')ICASL7='MAP7' IF(IHARG(3).EQ.'EIGH')ICASL7='MAP8' IF(IHARG(3).EQ.'NINT')ICASL7='MAP9' IF(IHARG(3).EQ.'TENT')ICASL7='MA10' GOTO8007 2655 CONTINUE IMSUBC='PC' ICASL7='MAP1' IF(IHARG(3).EQ.'SECO')ICASL7='MAP2' IF(IHARG(3).EQ.'THIR')ICASL7='MAP3' IF(IHARG(3).EQ.'FOUR')ICASL7='MAP4' IF(IHARG(3).EQ.'FIFT')ICASL7='MAP5' IF(IHARG(3).EQ.'SIXT')ICASL7='MAP6' IF(IHARG(3).EQ.'SEVE')ICASL7='MAP7' IF(IHARG(3).EQ.'EIGH')ICASL7='MAP8' IF(IHARG(3).EQ.'NINT')ICASL7='MAP9' IF(IHARG(3).EQ.'TENT')ICASL7='MA10' GOTO8006 C 2661 CONTINUE ICASL7='MAEE' GOTO8004 C 2662 CONTINUE ICASL7='MAEA' GOTO8004 CCCCC OCTOBER 1993. FOLLOWING SECTION ADDED FOR CHOLESKY DECOMP 2666 CONTINUE ICASL7='MACH' GOTO8004 C 2668 CONTINUE ICASL7='MATZ' GOTO8005 C 2669 CONTINUE ICASL7='MATZ' GOTO8006 C 2670 CONTINUE ICASL7='MAUZ' GOTO8006 C CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1989 C -----(DEX) GENERATORS----- C 2701 CONTINUE ICASL7='GEAD' GOTO8005 C 2702 CONTINUE ICASL7='GESU' GOTO8005 C 2703 CONTINUE ICASL7='GEMU' GOTO8005 C CCCCC THE FOLLOWING WAS ADDED JULY 1991 2801 CONTINUE ICASL7='COCD' GOTO8004 C CCCCC THE FOLLOWING WAS ADDED JULY 1991 2802 CONTINUE ICASL7='COCP' GOTO8004 C CCCCC THE FOLLOWING WAS ADDED JUNE 1999 2806 CONTINUE ICASL7='CUSA' GOTO8005 C CCCCC THE FOLLOWING WAS ADDED JUNE 1999 2808 CONTINUE ICASL7='CUSA' GOTO8007 C CCCCC THE FOLLOWING WAS ADDED JUNE 1999 2810 CONTINUE ICASL7='CU1A' GOTO8007 C CCCCC THE FOLLOWING WAS ADDED MARCH 2001 2812 CONTINUE ICASL7='STAN' GOTO8004 C CCCCC THE FOLLOWING WAS ADDED MARCH 2001 2814 CONTINUE ICASL7='LSST' GOTO8005 C CCCCC THE FOLLOWING WAS ADDED MARCH 2001 2816 CONTINUE ICASL7='LSTA' GOTO8005 C CCCCC THE FOLLOWING WAS ADDED MARCH 2001 2818 CONTINUE ICASL7='ZSCO' GOTO8004 C CCCCC THE FOLLOWING WAS ADDED MARCH 2001 2820 CONTINUE ICASL7='USCO' GOTO8004 C CCCCC THE FOLLOWING WAS ADDED MARCH 2001 2822 CONTINUE ICASL7='LSST' GOTO8005 C CCCCC THE FOLLOWING WAS ADDED MARCH 2001 2824 CONTINUE ICASL7='STAC' GOTO8005 C 2825 CONTINUE ICASL7='RSTA' GOTO8007 C CCCCC THE FOLLOWING LONG SECTION IDENTIFIES THE SPECFIC STATISTIC CCCCC FOR THE CROSS TABULATE COMMAND 2832 CONTINUE ICASL7='CTAB' ICASS7='MEAN' GOTO8006 C 2834 CONTINUE ICASL7='CTAB' ICASS7='MIDM' GOTO8006 C 2836 CONTINUE ICASL7='CTAB' ICASS7='MEDI' GOTO8006 C 2838 CONTINUE ICASL7='CTAB' ICASS7='TRIM' GOTO8007 C 2840 CONTINUE ICASL7='CTAB' ICASS7='WINM' GOTO8007 C 2842 CONTINUE ICASL7='CTAB' ICASS7='SUM' GOTO8006 C 2844 CONTINUE ICASL7='CTAB' ICASS7='PROD' GOTO8006 C 2846 CONTINUE ICASL7='CTAB' ICASS7='SD' GOTO8006 C 2848 CONTINUE ICASL7='CTAB' ICASS7='SD' GOTO8007 C 2850 CONTINUE ICASL7='CTAB' ICASS7='SDME' GOTO8009 C 2852 CONTINUE ICASL7='CTAB' ICASS7='SDME' GOTO8008 C 2854 CONTINUE ICASL7='CTAB' ICASS7='VARI' GOTO8006 C 2856 CONTINUE ICASL7='CTAB' ICASS7='VAME' GOTO8008 C 2858 CONTINUE ICASL7='CTAB' ICASS7='REVA' GOTO8007 C 2860 CONTINUE ICASL7='CTAB' ICASS7='RESD' GOTO8007 C 2862 CONTINUE ICASL7='CT26' ICASS7='RESD' GOTO8008 C 2864 CONTINUE ICASL7='CTAB' ICASS7='CVAR' GOTO8008 C 2866 CONTINUE ICASL7='CTAB' ICASS7='AAD' GOTO8008 C 2868 CONTINUE ICASL7='CTAB' ICASS7='MAD' GOTO8008 C 2869 CONTINUE ICASL7='CTAB' ICASS7='MAD' GOTO8006 C 2870 CONTINUE ICASL7='CTAB' ICASS7='RANG' GOTO8006 C 2872 CONTINUE ICASL7='CTAB' ICASS7='MIDR' GOTO8006 C 2874 CONTINUE ICASL7='CTAB' ICASS7='MAXI' GOTO8006 C 2876 CONTINUE ICASL7='CTAB' ICASS7='MINI' GOTO8006 C 2878 CONTINUE ICASL7='CTAB' ICASS7='EXTR' GOTO8006 C 2880 CONTINUE ICASL7='CTAB' ICASS7='LOWH' GOTO8007 C 2882 CONTINUE ICASL7='CTAB' ICASS7='UPPH' GOTO8007 C 2884 CONTINUE ICASL7='CTAB' ICASS7='LOWQ' GOTO8007 C 2886 CONTINUE ICASL7='CTAB' ICASS7='UPPQ' GOTO8007 C 2888 CONTINUE ICASL7='CTAB' ICASS7='SKEW' GOTO8006 C 2890 CONTINUE ICASL7='CTAB' ICASS7='KURT' GOTO8006 C 2892 CONTINUE ICASL7='CTAB' ICASS7='AUCR' GOTO8006 C 2894 CONTINUE ICASL7='CTAB' ICASS7='AUCV' GOTO8006 C 2896 CONTINUE ICASL7='CTAB' ICASS7='IQRA' GOTO8007 C 2898 CONTINUE ICASL7='CTAB' ICASS7='BILO' GOTO8007 C 2899 CONTINUE ICASL7='CTAB' ICASS7='BISC' GOTO8007 C 12900 CONTINUE ICASL7='CTAB' ICASS7='BIMV' GOTO8007 C 12901 CONTINUE ICASL7='CTAB' ICASS7='WISD' GOTO8007 C 12902 CONTINUE ICASL7='CTAB' ICASS7='WISD' GOTO8008 C 12903 CONTINUE ICASL7='CTAB' ICASS7='WIVA' GOTO8007 C 12904 CONTINUE ICASL7='CTAB' ICASS7='PBMV' GOTO8008 C 12905 CONTINUE ICASL7='CTAB' ICASS7='HLEH' GOTO8007 C 12906 CONTINUE ICASL7='CTAB' ICASS7='QUSE' GOTO8008 C 12907 CONTINUE ICASL7='CTAB' ICASS7='QUAN' GOTO8006 C 12908 CONTINUE ICASL7='CTAB' ICASS7='TMSE' GOTO8008 C 12911 CONTINUE ICASL7='CTAB' ICASS7='CP' GOTO8006 C 12912 CONTINUE ICASL7='CTAB' ICASS7='CPK' GOTO8006 C 12913 CONTINUE ICASL7='CTAB' ICASS7='CPM' GOTO8006 C 12914 CONTINUE ICASL7='CTAB' ICASS7='CPL' GOTO8006 C 12915 CONTINUE ICASL7='CTAB' ICASS7='CPU' GOTO8006 C 12916 CONTINUE ICASL7='CTAB' ICASS7='CNPK' GOTO8006 C 12917 CONTINUE ICASL7='CTAB' ICASS7='CC' GOTO8006 C 12918 CONTINUE ICASL7='CTAB' ICASS7='PEDE' GOTO8007 C 12919 CONTINUE ICASL7='CTAB' ICASS7='EXLO' GOTO8007 C 12921 CONTINUE ICASL7='CTAB' ICASS7='PERC' GOTO8006 C 12922 CONTINUE ICASL7='CTAB' ICASS7='HAME' GOTO8007 C 12923 CONTINUE ICASL7='CTAB' ICASS7='GEME' GOTO8007 C 12924 CONTINUE ICASL7='CTAB' ICASS7='GESD' GOTO8007 C 12925 CONTINUE ICASL7='CTAB' ICASS7='GESD' GOTO8008 C 12926 CONTINUE ICASL7='CTAB' ICASS7='NOPP' GOTO8007 C 12931 CONTINUE ICASL7='CTAB' ICASS7='1DEC' GOTO8007 C 12932 CONTINUE ICASL7='CTAB' ICASS7='2DEC' GOTO8007 C 12933 CONTINUE ICASL7='CTAB' ICASS7='3DEC' GOTO8007 C 12934 CONTINUE ICASL7='CTAB' ICASS7='4DEC' GOTO8007 C 12935 CONTINUE ICASL7='CTAB' ICASS7='5DEC' GOTO8007 C 12936 CONTINUE ICASL7='CTAB' ICASS7='6DEC' GOTO8007 C 12937 CONTINUE ICASL7='CTAB' ICASS7='7DEC' GOTO8007 C 12938 CONTINUE ICASL7='CTAB' ICASS7='8DEC' GOTO8007 C 12939 CONTINUE ICASL7='CTAB' ICASS7='9DEC' GOTO8007 C 12941 CONTINUE ICASL7='CTAB' ICASS7='SN00' GOTO8007 C 12942 CONTINUE ICASL7='CTAB' ICASS7='SN0' GOTO8007 C 12943 CONTINUE ICASL7='CTAB' ICASS7='SN+' GOTO8007 C 12944 CONTINUE ICASL7='CTAB' ICASS7='SN-' GOTO8007 C 12946 CONTINUE ICASL7='CTAB' ICASS7='SN00' GOTO8006 C 12947 CONTINUE ICASL7='CTAB' ICASS7='SN0' GOTO8006 C 12948 CONTINUE ICASL7='CTAB' ICASS7='SN+' GOTO8006 C 12949 CONTINUE ICASL7='CTAB' ICASS7='SN-' GOTO8006 C 12951 CONTINUE ICASL7='CTAB' ICASS7='SIFR' GOTO8007 C 12952 CONTINUE ICASL7='CTAB' ICASS7='SIAM' GOTO8007 C 12954 CONTINUE ICASL7='CTAB' ICASS7='WEME' GOTO8007 C 12956 CONTINUE ICASL7='CTAB' ICASS7='WEVA' GOTO8007 C 12958 CONTINUE ICASL7='CTAB' ICASS7='WESD' GOTO8007 C 12960 CONTINUE ICASL7='CTAB' ICASS7='WESD' GOTO8008 C 12961 CONTINUE ICASL7='CTAB' ICASS7='RATI' GOTO8006 C 12962 CONTINUE ICASL7='CTAB' ICASS7='SNSC' GOTO8007 C 12964 CONTINUE ICASL7='CTAB' ICASS7='QNSC' GOTO8007 C 12501 CONTINUE ICASL7='CTAB' ICASS7='DMEA' GOTO8008 C 12502 CONTINUE ICASL7='CTAB' ICASS7='DMDM' GOTO8008 C 12503 CONTINUE ICASL7='CTAB' ICASS7='DMED' GOTO8008 C 12504 CONTINUE ICASL7='CTAB' ICASS7='DTRM' GOTO8009 C 12505 CONTINUE ICASL7='CTAB' ICASS7='DWNM' GOTO8009 C 12506 CONTINUE ICASL7='CTAB' ICASS7='DGEO' GOTO8009 C 12507 CONTINUE ICASL7='CTAB' ICASS7='DHAR' GOTO8009 C 12508 CONTINUE ICASL7='CTAB' ICASS7='DHDL' GOTO8009 C 12509 CONTINUE ICASL7='CTAB' ICASS7='DBIW' GOTO8009 C 12520 CONTINUE ICASL7='CTAB' ICASS7='DSD ' GOTO8008 C 12521 CONTINUE ICASL7='CTAB' ICASS7='DSD ' GOTO8009 C 12522 CONTINUE ICASL7='CTAB' ICASS7='DVAR' GOTO8008 C 12623 CONTINUE ICASL7='CTAB' ICASS7='DAAD' GOTO8010 C 12523 CONTINUE ICASL7='CTAB' ICASS7='DAAD' GOTO8008 C 12624 CONTINUE ICASL7='CTAB' ICASS7='MAAD' GOTO8010 C 12524 CONTINUE ICASL7='CTAB' ICASS7='DMAD' GOTO8008 C 12525 CONTINUE ICASL7='CTAB' ICASS7='DIQR' GOTO8009 C 12526 CONTINUE ICASL7='CTAB' ICASS7='DWSD' GOTO8010 C 12527 CONTINUE ICASL7='CTAB' ICASS7='DWVA' GOTO8009 C 12528 CONTINUE ICASL7='CTAB' ICASS7='DBIM' GOTO8009 C 12529 CONTINUE ICASL7='CTAB' ICASS7='DBIS' GOTO8009 C 12530 CONTINUE ICASL7='CTAB' ICASS7='DPBN' GOTO8010 C 12531 CONTINUE ICASL7='CTAB' ICASS7='DGSD' GOTO8010 C 12532 CONTINUE ICASL7='CTAB' ICASS7='DRAN' GOTO8008 C 12533 CONTINUE ICASL7='CTAB' ICASS7='DMDR' GOTO8009 C 12534 CONTINUE ICASL7='CTAB' ICASS7='DQUA' GOTO8008 C 12535 CONTINUE ICASL7='CTAB' ICASS7='DSKE' GOTO8008 C 12536 CONTINUE ICASL7='CTAB' ICASS7='DKUR' GOTO8008 C 12537 CONTINUE ICASL7='CTAB' ICASS7='DRSD' GOTO8009 C 12738 CONTINUE ICASL7='CTAB' ICASS7='DSDM' GOTO8011 C 12638 CONTINUE ICASL7='CTAB' ICASS7='DSDM' GOTO8010 C 12538 CONTINUE ICASL7='CTAB' ICASS7='DSDM' GOTO8009 C 12539 CONTINUE ICASL7='CTAB' ICASS7='DRVA' GOTO8009 C 12740 CONTINUE ICASL7='CTAB' ICASS7='DVAM' GOTO8011 C 12640 CONTINUE ICASL7='CTAB' ICASS7='DVAM' GOTO8010 C 12540 CONTINUE ICASL7='CTAB' ICASS7='DVAM' GOTO8009 C 12541 CONTINUE ICASL7='CTAB' ICASS7='DMIN' GOTO8008 C 12542 CONTINUE ICASL7='CTAB' ICASS7='DMAX' GOTO8008 C 12543 CONTINUE ICASL7='CTAB' ICASS7='DEXT' GOTO8008 C 12554 CONTINUE ICASL7='CTAB' ICASS7='DCVA' GOTO8010 C 12544 CONTINUE ICASL7='CTAB' ICASS7='DCVA' GOTO8009 C 12545 CONTINUE ICASL7='CTAB' ICASS7='DSN' GOTO8008 C 12546 CONTINUE ICASL7='CTAB' ICASS7='DQN' GOTO8008 C 12551 CONTINUE ICASL7='CTAB' ICASS7='DSUM' GOTO8008 C 12552 CONTINUE ICASL7='CTAB' ICASS7='DCOU' GOTO8008 C C CCCCC THE FOLLOWING SECTION WAS ADDED OCTOBER 1993 C -----MORE MATRIX COMMANDS- C 2902 CONTINUE ICASL7='MAAU' GOTO8005 C 2912 CONTINUE ICASL7='MADI' GOTO8005 C 2922 CONTINUE ICASL7='MARR' GOTO8006 C 2932 CONTINUE ICASL7='MARE' GOTO8006 C 2942 CONTINUE ICASL7='DIMA' GOTO8005 C 2952 CONTINUE ICASL7='MATD' GOTO8005 C 2962 CONTINUE ICASL7='MAIS' GOTO8006 C 2972 CONTINUE ICASL7='MATS' GOTO8005 C 2982 CONTINUE ICASL7='MATI' GOTO8005 C 2992 CONTINUE ICASL7='MROW' ICASS7='MEAN' GOTO8006 C 3002 CONTINUE ICASL7='MROW' ICASS7='MIDM' GOTO8006 C 3012 CONTINUE ICASL7='MROW' ICASS7='MEDI' GOTO8006 C 3022 CONTINUE ICASL7='MROW' ICASS7='TRIM' GOTO8007 C 3024 CONTINUE ICASL7='MROW' ICASS7='TRSE' GOTO8009 C 3032 CONTINUE ICASL7='MROW' ICASS7='WINM' GOTO8007 C 3034 CONTINUE ICASL7='MROW' ICASS7='HLEH' GOTO8007 C 3036 CONTINUE ICASL7='MROW' ICASS7='BILO' GOTO8007 C 3038 CONTINUE ICASL7='MROW' ICASS7='BISC' GOTO8007 C 3042 CONTINUE ICASL7='MROW' ICASS7='SUM' GOTO8006 C 3045 CONTINUE ICASL7='MROW' ICASS7='PROD' GOTO8006 C 3052 CONTINUE ICASL7='MROW' ICASS7='SD' GOTO8006 C 3062 CONTINUE ICASL7='MROW' ICASS7='SD' GOTO8007 C 3063 CONTINUE ICASL7='MROW' ICASS7='BIMV' GOTO8007 C 3064 CONTINUE ICASL7='MROW' ICASS7='PBMV' GOTO8008 C 3065 CONTINUE ICASL7='MROW' ICASS7='WIVA' GOTO8007 C 3066 CONTINUE ICASL7='MROW' ICASS7='WISD' GOTO8007 C 3067 CONTINUE ICASL7='MROW' ICASS7='WISD' GOTO8008 C 3072 CONTINUE ICASL7='MROW' ICASS7='SDME' GOTO8009 C 3082 CONTINUE ICASL7='MROW' ICASS7='SDME' GOTO8008 C 3092 CONTINUE ICASL7='MROW' ICASS7='VARI' GOTO8006 C 3102 CONTINUE ICASL7='MROW' ICASS7='VAME' GOTO8008 C 3112 CONTINUE ICASL7='MROW' ICASS7='REVA' GOTO8007 C 3122 CONTINUE ICASL7='MROW' ICASS7='RESD' GOTO8007 C 3132 CONTINUE ICASL7='MROW' ICASS7='RESD' GOTO8008 C 3142 CONTINUE ICASL7='MROW' ICASS7='CVAR' GOTO8008 C 3152 CONTINUE ICASL7='MROW' ICASS7='AAD' GOTO8008 C 3162 CONTINUE ICASL7='MROW' ICASS7='MAD' GOTO8008 C 3172 CONTINUE ICASL7='MROW' ICASS7='RANG' GOTO8006 C 3182 CONTINUE ICASL7='MROW' ICASS7='MIDR' GOTO8006 C 3192 CONTINUE ICASL7='MROW' ICASS7='MAXI' GOTO8006 C 3202 CONTINUE ICASL7='MROW' ICASS7='MINI' GOTO8006 C 3212 CONTINUE ICASL7='MROW' ICASS7='EXTR' GOTO8006 C 3222 CONTINUE ICASL7='MROW' ICASS7='LOWH' GOTO8007 C 3232 CONTINUE ICASL7='MROW' ICASS7='UPPH' GOTO8007 C 3242 CONTINUE ICASL7='MROW' ICASS7='LOWQ' GOTO8007 C 3252 CONTINUE ICASL7='MROW' ICASS7='UPPQ' GOTO8007 C 3262 CONTINUE ICASL7='MROW' ICASS7='SKEW' GOTO8006 C 3272 CONTINUE ICASL7='MROW' ICASS7='KURT' GOTO8006 C 3282 CONTINUE ICASL7='MROW' ICASS7='AUCR' GOTO8006 C 3292 CONTINUE ICASL7='MROW' ICASS7='AUCV' GOTO8006 C 3302 CONTINUE ICASL7='MRSC' GOTO8006 C 3303 CONTINUE ICASL7='MROW' ICASS7='QUSE' GOTO8008 C 3304 CONTINUE ICASL7='MROW' ICASS7='QUAN' GOTO8006 C 3311 CONTINUE ICASL7='MROW' ICASS7='CP' GOTO8006 C 3312 CONTINUE ICASL7='MROW' ICASS7='CPK' GOTO8006 C 3313 CONTINUE ICASL7='MROW' ICASS7='CPM' GOTO8006 C 3314 CONTINUE ICASL7='MROW' ICASS7='CPL' GOTO8006 C 3315 CONTINUE ICASL7='MROW' ICASS7='CPU' GOTO8006 C 3316 CONTINUE ICASL7='MROW' ICASS7='CNPK' GOTO8006 C 3317 CONTINUE ICASL7='MROW' ICASS7='CC' GOTO8006 C 3318 CONTINUE ICASL7='MROW' ICASS7='PEDE' GOTO8007 C 3319 CONTINUE ICASL7='MROW' ICASS7='EXLO' GOTO8007 C 3321 CONTINUE ICASL7='MROW' ICASS7='PERC' GOTO8006 C 3322 CONTINUE ICASL7='MROW' ICASS7='HAME' GOTO8007 C 3323 CONTINUE ICASL7='MROW' ICASS7='GEME' GOTO8007 C 3324 CONTINUE ICASL7='MROW' ICASS7='GESD' GOTO8007 C 3325 CONTINUE ICASL7='MROW' ICASS7='GESD' GOTO8008 C 3326 CONTINUE ICASL7='MROW' ICASS7='NOPP' GOTO8007 C 3331 CONTINUE ICASL7='MROW' ICASS7='1DEC' GOTO8007 C 3332 CONTINUE ICASL7='MROW' ICASS7='2DEC' GOTO8007 C 3333 CONTINUE ICASL7='MROW' ICASS7='3DEC' GOTO8007 C 3334 CONTINUE ICASL7='MROW' ICASS7='4DEC' GOTO8007 C 3335 CONTINUE ICASL7='MROW' ICASS7='5DEC' GOTO8007 C 3336 CONTINUE ICASL7='MROW' ICASS7='6DEC' GOTO8007 C 3337 CONTINUE ICASL7='MROW' ICASS7='7DEC' GOTO8007 C 3338 CONTINUE ICASL7='MROW' ICASS7='8DEC' GOTO8007 C 3339 CONTINUE ICASL7='MROW' ICASS7='9DEC' GOTO8007 C 3341 CONTINUE ICASL7='MROW' ICASS7='SN00' GOTO8007 C 3342 CONTINUE ICASL7='MROW' ICASS7='SN0' GOTO8007 C 3343 CONTINUE ICASL7='MROW' ICASS7='SN+' GOTO8007 C 3344 CONTINUE ICASL7='MROW' ICASS7='SN-' GOTO8007 C 3346 CONTINUE ICASL7='MROW' ICASS7='SN00' GOTO8006 C 3347 CONTINUE ICASL7='MROW' ICASS7='SN0' GOTO8006 C 3348 CONTINUE ICASL7='MROW' ICASS7='SN+' GOTO8006 C 3349 CONTINUE ICASL7='MROW' ICASS7='SN-' GOTO8006 C 3351 CONTINUE ICASL7='MROW' ICASS7='SIFR' GOTO8007 C 3352 CONTINUE ICASL7='MROW' ICASS7='SIAM' GOTO8007 C 3354 CONTINUE ICASL7='MROW' ICASS7='SNSC' GOTO8007 C 3356 CONTINUE ICASL7='MROW' ICASS7='QNSC' GOTO8007 C 3992 CONTINUE ICASL7='MCOL' ICASS7='MEAN' GOTO8006 C 4002 CONTINUE ICASL7='MCOL2' ICASS7='MIDM' GOTO8006 C 4012 CONTINUE ICASL7='MCOL' ICASS7='MEDI' GOTO8006 C 4022 CONTINUE ICASL7='MCOL' ICASS7='TRIM' GOTO8007 C 4024 CONTINUE ICASL7='MCOL' ICASS7='TRSE' GOTO8009 C 4032 CONTINUE ICASL7='MCOL' ICASS7='WINM' GOTO8007 C 4034 CONTINUE ICASL7='MCOL' ICASS7='HLEH' GOTO8007 C 4036 CONTINUE ICASL7='MCOL' ICASS7='BILO' GOTO8007 C 4038 CONTINUE ICASL7='MCOL' ICASS7='BISC' GOTO8007 C 4042 CONTINUE ICASL7='MCOL' ICASS7='SUM' GOTO8006 C 4045 CONTINUE ICASL7='MCOL' ICASS7='PROD' GOTO8006 C 4052 CONTINUE ICASL7='MCOL' ICASS7='SD' GOTO8006 C 4062 CONTINUE ICASL7='MCOL' ICASS7='SD' GOTO8007 C 4063 CONTINUE ICASL7='MCOL' ICASS7='BIMV' GOTO8007 C 4064 CONTINUE ICASL7='MCOL' ICASS7='PBMV' GOTO8008 C 4065 CONTINUE ICASL7='MCOL' ICASS7='WIVA' GOTO8007 C 4066 CONTINUE ICASL7='MCOL' ICASS7='WISD' GOTO8007 C 4067 CONTINUE ICASL7='MCOL' ICASS7='WISD' GOTO8008 C 4072 CONTINUE ICASL7='MCOL' ICASS7='SDME' GOTO8009 C 4082 CONTINUE ICASL7='MCOL' ICASS7='SDME' GOTO8008 C 4092 CONTINUE ICASL7='MCOL' ICASS7='VARI' GOTO8006 C 4102 CONTINUE ICASL7='MCOL' ICASS7='VAME' GOTO8008 C 4112 CONTINUE ICASL7='MCOL' ICASS7='REVA' GOTO8007 C 4122 CONTINUE ICASL7='MCOL' ICASS7='RESD' GOTO8007 C 4132 CONTINUE ICASL7='MCOL' ICASS7='RESD' GOTO8008 C 4142 CONTINUE ICASL7='MCOL' ICASS7='CVAR' GOTO8008 C 4152 CONTINUE ICASL7='MCOL' ICASS7='AAD' GOTO8008 C 4162 CONTINUE ICASL7='MCOL' ICASS7='MAD' GOTO8008 C 4172 CONTINUE ICASL7='MCOL' ICASS7='RANG' GOTO8006 C 4182 CONTINUE ICASL7='MCOL' ICASS7='MRAN' GOTO8006 C 4192 CONTINUE ICASL7='MCOL' ICASS7='MAXI' GOTO8006 C 4202 CONTINUE ICASL7='MCOL' ICASS7='MINI' GOTO8006 C 4212 CONTINUE ICASL7='MCOL' ICASS7='EXTR' GOTO8006 C 4222 CONTINUE ICASL7='MCOL' ICASS7='LOWH' GOTO8007 C 4232 CONTINUE ICASL7='MCOL' ICASS7='UPPH' GOTO8007 C 4242 CONTINUE ICASL7='MCOL' ICASS7='LOWQ' GOTO8007 C 4252 CONTINUE ICASL7='MCOL' ICASS7='UPPQ' GOTO8007 C 4262 CONTINUE ICASL7='MCOL' ICASS7='SKEW' GOTO8006 C 4272 CONTINUE ICASL7='MCOL' ICASS7='KURT' GOTO8006 C 4282 CONTINUE ICASL7='MCOL' ICASS7='AUCR' GOTO8006 C 4292 CONTINUE ICASL7='MCOL' ICASS7='AUCV' GOTO8006 C 4302 CONTINUE ICASL7='MCSC' GOTO8006 C 4303 CONTINUE ICASL7='MCOL' ICASS7='QUSE' GOTO8008 C 4304 CONTINUE ICASL7='MCOL' ICASS7='QUAN' GOTO8006 C 4311 CONTINUE ICASL7='MCOL' ICASS7='CP' GOTO8006 C 4312 CONTINUE ICASL7='MCOL' ICASS7='CPK' GOTO8006 C 4313 CONTINUE ICASL7='MCOL' ICASS7='CPM' GOTO8006 C 4314 CONTINUE ICASL7='MCOL' ICASS7='CPL' GOTO8006 C 4315 CONTINUE ICASL7='MCOL' ICASS7='CPU' GOTO8006 C 4316 CONTINUE ICASL7='MCOL' ICASS7='CNPK' GOTO8006 C 4317 CONTINUE ICASL7='MCOL' ICASS7='CC' GOTO8006 C 4318 CONTINUE ICASL7='MCOL' ICASS7='PEDE' GOTO8007 C 4319 CONTINUE ICASL7='MCOL' ICASS7='EXLO' GOTO8007 C 4321 CONTINUE ICASL7='MCOL' ICASS7='PERC' GOTO8006 C 4322 CONTINUE ICASL7='MCOL' ICASS7='HAME' GOTO8007 C 4323 CONTINUE ICASL7='MCOL' ICASS7='GEME' GOTO8007 C 4324 CONTINUE ICASL7='MCOL' ICASS7='GESD' GOTO8007 C 4325 CONTINUE ICASL7='MCOL' ICASS7='GESD' GOTO8008 C 4326 CONTINUE ICASL7='MCOL' ICASS7='NOPP' GOTO8007 C 4331 CONTINUE ICASL7='MCOL' ICASS7='1DEC' GOTO8007 C 4332 CONTINUE ICASL7='MCOL' ICASS7='2DEC' GOTO8007 C 4333 CONTINUE ICASL7='MCOL' ICASS7='3DEC' GOTO8007 C 4334 CONTINUE ICASL7='MCOL' ICASS7='4DEC' GOTO8007 C 4335 CONTINUE ICASL7='MCOL' ICASS7='5DEC' GOTO8007 C 4336 CONTINUE ICASL7='MCOL' ICASS7='6DEC' GOTO8007 C 4337 CONTINUE ICASL7='MCOL' ICASS7='7DEC' GOTO8007 C 4338 CONTINUE ICASL7='MCOL' ICASS7='8DEC' GOTO8007 C 4339 CONTINUE ICASL7='MCOL' ICASS7='9DEC' GOTO8007 C 4341 CONTINUE ICASL7='MCOL' ICASS7='SN00' GOTO8007 C 4342 CONTINUE ICASL7='MCOL' ICASS7='SN0' GOTO8007 C 4343 CONTINUE ICASL7='MCOL' ICASS7='SN+' GOTO8007 C 4344 CONTINUE ICASL7='MCOL' ICASS7='SN-' GOTO8007 C 4346 CONTINUE ICASL7='MCOL' ICASS7='SN00' GOTO8006 C 4347 CONTINUE ICASL7='MCOL' ICASS7='SN0' GOTO8006 C 4348 CONTINUE ICASL7='MCOL' ICASS7='SN+' GOTO8006 C 4349 CONTINUE ICASL7='MCOL' ICASS7='SN-' GOTO8006 C 4351 CONTINUE ICASL7='MCOL' ICASS7='SIFR' GOTO8007 C 4352 CONTINUE ICASL7='MCOL' ICASS7='SIAM' GOTO8007 C 4354 CONTINUE ICASL7='MCOL' ICASS7='SNSC' GOTO8007 C 4356 CONTINUE ICASL7='MCOL' ICASS7='QNSC' GOTO8007 C 4500 CONTINUE ICASL7='MPAR' ICASS7='MEAN' GOTO8006 C 4502 CONTINUE ICASL7='MPAR2' ICASS7='MIDM' GOTO8006 C 4512 CONTINUE ICASL7='MPAR' ICASS7='MEDI' GOTO8006 C 4522 CONTINUE ICASL7='MPAR' ICASS7='TRIM' GOTO8007 C 4524 CONTINUE ICASL7='MPAR' ICASS7='TRSE' GOTO8009 C 4532 CONTINUE ICASL7='MPAR' ICASS7='WINM' GOTO8007 C 4534 CONTINUE ICASL7='MPAR' ICASS7='HLEH' GOTO8007 C 4536 CONTINUE ICASL7='MPAR' ICASS7='BILO' GOTO8007 C 4538 CONTINUE ICASL7='MPAR' ICASS7='BISC' GOTO8007 C 4542 CONTINUE ICASL7='MPAR' ICASS7='SUM' GOTO8006 C 4545 CONTINUE ICASL7='MPAR' ICASS7='PROD' GOTO8006 C 4552 CONTINUE ICASL7='MPAR' ICASS7='SD' GOTO8006 C 4562 CONTINUE ICASL7='MPAR' ICASS7='SD' GOTO8007 C 4563 CONTINUE ICASL7='MPAR' ICASS7='BIMV' GOTO8007 C 4564 CONTINUE ICASL7='MPAR' ICASS7='PBMV' GOTO8008 C 4565 CONTINUE ICASL7='MPAR' ICASS7='WIVA' GOTO8007 C 4566 CONTINUE ICASL7='MPAR' ICASS7='WISD' GOTO8007 C 4567 CONTINUE ICASL7='MPAR' ICASS7='WISD' GOTO8008 C 4572 CONTINUE ICASL7='MPAR' ICASS7='SDME' GOTO8009 C 4582 CONTINUE ICASL7='MPAR' ICASS7='SDME' GOTO8008 C 4592 CONTINUE ICASL7='MPAR' ICASS7='VARI' GOTO8006 C 4602 CONTINUE ICASL7='MPAR' ICASS7='VAME' GOTO8008 C 4612 CONTINUE ICASL7='MPAR' ICASS7='REVA' GOTO8007 C 4622 CONTINUE ICASL7='MPAR' ICASS7='RESD' GOTO8007 C 4632 CONTINUE ICASL7='MPAR' ICASS7='RESD' GOTO8008 C 4642 CONTINUE ICASL7='MPAR' ICASS7='CVAR' GOTO8008 C 4652 CONTINUE ICASL7='MPAR' ICASS7='AAD' GOTO8008 C 4662 CONTINUE ICASL7='MPAR' ICASS7='MAD' GOTO8008 C 4672 CONTINUE ICASL7='MPAR' ICASS7='RANG' GOTO8006 C 4682 CONTINUE ICASL7='MPAR' ICASS7='MRAN' GOTO8006 C 4692 CONTINUE ICASL7='MPAR' ICASS7='MAXI' GOTO8006 C 4702 CONTINUE ICASL7='MPAR' ICASS7='MINI' GOTO8006 C 4712 CONTINUE ICASL7='MPAR' ICASS7='EXTR' GOTO8006 C 4722 CONTINUE ICASL7='MPAR' ICASS7='LOWH' GOTO8007 C 4732 CONTINUE ICASL7='MPAR' ICASS7='UPPH' GOTO8007 C 4742 CONTINUE ICASL7='MPAR' ICASS7='LOWQ' GOTO8007 C 4752 CONTINUE ICASL7='MPAR' ICASS7='UPPQ' GOTO8007 C 4762 CONTINUE ICASL7='MPAR' ICASS7='SKEW' GOTO8006 C 4772 CONTINUE ICASL7='MPAR' ICASS7='KURT' GOTO8006 C 4782 CONTINUE ICASL7='MPAR' ICASS7='AUCR' GOTO8006 C 4792 CONTINUE ICASL7='MPAR' ICASS7='AUCV' GOTO8006 C 4802 CONTINUE ICASL7='MCSC' GOTO8006 C 4803 CONTINUE ICASL7='MPAR' ICASS7='QUSE' GOTO8008 C 4804 CONTINUE ICASL7='MPAR' ICASS7='QUAN' GOTO8006 C 4811 CONTINUE ICASL7='MPAR' ICASS7='CP' GOTO8006 C 4812 CONTINUE ICASL7='MPAR' ICASS7='CPK' GOTO8006 C 4813 CONTINUE ICASL7='MPAR' ICASS7='CPM' GOTO8006 C 4814 CONTINUE ICASL7='MPAR' ICASS7='CPL' GOTO8006 C 4815 CONTINUE ICASL7='MPAR' ICASS7='CPU' GOTO8006 C 4816 CONTINUE ICASL7='MPAR' ICASS7='CNPK' GOTO8006 C 4817 CONTINUE ICASL7='MPAR' ICASS7='CC' GOTO8006 C 4818 CONTINUE ICASL7='MPAR' ICASS7='PEDE' GOTO8007 C 4819 CONTINUE ICASL7='MPAR' ICASS7='EXLO' GOTO8007 C 4821 CONTINUE ICASL7='MPAR' ICASS7='PERC' GOTO8006 C 4822 CONTINUE ICASL7='MPAR' ICASS7='HAME' GOTO8007 C 4823 CONTINUE ICASL7='MPAR' ICASS7='GEME' GOTO8007 C 4824 CONTINUE ICASL7='MPAR' ICASS7='GESD' GOTO8007 C 4825 CONTINUE ICASL7='MPAR' ICASS7='GESD' GOTO8008 C 4826 CONTINUE ICASL7='MPAR' ICASS7='NOPP' GOTO8007 C 4831 CONTINUE ICASL7='MPAR' ICASS7='1DEC' GOTO8007 C 4832 CONTINUE ICASL7='MPAR' ICASS7='2DEC' GOTO8007 C 4833 CONTINUE ICASL7='MPAR' ICASS7='3DEC' GOTO8007 C 4834 CONTINUE ICASL7='MPAR' ICASS7='4DEC' GOTO8007 C 4835 CONTINUE ICASL7='MPAR' ICASS7='5DEC' GOTO8007 C 4836 CONTINUE ICASL7='MPAR' ICASS7='6DEC' GOTO8007 C 4837 CONTINUE ICASL7='MPAR' ICASS7='7DEC' GOTO8007 C 4838 CONTINUE ICASL7='MPAR' ICASS7='8DEC' GOTO8007 C 4839 CONTINUE ICASL7='MPAR' ICASS7='9DEC' GOTO8007 C 4841 CONTINUE ICASL7='MPAR' ICASS7='SN00' GOTO8007 C 4842 CONTINUE ICASL7='MPAR' ICASS7='SN0' GOTO8007 C 4843 CONTINUE ICASL7='MPAR' ICASS7='SN+' GOTO8007 C 4844 CONTINUE ICASL7='MPAR' ICASS7='SN-' GOTO8007 C 4846 CONTINUE ICASL7='MPAR' ICASS7='SN00' GOTO8006 C 4847 CONTINUE ICASL7='MPAR' ICASS7='SN0' GOTO8006 C 4848 CONTINUE ICASL7='MPAR' ICASS7='SN+' GOTO8006 C 4849 CONTINUE ICASL7='MPAR' ICASS7='SN-' GOTO8006 C 4851 CONTINUE ICASL7='MPAR' ICASS7='SIFR' GOTO8007 C 4852 CONTINUE ICASL7='MPAR' ICASS7='SIAM' GOTO8007 C 4854 CONTINUE ICASL7='MPAR' ICASS7='SNSC' GOTO8007 C 4856 CONTINUE ICASL7='MPAR' ICASS7='QNSC' GOTO8007 C 5002 CONTINUE ICASL7='MPIN' GOTO8005 C 5012 CONTINUE ICASL7='MQFO' GOTO8005 C 5022 CONTINUE ICASL7='MHT1' GOTO8007 C 5023 CONTINUE ICASL7='MHT2' GOTO8007 C 5032 CONTINUE ICASL7='MDER' GOTO8006 C 5034 CONTINUE ICASL7='MDEC' GOTO8006 C 5042 CONTINUE ICASL7='MDMR' GOTO8006 C 5044 CONTINUE ICASL7='MDMC' GOTO8006 C 5052 CONTINUE ICASL7='MQRD' GOTO8005 C 5062 CONTINUE ICASL7='MDKR' GOTO8006 C 5064 CONTINUE ICASL7='MDKC' GOTO8006 C 5072 CONTINUE ICASL7='MDBR' GOTO8006 C 5074 CONTINUE ICASL7='MDBC' GOTO8006 C 5082 CONTINUE ICASL7='MDCR' GOTO8006 C 5084 CONTINUE ICASL7='MDCC' GOTO8006 C 5086 CONTINUE ICASL7='MPVC' GOTO8007 C 5087 CONTINUE ICASL7='MPVC' GOTO8006 C 5088 CONTINUE ICASL7='MAAR' GOTO8006 C 5090 CONTINUE ICASL7='MADR' GOTO8006 C 5092 CONTINUE ICASL7='MAMM' GOTO8005 C 5093 CONTINUE ICASL7='MSUM' GOTO8005 C 5094 CONTINUE ICASL7='MADM' GOTO8006 C 5096 CONTINUE ICASL7='MALC' GOTO8005 C 5098 CONTINUE ICASL7='MAVT' GOTO8006 C 5102 CONTINUE ICASL7='MAGM' GOTO8006 C 5104 CONTINUE ICASL7='MAGS' GOTO8006 C 5106 CONTINUE ICASL7='MAGS' GOTO8007 C 5110 CONTINUE ICASL7='BINN' GOTO8005 C 5112 CONTINUE ICASL7='BINN' GOTO8006 C 5114 CONTINUE ICASL7='BINR' GOTO8006 C 5116 CONTINUE ICASL7='BINR' GOTO8007 C 5118 CONTINUE ICASL7='MVRN' GOTO8007 C 5119 CONTINUE ICASL7='MTRN' GOTO8007 C 5120 CONTINUE ICASL7='MACA' GOTO8005 C 5122 CONTINUE ICASL7='MURN' GOTO8006 C 5123 CONTINUE ICASL7='MPDF' GOTO8005 C 5124 CONTINUE ICASL7='WIRN' GOTO8006 C 5125 CONTINUE ICASL7='DIRN' GOTO8006 C 15125 CONTINUE ICASL7='DPDF' GOTO8005 C 5126 CONTINUE ICASL7='VINF' GOTO8006 C 15127 CONTINUE ICASL7='DLPD' GOTO8006 C 5128 CONTINUE ICASL7='CIND' GOTO8005 C 5130 CONTINUE ICASL7='XTXI' GOTO8005 C 5132 CONTINUE ICASL7='CRMA' GOTO8005 C 5152 CONTINUE ICASL7='WINS' GOTO8004 C 5154 CONTINUE ICASL7='NCDF' GOTO8006 C 5156 CONTINUE ICASL7='TCDF' GOTO8006 C 5158 CONTINUE ICASL7='IURN' GOTO8007 C 5160 CONTINUE ICASL7='INRN' GOTO8007 C 5190 CONTINUE ICASL7='FRAW' GOTO8006 C 5192 CONTINUE ICASL7='ASHR' GOTO8006 C 5193 CONTINUE ICASL7='ASHR' GOTO8005 C 5194 CONTINUE ICASL7='ASHC' GOTO8007 C 5195 CONTINUE ICASL7='IFRT' GOTO8008 C 5196 CONTINUE ICASL7='CFRT' GOTO8008 C 5197 CONTINUE ICASL7='MATB' GOTO8006 C 5198 CONTINUE ICASL7='MATB' GOTO8007 C 5199 CONTINUE ICASL7='MARB' GOTO8007 C 5202 CONTINUE ICASL7='HCON' GOTO8006 C 5203 CONTINUE ICASL7='HCON' GOTO8005 C 5204 CONTINUE ICASL7='KCON' GOTO8006 C 5205 CONTINUE ICASL7='KCON' GOTO8005 C 5206 CONTINUE ICASL7='HCO2' GOTO8007 C 5207 CONTINUE ICASL7='HCO2' GOTO8006 C 5208 CONTINUE ICASL7='KCO2' GOTO8007 C 5209 CONTINUE ICASL7='KCO2' GOTO8006 C 5211 CONTINUE ICASL7='LMOM' GOTO8005 C 5213 CONTINUE ICASL7='PWMO' GOTO8006 C 5215 CONTINUE ICASL7='BPWM' GOTO8007 C 6500 CONTINUE ICASL7='MGRA' ICASS7='MEAN' GOTO8006 C 6502 CONTINUE ICASL7='MGRA2' ICASS7='MIDM' GOTO8006 C 6512 CONTINUE ICASL7='MGRA' ICASS7='MEDI' GOTO8006 C 6522 CONTINUE ICASL7='MGRA' ICASS7='TRIM' GOTO8007 C 6524 CONTINUE ICASL7='MGRA' ICASS7='TRSE' GOTO8009 C 6532 CONTINUE ICASL7='MGRA' ICASS7='WINM' GOTO8007 C 6534 CONTINUE ICASL7='MGRA' ICASS7='HLEH' GOTO8007 C 6536 CONTINUE ICASL7='MGRA' ICASS7='BILO' GOTO8007 C 6538 CONTINUE ICASL7='MGRA' ICASS7='BISC' GOTO8007 C 6542 CONTINUE ICASL7='MGRA' ICASS7='SUM' GOTO8006 C 6545 CONTINUE ICASL7='MGRA' ICASS7='PROD' GOTO8006 C 6552 CONTINUE ICASL7='MGRA' ICASS7='SD' GOTO8006 C 6562 CONTINUE ICASL7='MGRA' ICASS7='SD' GOTO8007 C 6563 CONTINUE ICASL7='MGRA' ICASS7='BIMV' GOTO8007 C 6564 CONTINUE ICASL7='MGRA' ICASS7='PBMV' GOTO8008 C 6565 CONTINUE ICASL7='MGRA' ICASS7='WIVA' GOTO8007 C 6566 CONTINUE ICASL7='MGRA' ICASS7='WISD' GOTO8007 C 6567 CONTINUE ICASL7='MGRA' ICASS7='WISD' GOTO8008 C 6572 CONTINUE ICASL7='MGRA' ICASS7='SDME' GOTO8009 C 6582 CONTINUE ICASL7='MGRA' ICASS7='SDME' GOTO8008 C 6592 CONTINUE ICASL7='MGRA' ICASS7='VARI' GOTO8006 C 6602 CONTINUE ICASL7='MGRA' ICASS7='VAME' GOTO8008 C 6612 CONTINUE ICASL7='MGRA' ICASS7='REVA' GOTO8007 C 6622 CONTINUE ICASL7='MGRA' ICASS7='RESD' GOTO8007 C 6632 CONTINUE ICASL7='MGRA' ICASS7='RESD' GOTO8008 C 6642 CONTINUE ICASL7='MGRA' ICASS7='CVAR' GOTO8008 C 6652 CONTINUE ICASL7='MGRA' ICASS7='AAD' GOTO8008 C 6662 CONTINUE ICASL7='MGRA' ICASS7='MAD' GOTO8008 C 6672 CONTINUE ICASL7='MGRA' ICASS7='RANG' GOTO8006 C 6682 CONTINUE ICASL7='MGRA' ICASS7='MRAN' GOTO8006 C 6692 CONTINUE ICASL7='MGRA' ICASS7='MAXI' GOTO8006 C 6702 CONTINUE ICASL7='MGRA' ICASS7='MINI' GOTO8006 C 6712 CONTINUE ICASL7='MGRA' ICASS7='EXTR' GOTO8006 C 6722 CONTINUE ICASL7='MGRA' ICASS7='LOWH' GOTO8007 C 6732 CONTINUE ICASL7='MGRA' ICASS7='UPPH' GOTO8007 C 6742 CONTINUE ICASL7='MGRA' ICASS7='LOWQ' GOTO8007 C 6752 CONTINUE ICASL7='MGRA' ICASS7='UPPQ' GOTO8007 C 6762 CONTINUE ICASL7='MGRA' ICASS7='SKEW' GOTO8006 C 6772 CONTINUE ICASL7='MGRA' ICASS7='KURT' GOTO8006 C 6782 CONTINUE ICASL7='MGRA' ICASS7='AUCR' GOTO8006 C 6792 CONTINUE ICASL7='MGRA' ICASS7='AUCV' GOTO8006 C 6802 CONTINUE ICASL7='MCSC' GOTO8006 C 6803 CONTINUE ICASL7='MGRA' ICASS7='QUSE' GOTO8008 C 6804 CONTINUE ICASL7='MGRA' ICASS7='QUAN' GOTO8006 C 6811 CONTINUE ICASL7='MGRA' ICASS7='CP' GOTO8006 C 6812 CONTINUE ICASL7='MGRA' ICASS7='CPK' GOTO8006 C 6813 CONTINUE ICASL7='MGRA' ICASS7='CPM' GOTO8006 C 6814 CONTINUE ICASL7='MGRA' ICASS7='CPL' GOTO8006 C 6815 CONTINUE ICASL7='MGRA' ICASS7='CPU' GOTO8006 C 6816 CONTINUE ICASL7='MGRA' ICASS7='CNPK' GOTO8006 C 6817 CONTINUE ICASL7='MGRA' ICASS7='CC' GOTO8006 C 6818 CONTINUE ICASL7='MGRA' ICASS7='PEDE' GOTO8007 C 6819 CONTINUE ICASL7='MGRA' ICASS7='EXLO' GOTO8007 C 6821 CONTINUE ICASL7='MGRA' ICASS7='PERC' GOTO8006 C 6822 CONTINUE ICASL7='MGRA' ICASS7='HAME' GOTO8007 C 6823 CONTINUE ICASL7='MGRA' ICASS7='GEME' GOTO8007 C 6824 CONTINUE ICASL7='MGRA' ICASS7='GESD' GOTO8007 C 6825 CONTINUE ICASL7='MGRA' ICASS7='GESD' GOTO8008 C 6826 CONTINUE ICASL7='MGRA' ICASS7='NOPP' GOTO8007 C 6831 CONTINUE ICASL7='MGRA' ICASS7='1DEC' GOTO8007 C 6832 CONTINUE ICASL7='MGRA' ICASS7='2DEC' GOTO8007 C 6833 CONTINUE ICASL7='MGRA' ICASS7='3DEC' GOTO8007 C 6834 CONTINUE ICASL7='MGRA' ICASS7='4DEC' GOTO8007 C 6835 CONTINUE ICASL7='MGRA' ICASS7='5DEC' GOTO8007 C 6836 CONTINUE ICASL7='MGRA' ICASS7='6DEC' GOTO8007 C 6837 CONTINUE ICASL7='MGRA' ICASS7='7DEC' GOTO8007 C 6838 CONTINUE ICASL7='MGRA' ICASS7='8DEC' GOTO8007 C 6839 CONTINUE ICASL7='MGRA' ICASS7='9DEC' GOTO8007 C 6841 CONTINUE ICASL7='MGRA' ICASS7='SN00' GOTO8007 C 6842 CONTINUE ICASL7='MGRA' ICASS7='SN0' GOTO8007 C 6843 CONTINUE ICASL7='MGRA' ICASS7='SN+' GOTO8007 C 6844 CONTINUE ICASL7='MGRA' ICASS7='SN-' GOTO8007 C 6846 CONTINUE ICASL7='MGRA' ICASS7='SN00' GOTO8006 C 6847 CONTINUE ICASL7='MGRA' ICASS7='SN0' GOTO8006 C 6848 CONTINUE ICASL7='MGRA' ICASS7='SN+' GOTO8006 C 6849 CONTINUE ICASL7='MGRA' ICASS7='SN-' GOTO8006 C 6851 CONTINUE ICASL7='MGRA' ICASS7='SIFR' GOTO8007 C 6852 CONTINUE ICASL7='MGRA' ICASS7='SIAM' GOTO8007 C 6854 CONTINUE ICASL7='MGRA' ICASS7='SNSC' GOTO8007 C 6856 CONTINUE ICASL7='MGRA' ICASS7='QNSC' GOTO8007 C CCCCC THE FOLLOWING LONG SECTION IDENTIFIES THE SPECFIC STATISTIC CCCCC FOR THE "SORT BY" COMMAND 13002 CONTINUE ICASL7='SRTB' ICASS7='MEAN' GOTO8007 C 13004 CONTINUE ICASL7='SRTB' ICASS7='MIDM' GOTO8007 C 13006 CONTINUE ICASL7='SRTB' ICASS7='MAD ' GOTO8009 C 13008 CONTINUE ICASL7='SRTB' ICASS7='MAD ' GOTO8007 C 13010 CONTINUE ICASL7='SRTB' ICASS7='SNSC' GOTO8008 C 13012 CONTINUE ICASL7='SRTB' ICASS7='QNSC' GOTO8008 C 13014 CONTINUE ICASL7='SRTB' ICASS7='MEDI' GOTO8007 C 13016 CONTINUE ICASL7='SRTB' ICASS7='TMSE' GOTO8010 C 13018 CONTINUE ICASL7='SRTB' ICASS7='TRIM' GOTO8008 C 13020 CONTINUE ICASL7='SRTB' ICASS7='WINM' GOTO8008 C 13022 CONTINUE ICASL7='SRTB' ICASS7='SUM' GOTO8007 C 13024 CONTINUE ICASL7='SRTB' ICASS7='PROD' GOTO8007 C 13026 CONTINUE ICASL7='SRTB' ICASS7='SDME' GOTO8010 C 13028 CONTINUE ICASL7='SRTB' ICASS7='SD' GOTO8007 C 13030 CONTINUE ICASL7='SRTB' ICASS7='SDME' GOTO8009 C 13032 CONTINUE ICASL7='SRTB' ICASS7='SD' GOTO8008 C 13034 CONTINUE ICASL7='SRTB' ICASS7='VAME' GOTO8009 C 13036 CONTINUE ICASL7='SRTB' ICASS7='VARI' GOTO8007 C 13038 CONTINUE ICASL7='SRTB' ICASS7='REVA' GOTO8008 C 13040 CONTINUE ICASL7='SRTB' ICASS7='RESD' GOTO8008 C 13042 CONTINUE ICASL7='CT26' ICASS7='RESD' GOTO8009 C 13044 CONTINUE ICASL7='SRTB' ICASS7='CVAR' GOTO8009 C 13046 CONTINUE ICASL7='SRTB' ICASS7='AAD' GOTO8009 C 13048 CONTINUE ICASL7='SRTB' ICASS7='RANG' GOTO8009 C 13050 CONTINUE ICASL7='SRTB' ICASS7='MIDR' GOTO8007 C 13052 CONTINUE ICASL7='SRTB' ICASS7='MAXI' GOTO8007 C 13054 CONTINUE ICASL7='SRTB' ICASS7='MINI' GOTO8007 C 13056 CONTINUE ICASL7='SRTB' ICASS7='EXTR' GOTO8007 C 13058 CONTINUE ICASL7='SRTB' ICASS7='LOWH' GOTO8008 C 13060 CONTINUE ICASL7='SRTB' ICASS7='UPPH' GOTO8008 C 13062 CONTINUE ICASL7='SRTB' ICASS7='LOWQ' GOTO8008 C 13064 CONTINUE ICASL7='SRTB' ICASS7='UPPQ' GOTO8008 C 13066 CONTINUE ICASL7='SRTB' ICASS7='SKEW' GOTO8007 C 13068 CONTINUE ICASL7='SRTB' ICASS7='KURT' GOTO8007 C 13070 CONTINUE ICASL7='SRTB' ICASS7='AUCR' GOTO8007 C 13072 CONTINUE ICASL7='SRTB' ICASS7='AUCV' GOTO8007 C 13074 CONTINUE ICASL7='SRTB' ICASS7='IQRA' GOTO8008 C 13078 CONTINUE ICASL7='SRTB' ICASS7='BILO' GOTO8008 C 13080 CONTINUE ICASL7='SRTB' ICASS7='BISC' GOTO8008 C 13082 CONTINUE ICASL7='SRTB' ICASS7='BIMV' GOTO8008 C 13084 CONTINUE ICASL7='SRTB' ICASS7='WISD' GOTO8008 C 13086 CONTINUE ICASL7='SRTB' ICASS7='WISD' GOTO8009 C 13088 CONTINUE ICASL7='SRTB' ICASS7='WIVA' GOTO8008 C 13090 CONTINUE ICASL7='SRTB' ICASS7='PBMV' GOTO8009 C 13092 CONTINUE ICASL7='SRTB' ICASS7='HLEH' GOTO8008 C 13094 CONTINUE ICASL7='SRTB' ICASS7='QUSE' GOTO8009 C 13096 CONTINUE ICASL7='SRTB' ICASS7='QUAN' GOTO8007 C 13098 CONTINUE ICASL7='SRTB' ICASS7='CP' GOTO8007 C 13100 CONTINUE ICASL7='SRTB' ICASS7='CPK' GOTO8007 C 13102 CONTINUE ICASL7='SRTB' ICASS7='CPM' GOTO8007 C 13104 CONTINUE ICASL7='SRTB' ICASS7='CPL' GOTO8007 C 13106 CONTINUE ICASL7='SRTB' ICASS7='CPU' GOTO8007 C 13108 CONTINUE ICASL7='SRTB' ICASS7='CNPK' GOTO8007 C 13110 CONTINUE ICASL7='SRTB' ICASS7='CC' GOTO8007 C 13112 CONTINUE ICASL7='SRTB' ICASS7='PEDE' GOTO8008 C 13114 CONTINUE ICASL7='SRTB' ICASS7='EXLO' GOTO8008 C 13116 CONTINUE ICASL7='SRTB' ICASS7='PERC' GOTO8007 C 13118 CONTINUE ICASL7='SRTB' ICASS7='HAME' GOTO8008 C 13120 CONTINUE ICASL7='SRTB' ICASS7='GEME' GOTO8008 C 13122 CONTINUE ICASL7='SRTB' ICASS7='GESD' GOTO8008 C 13124 CONTINUE ICASL7='SRTB' ICASS7='GESD' GOTO8009 C 13126 CONTINUE ICASL7='SRTB' ICASS7='NOPP' GOTO8008 C 13128 CONTINUE ICASL7='SRTB' ICASS7='1DEC' GOTO8008 C 13130 CONTINUE ICASL7='SRTB' ICASS7='2DEC' GOTO8008 C 13132 CONTINUE ICASL7='SRTB' ICASS7='3DEC' GOTO8008 C 13134 CONTINUE ICASL7='SRTB' ICASS7='4DEC' GOTO8008 C 13136 CONTINUE ICASL7='SRTB' ICASS7='5DEC' GOTO8008 C 13138 CONTINUE ICASL7='SRTB' ICASS7='6DEC' GOTO8008 C 13140 CONTINUE ICASL7='SRTB' ICASS7='7DEC' GOTO8008 C 13142 CONTINUE ICASL7='SRTB' ICASS7='8DEC' GOTO8008 C 13144 CONTINUE ICASL7='SRTB' ICASS7='9DEC' GOTO8008 C 13146 CONTINUE ICASL7='SRTB' ICASS7='SN00' GOTO8008 C 13148 CONTINUE ICASL7='SRTB' ICASS7='SN0' GOTO8008 C 13150 CONTINUE ICASL7='SRTB' ICASS7='SN+' GOTO8008 C 13152 CONTINUE ICASL7='SRTB' ICASS7='SN-' GOTO8008 C 13154 CONTINUE ICASL7='SRTB' ICASS7='SN00' GOTO8007 C 13156 CONTINUE ICASL7='SRTB' ICASS7='SN0' GOTO8007 C 13158 CONTINUE ICASL7='SRTB' ICASS7='SN+' GOTO8007 C 13160 CONTINUE ICASL7='SRTB' ICASS7='SN-' GOTO8007 C 13162 CONTINUE ICASL7='SRTB' ICASS7='SIFR' GOTO8008 C 13164 CONTINUE ICASL7='SRTB' ICASS7='SIAM' GOTO8008 C C ***************************************************** C ** STEP 80- ** C ** DETERMINE IF THE WORD (OR COLUMN DESIGNATION) ** C ** AFTER THE KEY WORD (SORT, RANK, ETC.) IS A ** C ** VALID DATA VARIABLE OR COLUMN. ** C ** DEFINE ILOCV. ** C ***************************************************** C 8004 CONTINUE ILOCV=4 GOTO8020 C 8005 CONTINUE ILOCV=5 GOTO8020 C 8006 CONTINUE ILOCV=6 GOTO8020 C 8007 CONTINUE ILOCV=7 GOTO8020 CCCCC JULY 1993. FOLLOWING ADDED FOR SINGULAR VALUE DECOMPOSITION. 8008 CONTINUE ILOCV=8 GOTO8020 C CCCCC JUNE 1998. FOLLOWING ADDED FOR MATRIX 8009 CONTINUE ILOCV=9 GOTO8020 C 8010 CONTINUE ILOCV=10 GOTO8020 C 8011 CONTINUE ILOCV=11 GOTO8020 C 8020 CONTINUE IF(ILOCV.GT.NUMARG)GOTO8039 CCCCC OCTOBER 1993. JACKNIFE INDEX HAS PARAMETER ARGUMENTS IF(ICASL7.EQ.'JAIN')GOTO8040 IH=IHARG(ILOCV) IH2=IHARG2(ILOCV) DO8030I=1,NUMNAM IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO8040 IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'M')GOTO8040 8030 CONTINUE 8039 CONTINUE IFOUN7='NO' ICASL7='UNKN' GOTO9000 8040 CONTINUE IFOUN7='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE C IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MATH')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKMATH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IBUGA3,ISUBRO 9013 FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IFOUN7,ICASL7,IMSUBC,ILOCV 9014 FORMAT('IFOUN7,ICASL7,IMSUBC,ILOCV = ',A4,2X,A4,2X,A4,I8) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CKPREF(ICASFI,ILOCFI,IBUGA3,IFOUND,IERROR) C C PURPOSE--CHECK TO SEE THE TYPE OF PRE-FIT COMMAND C THAT HAS BEEN GIVEN C (E.G., WHAT DEGREE). C OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO') C --IERROR ('YES' OR 'NO') C --ICASFI ('FIT', '1FIT', '2FIT', '3FIT', ETC.) C --ILOCFI (AN INTEGER VALUE WHICH GIVES C THE ARGUMENT NUMBER (1, 2, 3, ...) C OF THE WORD FIT . C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--AUGUST 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASFI CHARACTER*4 IBUGA3 CHARACTER*4 IFOUND CHARACTER*4 IERROR C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C C ***************************** C ** CHECK FOR PRE-FITTING ** C ***************************** C IFOUND='NO' IERROR='NO' ICASFI='UNKN' ILOCFI=-99 C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKPREF--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)NUMARG 53 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ICOM,ICOM2 54 FORMAT('ICOM,ICOM2 = ',A4,A4) CALL DPWRST('XXX','BUG ') DO55I=1,NUMARG WRITE(ICOUT,56)I,IHARG(I),IHARG2(I) 56 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,2X,A4) CALL DPWRST('XXX','BUG ') 55 CONTINUE 90 CONTINUE C C ********************************* C ** STEP 1.1-- ** C ** SEARCH FOR PRE-FIT ** C ** (WITH UNSPECIFIED DEGREE) ** C ********************************* C ICASFI='FIT' C IF(ICOM.EQ.'PREF')GOTO110 IF(ICOM.EQ.'PRE ')GOTO111 C DO210I=1,NUMARG I2=I IF(IHARG(I).EQ.'PREF'.AND.IHARG2(I).EQ.'IT ')GOTO219 210 CONTINUE GOTO249 219 CONTINUE C NUMARG=NUMARG+1 I2P1=I2+1 IF(I2P1.GT.NUMARG)GOTO239 DO230I=I2P1,NUMARG IREV=NUMARG-I+I2P1 IREVM1=IREV-1 IHARG(IREV)=IHARG(IREVM1) IHARG2(IREV)=IHARG2(IREVM1) IARGT(IREV)=IARGT(IREVM1) ARG(IREV)=ARG(IREVM1) 230 CONTINUE 239 CONTINUE C IHARG(I2)='PRE ' IHARG2(I2)=' ' IARGT(I2)='WORD' IARG(I2)=-999 ARG(I2)=-999.0 IHARG(I2P1)='FIT ' IHARG2(I2P1)=' ' IARGT(I2P1)='WORD' IARG(I2P1)=-999 ARG(I2P1)=-999.0 249 CONTINUE C C ********************************* C ** STEP 1.2-- ** C ** SEARCH FOR ROBUST FITTING ** C ********************************* C ICASFI='RFIT' C IF(NUMARG.GE.2.AND. 1ICOM.EQ.'ROBU'.AND.IHARG(2).EQ.'PRE ')GOTO113 C C ******************************************* C ** STEP 1.20-- ** C ** SEARCH FOR 0-TH DEGREE FITTING ** C ******************************************* C ICASFI='0FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'0'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'0TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'ZERO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'0'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'0'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ZERO'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'CONS'.AND.IHARG(1).EQ.'PRE ')GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'RECT'.AND.IHARG(1).EQ.'PRE ')GOTO112 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'FLAT'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.21-- ** C ** SEARCH FOR 1-ST DEGREE FITTING ** C ******************************************* C ICASFI='1FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'1'.AND.IHARG(1).EQ.'ST'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'1ST'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'1'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'ONE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'1'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ONE'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.22-- ** C ** SEARCH FOR 2-ND DEGREE FITTING ** C ******************************************* C ICASFI='2FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'2'.AND.IHARG(1).EQ.'ND'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'2ND'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'2'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'TWO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'2'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TWO'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.23-- ** C ** SEARCH FOR 3-RD DEGREE FITTING ** C ******************************************* C ICASFI='3FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'3'.AND.IHARG(1).EQ.'RD'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'3RD'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'3'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'THRE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'3'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'THRE'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'CUBI'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.24-- ** C ** SEARCH FOR 4-TH DEGREE FITTING ** C ******************************************* C ICASFI='4FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'4'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'4TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'4'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'4'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FOUR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'QUAR'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.25-- ** C ** SEARCH FOR 5-TH DEGREE FITTING ** C ******************************************* C ICASFI='5FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'5'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'5TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FIFT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'5'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'FIVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'5'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FIVE'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'QUIN'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.26-- ** C ** SEARCH FOR 6-TH DEGREE FITTING ** C ******************************************* C ICASFI='6FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'6'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'6TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SIXT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'6'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SIX'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'6'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SIX'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'SEXT'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.27-- ** C ** SEARCH FOR 7-TH DEGREE FITTING ** C ******************************************* C ICASFI='7FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'7'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'7TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'7'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'7'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SEVE'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'SEPT'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.28-- ** C ** SEARCH FOR 8-TH DEGREE FITTING ** C ******************************************* C ICASFI='8FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'8'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'8TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'8'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'8'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'EIGH'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'OCTI'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.29-- ** C ** SEARCH FOR 9-TH DEGREE FITTING ** C ******************************************* C ICASFI='9FIT' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'9'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'9TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'NINT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'9'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'NINE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'9'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'NINE'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'NONI'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************* C ** STEP 1.20-- ** C ** SEARCH FOR 10-TH DEGREE FITTING ** C ******************************************* C ICASFI='10FI' C IF(NUMARG.GE.3.AND. 1ICOM.EQ.'10'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND. 1IHARG(3).EQ.'PRE ')GOTO114 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'10TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'TENT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'10'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'TEN'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'10'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.2.AND. 1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TEN'.AND.IHARG(2).EQ.'PRE ') 1GOTO113 IF(NUMARG.GE.1.AND. 1ICOM.EQ.'DEXI'.AND.IHARG(1).EQ.'PRE ')GOTO112 C C ******************************************** C ** STEP 1.31-- ** C ** SINCE VALID COMMAND NOT FOUND, EXIT. ** C ******************************************** C ICASFI=' ' C IFOUND='NO' GOTO9000 C 110 CONTINUE ILASTC=0 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO180 C 111 CONTINUE ILASTC=1 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO180 C 112 CONTINUE ILASTC=2 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO180 C 113 CONTINUE ILASTC=3 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO180 C 114 CONTINUE ILASTC=4 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO180 C 180 CONTINUE ILOCFI=ILASTC IFOUND='YES' GOTO190 C 190 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKPREF--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IFOUND,IERROR 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)ICASFI,ILOCFI 9013 FORMAT('ICASFI,ILOCFI = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)NUMARG 9016 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)ICOM,ICOM2 9017 FORMAT('ICOM,ICOM2 = ',A4,A4) CALL DPWRST('XXX','BUG ') DO9020I=1,NUMARG WRITE(ICOUT,9021)I,IHARG(I),IHARG2(I) 9021 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9020 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE CKPRPA(ANOPL1,ANOPL2,IBUGG3,ISUBRO,IERROR) C C PURPOSE--CHECK THE PARAMETERS NEEDED C FOR THE PROPORTION (= ANOP) STATISTIC. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--89/6 C ORIGINAL VERSION--MAY 1988. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGG3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 IHP CHARACTER*4 IHP2 CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CCCCC CHARACTER*4 IWRITE C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CCCCC CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.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='CKPR' ISUBN2='PA ' C IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PRPA')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKPRPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR 52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C -------------------------- C IHP='LOWE' IHP2='R ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO1110 ANOPL1=VALUE(ILOCP) GOTO1119 C 1110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1111) 1111 FORMAT('***** ERROR IN CKPRPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1112) 1112 FORMAT(' IN COMPUTING THE PROPORTION STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1114) 1114 FORMAT(' THE LOWER BOUND (PARAMETER LOWER) OF THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115) 1115 FORMAT(' REGION OF INTEREST MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1116) 1116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE LOWER,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117) 1117 FORMAT(' AS IN LET LOWER = 900') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1119 CONTINUE C C -------------------------- C IHP='UPPE' IHP2='R ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO2110 ANOPL2=VALUE(ILOCP) GOTO2119 C 2110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2111) 2111 FORMAT('***** ERROR IN CKPRPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2112) 2112 FORMAT(' IN COMPUTING THE PROPORTION STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2114) 2114 FORMAT(' THE UPPER BOUND (PARAMETER UPPER) OF THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2115) 2115 FORMAT(' REGION OF INTEREST MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2116) 2116 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE UPPER,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2117) 2117 FORMAT(' AS IN LET UPPER = 1100') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 2119 CONTINUE C C -------------------------- C IF(ANOPL1.LT.ANOPL2)GOTO3129 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3111) 3111 FORMAT('***** ERROR IN CKPRPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3112) 3112 FORMAT(' IN COMPUTING THE PROPORTION STATISTIC,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3114) 3114 FORMAT(' THE VALUE OF THE LOWER REGION LIMIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3115) 3115 FORMAT(' (PARAMETER LOWER) MUST BE STRICTLY') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3116) 3116 FORMAT(' LESS THAN THE VALUE OF THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3117) 3117 FORMAT(' UPPER REGION LIMIT (PARAMETER UPPER).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3118) 3118 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3119)ANOPL1 3119 FORMAT(' LOWER = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3120)ANOPL2 3120 FORMAT(' UPPER = ',E15.7) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 3129 CONTINUE C C ****************** C ** STEP 90-- ** C ** EXIT ** C ****************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PRPA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKPRPA--') 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)ANOPL1,ANOPL2 9013 FORMAT('ANOPL1,ANOPL2 = ',2E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CKPRSC(X,N,ISORSW,ICASAX, 1ISUBG4,IBUGPL,IERRG4) C C PURPOSE--CHECK THAT ALL DATA IN X(.) ARE VALID C (IN THIS CASE, MEANING 0 < X(.) < 100 ) C IN PREPARATION FOR A PROBABILITY SCALE TRANSFORMATION. C (SUCH AS (0 TO 100) WEIBULL OR NORMAL) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--88.10 C ORIGINAL VERSION--MAY 1983. C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1988. C UPDATED --JULY 1993 ADD NORMAL TO WEIBULL C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CHARACTER*4 ISORSW CHARACTER*4 ICASAX C CHARACTER*4 ISUBG4 CHARACTER*4 IBUGPL CHARACTER*4 IERRG4 C C--------------------------------------------------------------------- C DIMENSION X(*) 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 IERRG4='NO' AHUNDR=100.0 C IF(IBUGPL.EQ.'OFF'.AND.ISUBG4.NE.'PRSC')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKPRSC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGPL,ISUBG4,IERRG4 52 FORMAT('IBUGPL,ISUBG4,IERRG4 = ',3A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)ISORSW,ICASAX 53 FORMAT('ISORSW,ICASAX = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)N 61 FORMAT('N = ',I8) CALL DPWRST('XXX','BUG ') DO62I=1,N WRITE(ICOUT,63)I,X(I) 63 FORMAT('I,X(I) = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 62 CONTINUE 90 CONTINUE C C ************************************************** C ** STEP 11-- ** C ** CHECK THAT ALL X(.) ARE > 0 AND < 100 ** C ************************************************** C DO1135I=1,N J=I IF(X(J).LE.0.0.OR.X(J).GE.100.0)GOTO1150 1135 CONTINUE GOTO9000 C 1150 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1151) 1151 FORMAT('***** ERROR IN CKPRSC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1152) 1152 FORMAT(' AN ILLEGAL DATA OR LIMITS VALUE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1153) 1153 FORMAT(' WAS ENCOUNTERED IN FORMING A PLOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1154) 1154 FORMAT(' DATA MUST BE STRICTLY GREATER THAN 0') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1155) 1155 FORMAT(' AND STRICTLY LESS THAN 100') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1156) 1156 FORMAT(' WHEN A WEIBULL OR NORMAL SCALE PLOT IS USED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1157)X(J) 1157 FORMAT(' THE VALUE = ',E15.7) CALL DPWRST('XXX','BUG ') 1160 FORMAT(' THIS VALUE CAME FROM THE ') IF(ICASAX.EQ.'2DHO')WRITE(ICOUT,1161) 1161 FORMAT(' 2-D HORIZONTAL AXIS VARIABLE.') IF(ICASAX.EQ.'2DHO')CALL DPWRST('XXX','BUG ') IF(ICASAX.EQ.'2DVE')WRITE(ICOUT,1162) 1162 FORMAT(' 2-D VERTICAL AXIS VARIABLE.') IF(ICASAX.EQ.'2DVE')CALL DPWRST('XXX','BUG ') IF(ICASAX.EQ.'3DH1')WRITE(ICOUT,1163) 1163 FORMAT(' FIRST 3-D HORIZONTAL AXIS VARIABLE.') IF(ICASAX.EQ.'3DH1')CALL DPWRST('XXX','BUG ') IF(ICASAX.EQ.'3DH2')WRITE(ICOUT,1164) 1164 FORMAT(' 2ND 3-D HORIZONTAL AXIS VARIABLE.') IF(ICASAX.EQ.'3DH2')CALL DPWRST('XXX','BUG ') IF(ICASAX.EQ.'3DVE')WRITE(ICOUT,1165) 1165 FORMAT(' 3-D VERTICAL AXIS VARIABLE.') IF(ICASAX.EQ.'3DVE')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1171) 1171 FORMAT(' CORRECTIVE ACTION--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1172) 1172 FORMAT(' CHANGE DATA OR CHANGE LIMITS.') CALL DPWRST('XXX','BUG ') IERRG4='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGPL.EQ.'OFF'.AND.ISUBG4.NE.'PRSC')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKPRSC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGPL,ISUBG4,IERRG4 9012 FORMAT('IBUGPL,ISUBG4,IERRG4 = ',3A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)ISORSW,ICASAX 9013 FORMAT('ISORSW,ICASAX = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)N,J 9021 FORMAT('N,J = ',2I8) CALL DPWRST('XXX','BUG ') DO9022I=1,N WRITE(ICOUT,9023)I,X(I) 9023 FORMAT('I,X(I) = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 9022 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE CKRAND(ICASRA,ILOCNU,IBUGA3,IFOUND,IERROR) C C PURPOSE--CHECK TO SEE IF A RANDOM NUMBER C COMMAND HAS BEEN GIVEN. C OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO') C --IERROR ('YES' OR 'NO') C --ICASRA ('UNIF', 'NORM', 'LOGI', ETC.) C --ILOCNU (AN INTEGER VALUE WHICH GIVES C THE ARGUMENT NUMBER (1, 2, 3, ...) C OF THE WORD NUMBER . C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--MAY 1978. C UPDATED --JUNE 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --MAY 1982. C UPDATED --DECEMBER 1988. EXTENSIVE. TO SIMPLIFY CALL C UPDATED --DECEMBER 1988. DISCRETE UNIFORM C UPDATED --DECEMBER 1988. BOOTSTRAP INDEX C UPDATED --DECEMBER 1988. RANDOM INDEX = BOOTSTRAP INDEX C UPDATED --DECEMBER 1988. RANDOM PERMUTATION C UPDATED --DECEMBER 1988. RAND SAMP FOR RAND NUMB C UPDATED --JANUARY 1988. JACKNIFE INDEX C UPDATED --MAY 1990. IG, WALD, RIG, FL (SAUNDERS) C UPDATED --MAY 1993. ADD GUMBEL AND FRECHET NAMES C UPDATED --OCTOBER 1993. MOVED JACKNIFE INDEX TO CKMATH C UPDATED --DECEMBER 1993. ADD EV1 AND EV2 NAMES C UPDATED --DECEMBER 1993. GENERALIZED PARETO C UPDATED --APRIL 1995. POWER FUNCTION C UPDATED --AUGUST 1995. HYPERGEOMETRIC C UPDATED --AUGUST 1995. NON-CENTRAL CHI-SQUARE C UPDATED --AUGUST 1995. NON-CENTRAL F C UPDATED --AUGUST 1995. DOUBLY NON-CENTRAL F C UPDATED --OCTOBER 1995. FOLDED NORMAL C UPDATED --OCTOBER 1995. HALF-CAUCHY C UPDATED --MAY 1998. NORMAL MIXTURE C UPDATED --MAY 1998. POWER LAW C UPDATED --AUGUST 2001. GENERALIZED LAMBDA C UPDATED --SEPTEMBER 2001. INVERTED WEIBULL C UPDATED --OCTOBER 2001. DOUBLE WEIBULL C UPDATED --OCTOBER 2001. DOUBLE GAMMA C UPDATED --OCTOBER 2001. LOG GAMMA C UPDATED --OCTOBER 2001. INVERTED GAMMA C UPDATED --OCTOBER 2001. COSINE C UPDATED --OCTOBER 2001. ANGLIT C UPDATED --OCTOBER 2001. HYPERBOLIC SECANT C UPDATED --OCTOBER 2001. ARCSIN C UPDATED --OCTOBER 2001. LOG DOUBLE EXPONENTIAL C UPDATED --OCTOBER 2001. GENERALIZED EXTREME VALUE C UPDATED --OCTOBER 2001. EXPONENTIATED WEIBULL C UPDATED --OCTOBER 2001. GOMPERTZ C UPDATED --OCTOBER 2001. HALF-LOGISTIC C UPDATED --OCTOBER 2001. POWER EXPONENTIAL C UPDATED --OCTOBER 2001. ALPHA C UPDATED --OCTOBER 2001. BRADFORD C UPDATED --OCTOBER 2001. RECIPROCAL C UPDATED --OCTOBER 2001. JOHNSON SU C UPDATED --OCTOBER 2001. JOHNSON SB C UPDATED --OCTOBER 2001. POWER NORMAL C UPDATED --OCTOBER 2001. LOG-LOGISTIC C UPDATED --NOVEMBER 2001. GEOMETRIC EXTREME EXPONENTIAL C UPDATED --NOVEMBER 2001. POWER LOGNORMAL C UPDATED --DECEMBER 2001. BETA-BINOMIAL C UPDATED --MAY 2002. TWO-SIDED POWER C UPDATED --MAY 2002. BIWEIBULL C UPDATED --AUGUST 2002. LOGARITHMIC SERIES C UPDATED --JANUARY 2003. G-AND-H C UPDATED --JANUARY 2003. SLASH C UPDATED --APRIL 2003. LANDAU C UPDATED --MAY 2003. INVERTED BETA C UPDATED --MAY 2003. ERROR (OR SUBBOTIN OR C EXPONENTIAL POWER) C UPDATED --JUNE 2003. TRAPEZOID, VON MISES, C PARETO SECOND KIND, C WRAPPED CAUCHY, C GENERALIZED TRAPEZOID C UPDATED --JULY 2003. TRUNCATED NORMAL, CHI, C FOLDED CAUCHY, C MIELKE BETA-KAPPA, C TRUNCATED EXPONENTIAL, C GENERALIZED EXPONENTIAL C UPDATED --SEPTEMBER 2003. GENERALIZED GAMMA C UPDATED --NOVEMBER 2003. FOLDED T C UPDATED --NOVEMBER 2003. SKEWED T C UPDATED --NOVEMBER 2003. SKEWED NORMAL C UPDATED --NOVEMBER 2003. ZIPF C UPDATED --DECEMBER 2003. GOMPERTZ-MAKEM C UPDATED --DECEMBER 2003. GENERALIZED INVERSE GAUSSIAN C UPDATED --MARCH 2004. LOG SKEWED T C UPDATED --MARCH 2004. LOG SKEWED NORMAL C UPDATED --MARCH 2004. NON-CENTRAL T C UPDATED --MARCH 2004. DOUBLY NON-CENTRAL T C UPDATED --MARCH 2004. GENERALIZED LOGISTIC C UPDATED --MARCH 2004. GENERALIZED HALF-LOGISTIC C UPDATED --MARCH 2004. POLYA C UPDATED --APRIL 2004. HERMITE C UPDATED --APRIL 2004. YULE C UPDATED --APRIL 2004. WARING C UPDATED --APRIL 2004. GENERALIZED WARING C UPDATED --APRIL 2004. NON-CENTRAL BETA C UPDATED --MAY 2004. DOUBLY NON-CENTRAL BETA C UPDATED --JUNE 2004. SKEW DOUBLE EXPONENTIAL C UPDATED --JUNE 2004. ASYMMETRIC DOUBLE EXPONENTIAL C UPDATED --JUNE 2004. GENERALIZED ASYMMETRIC LAPLACE C UPDATED --JUNE 2004. MAXWELL C UPDATED --JUNE 2004. RAYLEIGH C UPDATED --AUGUST 2004. MCLEISH C UPDATED --AUGUST 2004. BESSEL I FUNCTION C UPDATED --AUGUST 2004. BESSEL K FUNCTION C UPDATED --SEPTEMBER 2004. GENERALIZED MCLEISH C UPDATED --SEPTEMBER 2004. HYPERBOLIC C UPDATED --FEBRUARY 2006. GENERALIZED LOGISTIC TYPE 5 C UPDATED --FEBRUARY 2006. WAKEBY C UPDATED --MARCH 2006. BETA-NORMAL C UPDATED --MARCH 2006. GENERALIZED LOGISTIC TYPE 2 C UPDATED --MARCH 2006. GENERALIZED LOGISTIC TYPE 3 C UPDATED --MARCH 2006. GENERALIZED LOGISTIC TYPE 4 C UPDATED --MARCH 2006. ASYMMETRIC LOG LAPLACE C UPDATED --MAY 2006. BETA-GEOMETRIC C UPDATED --MAY 2006. ZETA C UPDATED --MAY 2006. BOREL-TANNER C UPDATED --MAY 2006. BETA-NEGATIVE BINOMIAL C (SYNONYM FOR GENERALZIED C WARING) C UPDATED --JUNE 2006. LAGRANGE POISSON C UPDATED --JUNE 2006. LEADS IN COIN TOSSING C (DISCRETE ARCSINE) C UPDATED --JUNE 2006. MATCHING C UPDATED --JUNE 2006. CLASSICAL OCCUPANCY (NOT ACTIVE) C UPDATED --JUNE 2006. LOG BETA (NOT ACTIVE) C UPDATED --JUNE 2006. POLYA-AEPPLI C UPDATED --JUNE 2006. LOST GAMES C UPDATED --JUNE 2006. NEYMAN TYPE A (NOT ACTIVE) C UPDATED --JUNE 2006. DXG (NOT ACTIVE) C UPDATED --JUNE 2006. GENERALIZED LOGARITHMIC SERIES C UPDATED --JULY 2006. GENERALIZED NEGATIVE BINOMIAL C UPDATED --JULY 2006. GEETA C UPDATED --JULY 2006. QUASI BINOMIAL TYPE I C UPDATED --JULY 2006. POISSON-INVERSE GAUSSIAN C (NOT ACTIVE) C UPDATED --AUGUST 2006. CONSUL C UPDATED --AUGUST 2006. LAGRANGE KATZ (NOT ACTIVE) C UPDATED --SEPTEMBER 2006. KATZ (NOT ACTIVE) C UPDATED --NOVEMBER 2006. DISCRETE WEIBULL C UPDATED --NOVEMBER 2006. GENERALIZED LOST GAMES C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASRA CHARACTER*4 IBUGA3 CHARACTER*4 IFOUND CHARACTER*4 IERROR C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C C ****************************************** C ** CHECK FOR RANDOM NUMBER GENERATION ** C ****************************************** C IFOUND='NO' IERROR='NO' ICASRA='UNKN' C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKRAND--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)NUMARG 53 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') DO55I=1,NUMARG WRITE(ICOUT,56)I,IHARG(I),IHARG2(I) 56 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,2X,A4) CALL DPWRST('XXX','BUG ') 55 CONTINUE 90 CONTINUE C IF(NUMARG.LE.4)GOTO9000 JMAX=NUMARG-1 DO100J=1,JMAX JP1=J+1 CCCCC IF(IHARG(J).EQ.'RAND'.AND.IHARG2(J).EQ.'OM '.AND. CCCCC1 IHARG(JP1).EQ.'NUMB'.AND.IHARG2(JP1).EQ.'ERS ') CCCCC1 GOTO190 IF(J.GE.4.AND.IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'NUMB')GOTO190 IF(J.GE.4.AND.IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'SAMP')GOTO190 IF(IHARG(J).EQ.'BOOT'.AND.IHARG(JP1).EQ.'INDE')GOTO190 IF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'INDE')GOTO190 CCCCC OCTOBER 1993. JACKNIFE INDEX TO CKMATH CCCCC IF(IHARG(J).EQ.'JACK'.AND.IHARG(JP1).EQ.'INDE')GOTO190 IF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'PERM')GOTO190 100 CONTINUE GOTO9000 190 CONTINUE C IF(IHARG(3).EQ.'UNIF')GOTO1101 IF(IHARG(3).EQ.'RECT')GOTO1101 CCCCC ADD FOLLOWING 2 LINES MAY 1998. IF(IHARG(3).EQ.'NORM'.AND.IHARG(4).EQ.'MIXT')GOTO2201 IF(IHARG(3).EQ.'GAUS'.AND.IHARG(4).EQ.'MIXT')GOTO2201 IF(IHARG(3).EQ.'NORM')GOTO1102 IF(IHARG(3).EQ.'GAUS')GOTO1102 IF(IHARG(3).EQ.'LOGI')GOTO1103 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'DOUB'.AND. 1 IHARG(4).EQ.'EXPO')GOTO1104 IF(IHARG(3).EQ.'LAPL')GOTO1151 IF(IHARG(3).EQ.'CAUC')GOTO1105 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'TUKE'.AND. 1 IHARG(4).EQ.'LAMB')GOTO1152 IF(IHARG(3).EQ.'TUKE')GOTO1106 IF(IHARG(3).EQ.'LAMB')GOTO1106 IF(IHARG(3).EQ.'LOGN')GOTO1107 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'LOG '.AND. 1 IHARG(4).EQ.'NORM')GOTO1153 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'HALF'.AND. 1 IHARG(4).EQ.'NORM')GOTO1154 CCCCC OCTOBER 1995. NAME CONFLICT WITH HALF-CAUCHY CCCCC OCTOBER 2001. NAME CONFLICT WITH HALF-LOGISTIC CCCCC IF(IHARG(3).EQ.'HALF')GOTO1108 IF(IHARG(3).EQ.'HALF'.AND.IHARG(4).NE.'CAUC'.AND. 1 IHARG(4).NE.'LOGI')GOTO1108 IF(IHARG(3).EQ.'T ')GOTO1109 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'STUD'.AND. 1 IHARG(4).EQ.'T ')GOTO1155 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GOSS'.AND. 1 IHARG(4).EQ.'T ')GOTO1155 IF(IHARG(3).EQ.'CHIS')GOTO1110 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'CHI '.AND. 1 IHARG(4).EQ.'SQUA')GOTO1156 IF(IHARG(3).EQ.'F ')GOTO1111 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'SNED'.AND. 1 IHARG(4).EQ.'F ')GOTO1157 CCCCC CHECK FOR NAME CONFLICT WITH EXPONENTIATED WEIBULL. OCTOBER 2001 IF(IHARG(3).EQ.'EXPO'.AND.IHARG(4).NE.'WEIB')GOTO1112 IF(IHARG(3).EQ.'GAMM')GOTO1113 IF(IHARG(3).EQ.'BETA' .AND. 1 (IHARG(4).NE.'BINO' .AND. IHARG(4).NE.'NORM' .AND. 1 IHARG(4).NE.'GEOM' .AND. IHARG(4).NE.'NEGA'))GOTO1114 IF(IHARG(3).EQ.'WEIB')GOTO1115 IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'EXTR'.AND. 1 IHARG(4).EQ.'VALU'.AND. 1 IHARG(5).EQ.'TYPE'.AND. 1 IHARG(6).EQ.'1 ')GOTO1116 IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'EXTR'.AND. 1 IHARG(4).EQ.'VALU'.AND. 1 IHARG(5).EQ.'TYPE'.AND. 1 IHARG(6).EQ.'I ')GOTO1116 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'EXTR'.AND. 1 IHARG(4).EQ.'VALU'.AND. 1 IHARG(5).EQ.'1 ')GOTO1158 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'EXTR'.AND. 1 IHARG(4).EQ.'VALU'.AND. 1 IHARG(5).EQ.'I ')GOTO1158 CCCCC THE FOLLOWING LINE WAS ADDED MAY 1993 IF(IHARG(3).EQ.'GUMB')GOTO1162 CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1993 IF(IHARG(3).EQ.'EV1 ')GOTO1162 IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'EXTR'.AND. 1 IHARG(4).EQ.'VALU'.AND. 1 IHARG(5).EQ.'TYPE'.AND. 1 IHARG(6).EQ.'2 ')GOTO1117 IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'EXTR'.AND. 1 IHARG(4).EQ.'VALU'.AND. 1 IHARG(5).EQ.'TYPE'.AND. 1 IHARG(6).EQ.'II ')GOTO1117 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'EXTR'.AND. 1 IHARG(4).EQ.'VALU'.AND. 1 IHARG(5).EQ.'2 ')GOTO1160 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'EXTR'.AND. 1 IHARG(4).EQ.'VALU'.AND. 1 IHARG(5).EQ.'II ')GOTO1160 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'EXTR'.AND. 1 IHARG(4).EQ.'VALU')GOTO1159 CCCCC THE FOLLOWING LINE WAS ADDED MAY 1993 IF(IHARG(3).EQ.'FREC')GOTO1163 CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1993 IF(IHARG(3).EQ.'EV2 ')GOTO1163 IF(IHARG(3).EQ.'PARE'.AND.IHARG(4).NE.'SECO'.AND. 1 IHARG(4).NE.'2ND'.AND.IHARG(4).NE.'TYPE')GOTO1118 IF(IHARG(3).EQ.'BINO')GOTO1119 IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).NE.'EXTR')GOTO1120 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'POIS'.AND.IHARG(4).EQ.'INVE'.AND. 1 IHARG(5).EQ.'GAUS')GOTO2402 IF(IHARG(3).EQ.'POIS')GOTO1121 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'NEGA'.AND. 1 IHARG(4).EQ.'BINO')GOTO1122 IF(IHARG(3).EQ.'SEMI')GOTO1123 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'SEMI'.AND. 1 IHARG(4).EQ.'CIRC')GOTO1161 IF(IHARG(3).EQ.'TRIA')GOTO1124 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'DISC'.AND. 1 IHARG(4).EQ.'UNIF')GOTO1125 IF(NUMARG.GE.4.AND. 1 IHARG(3).EQ.'BOOT'.AND. 1 IHARG(4).EQ.'INDE')GOTO1126 IF(NUMARG.GE.4.AND. 1 IHARG(3).EQ.'RAND'.AND. 1 IHARG(4).EQ.'INDE')GOTO1126 CCCCC IF(NUMARG.GE.4.AND. CCCCC1 IHARG(3).EQ.'JACK'.AND. CCCCC1 IHARG(4).EQ.'INDE')GOTO1127 IF(NUMARG.GE.4.AND. 1 IHARG(3).EQ.'RAND'.AND. 1 IHARG(4).EQ.'PERM')GOTO1131 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 IF(NUMARG.GE.4.AND. 1 IHARG(3).EQ.'INVE'.AND. 1 IHARG(4).EQ.'GAUS')GOTO1132 IF(IHARG(3).EQ.'IG')GOTO1133 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 IF(IHARG(3).EQ.'WALD')GOTO1134 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'RECI'.AND. 1 IHARG(4).EQ.'INVE'.AND. 1 IHARG(5).EQ.'GAUS')GOTO1135 IF(IHARG(3).EQ.'RIG')GOTO1136 IF(IHARG(3).EQ.'TWEE')GOTO1136 IF(NUMARG.GE.4.AND. 1 IHARG(3).EQ.'BIRN'.AND. 1 IHARG(4).EQ.'SAUN')GOTO1137 IF(NUMARG.GE.4.AND. 1 IHARG(3).EQ.'SAUN'.AND. 1 IHARG(4).EQ.'BIRN')GOTO1137 C IF(NUMARG.GE.4.AND. 1 IHARG(3).EQ.'FATI'.AND. 1 IHARG(4).EQ.'LIFE')GOTO1138 IF(IHARG(3).EQ.'FL')GOTO1139 C CCCCC THE FOLLOWING 2 LINES WERE ADDED DECEMBER 1993 IF(IHARG(3).EQ.'GEP ')GOTO1164 IF(IHARG(3).EQ.'GP ')GOTO1164 C CCCCC THE FOLLOWING 3 LINES WAS ADDED DECEMBER 1993 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GENE'.AND. 1 IHARG(4).EQ.'PARE')GOTO1165 C CCCCC THE FOLLOWING 3 LINES WAS ADDED APRIL 1995 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'POWE'.AND. 1 IHARG(4).EQ.'FUNC')GOTO1166 C CCCCC THE FOLLOWING 3 LINES WAS ADDED JUNE 1998 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'POWE'.AND. 1 IHARG(4).EQ.'LAW ')GOTO11166 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'HYPE'.AND. 1 IHARG(4).EQ.'SECA')GOTO2228 C CCCCC THE FOLLOWING 3 LINES WERE ADDED SEPTEMBER 2004 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'HYPE'.AND.IHARG2(3).EQ.'BOLI')GOTO2352 C CCCCC THE FOLLOWING 3 LINES WAS ADDED AUGUST 1995 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'HYPE'.AND. 1 IHARG(4).EQ.'GEOM')GOTO1167 CCCCC OCTOBER 2001: CHECK FOR NAME CONFLICT WITH HYPERBOLIC SECANT IF(NUMARG.GE.5.AND. CCCCC1 IHARG(3).EQ.'HYPE')GOTO1168 1 IHARG(3).EQ.'HYPE'.AND.IHARG(4).NE.'SECA')GOTO1168 CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1995 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'NONC'.AND. 1 IHARG(4).EQ.'CHIS')GOTO1169 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'NONC'.AND. 1 IHARG(4).EQ.'CHI '.AND. 1 IHARG(5).EQ.'SQUA')GOTO2169 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'NON '.AND. 1 IHARG(4).EQ.'CENT'.AND. 1 IHARG(5).EQ.'CHIS')GOTO2169 IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'NON '.AND. 1 IHARG(4).EQ.'CENT'.AND. 1 IHARG(5).EQ.'CHI '.AND. 1 IHARG(6).EQ.'SQUA')GOTO3169 C CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1995 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'NONC'.AND. 1 IHARG(4).EQ.'F ')GOTO1170 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'NON '.AND. 1 IHARG(4).EQ.'CENT'.AND. 1 IHARG(5).EQ.'F ')GOTO2170 C CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1995 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'DOUB'.AND. 1 IHARG(4).EQ.'NONC'.AND. 1 IHARG(5).EQ.'F ')GOTO1171 IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'DOUB'.AND. 1 IHARG(4).EQ.'NON '.AND. 1 IHARG(4).EQ.'CENT'.AND. 1 IHARG(5).EQ.'F ')GOTO2171 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 1995 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'FOLD'.AND. 1 IHARG(4).EQ.'NORM')GOTO2181 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 1995 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'HALF'.AND. 1 IHARG(4).EQ.'CAUC')GOTO2191 C CCCCC THE FOLLOWING 3 LINES WERE ADDED AUGUST 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GENE'.AND. 1 IHARG(4).EQ.'LAMB')GOTO2211 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'TUKE'.AND. 1 IHARG(5).EQ.'LAMB')GOTO2212 C CCCCC THE FOLLOWING 3 LINES WERE ADDED SEPTEMBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'INVE'.AND. 1 IHARG(4).EQ.'WEIB')GOTO2221 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'DOUB'.AND. 1 IHARG(4).EQ.'WEIB')GOTO2222 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'DOUB'.AND. 1 IHARG(4).EQ.'GAMM')GOTO2223 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'LOG '.AND. 1 IHARG(4).EQ.'GAMM')GOTO2224 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'INVE'.AND. 1 IHARG(4).EQ.'GAMM')GOTO2225 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'COSI')GOTO2226 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'ANGL')GOTO2227 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'ARCS')GOTO2229 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'LOG '.AND. 1 IHARG(4).EQ.'DOUB'.AND.IHARG(5).EQ.'EXPO')GOTO2230 C CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED MARCH 2006 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'LOG '.AND. 1 IHARG(4).EQ.'LAPL')GOTO2366 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'ASYM'.AND.IHARG(4).EQ.'LOG '.AND. 1 IHARG(5).EQ.'DOUB'.AND.IHARG(6).EQ.'EXPO')GOTO2368 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'ASYM'.AND. 1 IHARG(4).EQ.'LOG '.AND.IHARG(5).EQ.'LAPL')GOTO2370 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GENE'.AND. 1 IHARG(4).EQ.'EXTR'.AND.IHARG(5).EQ.'VALU')GOTO2231 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'EXPO'.AND. 1 IHARG(4).EQ.'WEIB')GOTO2232 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'GOMP' .AND. IHARG(4).NE.'MAKE')GOTO2233 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'HALF'.AND. 1 IHARG(4).EQ.'LOGI')GOTO2234 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'POWE'.AND. 1 IHARG(4).EQ.'EXPO')GOTO2235 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'ALPH')GOTO2236 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'BRAD')GOTO2237 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'RECI')GOTO2238 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'JOHN'.AND. 1 IHARG(4).EQ.'SB ')GOTO2239 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'JOHN'.AND. 1 IHARG(4).EQ.'SU ')GOTO2240 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'POWE'.AND. 1 IHARG(4).EQ.'NORM')GOTO2241 C CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'LOG '.AND. 1 IHARG(4).EQ.'LOGI')GOTO2242 C CCCCC THE FOLLOWING 3 LINES WERE ADDED NOVEMBER 2001 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GEOM'.AND. 1 IHARG(4).EQ.'EXTR'.AND.IHARG(5).EQ.'EXPO')GOTO2244 C CCCCC THE FOLLOWING 3 LINES WERE ADDED NOVEMBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'POWE'.AND. 1 IHARG(4).EQ.'LOGN')GOTO2246 C CCCCC THE FOLLOWING 3 LINES WERE ADDED DECEMBER 2001 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'BETA'.AND. 1 IHARG(4).EQ.'BINO')GOTO2248 C CCCCC THE FOLLOWING 3 LINES WERE ADDED MARCH 2006 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'BETA'.AND. 1 IHARG(4).EQ.'NORM')GOTO2249 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'BETA'.AND. 1 IHARG(4).EQ.'GEOM')GOTO2251 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'BETA'.AND. 1 IHARG(4).EQ.'NEGA'.AND.IHARG(5).EQ.'BINO')GOTO2253 C CCCCC THE FOLLOWING 3 LINES WERE ADDED MAY 2002 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'TWO '.AND. 1 IHARG(4).EQ.'SIDE'.AND.IHARG(5).EQ.'POWE')GOTO2250 C CCCCC THE FOLLOWING 3 LINES WERE ADDED MAY 2002 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'BIWE')GOTO2252 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'BI '.AND.IHARG(4).EQ.'WEIB')GOTO2254 C CCCCC THE FOLLOWING LINES WERE ADDED AUGUST 2002 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'LOGA'.AND.IHARG(4).EQ.'SERI')GOTO2256 C CCCCC THE FOLLOWING LINES WERE ADDED JANUARY 2003 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'GH ')GOTO2258 C CCCCC THE FOLLOWING LINES WERE ADDED JANUARY 2003 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'G '.AND.IHARG(4).EQ.'AND '.AND. 1 IHARG(5).EQ.'H')GOTO2260 C CCCCC THE FOLLOWING LINES WERE ADDED JANUARY 2003 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'SLAS')GOTO2262 C CCCCC THE FOLLOWING LINES WERE ADDED APRIL 2003 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'LAND')GOTO2264 C CCCCC THE FOLLOWING LINES WERE ADDED MAY 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'INVE'.AND.IHARG(4).EQ.'BETA')GOTO2266 C CCCCC THE FOLLOWING LINES WERE ADDED MAY 2003 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'ERRO')GOTO2267 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'SUBB')GOTO2267 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'EXPO'.AND.IHARG(4).EQ.'POWE')GOTO2268 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'ERRO')GOTO2268 C CCCCC THE FOLLOWING LINES WERE ADDED JUNE 2003 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'TRAP')GOTO2270 C CCCCC THE FOLLOWING LINES WERE ADDED JUNE 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'VON'.AND.IHARG(4).EQ.'MISE')GOTO2272 C CCCCC THE FOLLOWING LINES WERE ADDED JUNE 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'WRAP'.AND.IHARG(4).EQ.'CAUC')GOTO2274 C CCCCC THE FOLLOWING LINES WERE ADDED JUNE 2003 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'PARE'.AND. 1 (IHARG(4).EQ.'SECO'.OR.IHARG(4).EQ.'2ND').AND. 1 IHARG(5).EQ.'KIND')GOTO2276 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'PARE'.AND. 1 IHARG(4).EQ.'TYPE'.AND.IHARG(5).EQ.'2 ')GOTO2276 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'PARE'.AND. 1 IHARG(4).EQ.'TYPE'.AND.IHARG(5).EQ.'TWO ')GOTO2276 C CCCCC THE FOLLOWING LINES WERE ADDED JUNE 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'TRAP')GOTO2278 C CCCCC THE FOLLOWING LINES WERE ADDED JULY 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'TRUN'.AND.IHARG(4).EQ.'NORM')GOTO2280 C CCCCC THE FOLLOWING LINES WERE ADDED JULY 2003 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'CHI ')GOTO2282 C CCCCC THE FOLLOWING LINES WERE ADDED JULY 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'FOLD'.AND.IHARG(4).EQ.'CAUC')GOTO2284 C CCCCC THE FOLLOWING LINES WERE ADDED JULY 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'BETA'.AND.IHARG(4).EQ.'KAPP')GOTO2286 C CCCCC THE FOLLOWING LINES WERE ADDED JULY 2003 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'MIEL'.AND.IHARG(4).EQ.'BETA'.AND. 1 IHARG(5).EQ.'KAPP')GOTO2288 C CCCCC THE FOLLOWING LINES WERE ADDED JULY 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'TRUN'.AND.IHARG(4).EQ.'EXPO')GOTO2290 C CCCCC THE FOLLOWING LINES WERE ADDED JULY 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'EXPO')GOTO2292 C CCCCC THE FOLLOWING LINES WERE ADDED SEPTEMBER 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'GAMM')GOTO2294 C CCCCC THE FOLLOWING LINES WERE ADDED NOVEMBER 2003 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'FOLD'.AND.IHARG(4).EQ.'T ')GOTO2296 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'SKEW'.AND.IHARG(4).EQ.'T ')GOTO2298 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'SKEW'.AND.IHARG(4).EQ.'NORM')GOTO2300 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'ZIPF')GOTO2302 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'ZETA')GOTO2303 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GOMP'.AND.IHARG(4).EQ.'MAKE')GOTO2304 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'INVE'.AND. 1 IHARG(5).EQ.'GAUS')GOTO2306 C CCCCC THE FOLLOWING LINES WERE ADDED MARCH 2004 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'LOG'.AND. 1 IHARG(4).EQ.'SKEW'.AND.IHARG(5).EQ.'T ')GOTO2308 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'LOG'.AND. 1 IHARG(4).EQ.'SKEW'.AND.IHARG(5).EQ.'NORM')GOTO2310 C CCCCC THE FOLLOWING LINES WERE ADDED MARCH 2004 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'NONC'.AND.IHARG(4).EQ.'T ')GOTO2312 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'NON '.AND.IHARG(4).EQ.'CENT'.AND. 1 IHARG(4).EQ.'T ')GOTO2312 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'DOUB'.AND. 1 IHARG(4).EQ.'NONC'.AND.IHARG(5).EQ.'T ')GOTO2314 IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'DOUB'.AND.IHARG(4).EQ.'NON '.AND. 1 IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'T ')GOTO2315 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GENE'.AND. 1 IHARG(4).EQ.'HALF'.AND.IHARG(5).EQ.'LOGI')GOTO2318 C CCCCC THE FOLLOWING LINES WERE ADDED MARCH 2004 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'POLY'.AND.IHARG(4).NE.'AEPP')GOTO2320 C CCCCC THE FOLLOWING LINES WERE ADDED APRIL 2004 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'HERM')GOTO2322 C CCCCC THE FOLLOWING LINES WERE ADDED APRIL 2004 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'YULE')GOTO2324 C CCCCC THE FOLLOWING LINES WERE ADDED APRIL 2004 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'WARI')GOTO2326 C CCCCC THE FOLLOWING LINES WERE ADDED APRIL 2004 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'WARI')GOTO2328 C CCCCC THE FOLLOWING LINES WERE ADDED APRIL 2004 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'NONC'.AND.IHARG(4).EQ.'BETA')GOTO2330 C CCCCC THE FOLLOWING LINES WERE ADDED MAY 2004 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'DOUB'.AND.IHARG(4).EQ.'NONC'.AND. 1 IHARG(5).EQ.'BETA')GOTO2332 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'DOUB'.AND.IHARG(4).EQ.'NON '.AND. 1 IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'BETA')GOTO2333 C CCCCC THE FOLLOWING LINES WERE ADDED JUNE 2004 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'SKEW'.AND.IHARG(4).EQ.'LAPL')GOTO2334 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'SKEW'.AND.IHARG(4).EQ.'DOUB'.AND. 1 IHARG(5).EQ.'EXPO')GOTO2335 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'ASYM'.AND.IHARG(4).EQ.'LAPL')GOTO2336 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'ASYM'.AND.IHARG(4).EQ.'DOUB'.AND. 1 IHARG(5).EQ.'EXPO')GOTO2337 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'ASYM'.AND. 1 IHARG(5).EQ.'LAPL')GOTO2338 IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'ASYM'.AND. 1 IHARG(5).EQ.'DOUB'.AND.IHARG(6).EQ.'EXPO')GOTO2339 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'MAXW')GOTO2340 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'RAYL')GOTO2341 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'MCLE')GOTO2343 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'BESS'.AND.IHARG(4).EQ.'I '.AND. 1 IHARG(5).EQ.'FUNC')GOTO2345 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'BESS'.AND.IHARG(4).EQ.'I ')GOTO2346 IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'BESS'.AND.IHARG(4).EQ.'K '.AND. 1 IHARG(5).EQ.'FUNC')GOTO2347 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'BESS'.AND.IHARG(4).EQ.'K ')GOTO2348 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'MCLE')GOTO2350 C CCCCC THE FOLLOWING LINES WERE ADDED FEBRUARY 2006 IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'5 ')GOTO2354 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'V ')GOTO2354 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'5 '.AND. 1 IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2354 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'V '.AND. 1 IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2354 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'HOSK'.AND.IHARG(4).EQ.'GENE'.AND. 1 IHARG(5).EQ.'LOGI')GOTO2356 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND. 1 IHARG(5).EQ.'HOSK')GOTO2356 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'2 ')GOTO2360 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'II ')GOTO2360 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'2 '.AND. 1 IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2360 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'II '.AND. 1 IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2360 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'3 ')GOTO2362 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'III ')GOTO2362 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'3 '.AND. 1 IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2362 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'III '.AND. 1 IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2362 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'4 ')GOTO2364 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'IV ')GOTO2364 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'4 '.AND. 1 IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2364 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'IV '.AND. 1 IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2364 C CCCCC THE FOLLOWING LINES WERE ADDED MARCH 2004 IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI')GOTO2316 C CCCCC THE FOLLOWING LINES WERE ADDED FEBRUARY 2006 IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'WAKE')GOTO2358 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'BORE'.AND.IHARG(4).EQ.'TANN')GOTO2372 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'LAGR'.AND.IHARG(4).EQ.'POIS')GOTO2374 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'CONS'.AND.IHARG(4).EQ.'GENE'.AND. 1 IHARG(5).EQ.'POIS')GOTO2376 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'LEAD'.AND.IHARG(4).EQ.'IN '.AND. 1 IHARG(5).EQ.'COIN'.AND.IHARG(6).EQ.'TOSS')GOTO2378 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'DISC'.AND.IHARG(4).EQ.'ARCS')GOTO2380 C IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'MATC')GOTO2382 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'LOG '.AND.IHARG(4).EQ.'BETA')GOTO2384 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'CLAS'.AND.IHARG(4).EQ.'OCCU')GOTO2386 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'POLY'.AND.IHARG(4).EQ.'AEPP')GOTO2388 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'LOST'.AND.IHARG(4).EQ.'GAME')GOTO2390 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'NEYM'.AND.IHARG(4).EQ.'TYPE'.AND. 1 IHARG(5).EQ.'A ')GOTO2392 C IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'DXG ')GOTO2394 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGA'.AND. 1 IHARG(5).EQ.'SERI')GOTO2396 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'NEGA'.AND. 1 IHARG(5).EQ.'BINO')GOTO2398 C IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'GEET')GOTO2400 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'QUAS'.AND.IHARG(4).EQ.'BINO'.AND. 1 IHARG(5).EQ.'I')GOTO2404 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'QUAS'.AND.IHARG(4).EQ.'BINO'.AND. 1 IHARG(5).EQ.'1')GOTO2404 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'QUAS'.AND.IHARG(4).EQ.'BINO'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'1')GOTO2406 C IF(NUMARG.GE.8.AND. 1 IHARG(3).EQ.'QUAS'.AND.IHARG(4).EQ.'BINO'.AND. 1 IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'I')GOTO2406 C IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'CONS')GOTO2408 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'LAGR'.AND.IHARG(4).EQ.'KATZ')GOTO2410 C IF(NUMARG.GE.5.AND. 1 IHARG(3).EQ.'KATZ')GOTO2412 C IF(NUMARG.GE.6.AND. 1 IHARG(3).EQ.'DISC'.AND.IHARG(4).EQ.'WEIB')GOTO2414 C IF(NUMARG.GE.7.AND. 1 IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOST'.AND. 1 IHARG(5).EQ.'GAME')GOTO2416 C C END OF SEARCH C IFOUND='NO' GOTO9000 C 1101 CONTINUE ICASRA='UNIF' GOTO1175 1102 CONTINUE ICASRA='NORM' GOTO1175 1103 CONTINUE ICASRA='LOGI' GOTO1175 1104 CONTINUE ICASRA='DOUB' GOTO1176 1105 CONTINUE ICASRA='CAUC' GOTO1175 1106 CONTINUE ICASRA='LAMB' GOTO1175 1107 CONTINUE ICASRA='LOGN' GOTO1175 1108 CONTINUE ICASRA='HALF' GOTO1175 1109 CONTINUE ICASRA='T' GOTO1175 1110 CONTINUE ICASRA='CHIS' GOTO1175 1111 CONTINUE ICASRA='F' GOTO1175 1112 CONTINUE ICASRA='EXPO' GOTO1175 1113 CONTINUE ICASRA='GAMM' GOTO1175 1114 CONTINUE ICASRA='BETA' GOTO1175 1115 CONTINUE ICASRA='WEIB' GOTO1175 1116 CONTINUE ICASRA='EXV1' GOTO1178 1117 CONTINUE ICASRA='EXV2' GOTO1178 1118 CONTINUE ICASRA='PARE' GOTO1175 1119 CONTINUE ICASRA='BINO' GOTO1175 1120 CONTINUE ICASRA='GEOM' GOTO1175 1121 CONTINUE ICASRA='POIS' GOTO1175 1122 CONTINUE ICASRA='NEGB' GOTO1176 1123 CONTINUE ICASRA='SEMI' GOTO1175 1124 CONTINUE ICASRA='TRIA' GOTO1175 C 1125 CONTINUE ICASRA='DIUN' GOTO1176 C 1126 CONTINUE ICASRA='BOOT' GOTO1174 C C1127 CONTINUE CCCCC ICASRA='JACK' CCCCC GOTO1174 C 1131 CONTINUE ICASRA='PERM' GOTO1174 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 1132 CONTINUE ICASRA='IG' GOTO1175 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 1133 CONTINUE ICASRA='IG' GOTO1174 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 1134 CONTINUE ICASRA='WALD' GOTO1174 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 1135 CONTINUE ICASRA='RIG' GOTO1176 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 1136 CONTINUE ICASRA='RIG' GOTO1174 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 1137 CONTINUE ICASRA='RIG' GOTO1175 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 1138 CONTINUE ICASRA='FL' GOTO1175 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990 1139 CONTINUE ICASRA='FL' GOTO1174 C 1151 CONTINUE ICASRA='DOUB' GOTO1175 1152 CONTINUE ICASRA='LAMB' GOTO1176 1153 CONTINUE ICASRA='LOGN' GOTO1176 1154 CONTINUE ICASRA='HALF' GOTO1176 1155 CONTINUE ICASRA='T' GOTO1176 1156 CONTINUE ICASRA='CHIS' GOTO1176 1157 CONTINUE ICASRA='F' GOTO1176 1158 CONTINUE ICASRA='EXV1' GOTO1177 1159 CONTINUE ICASRA='EXV1' GOTO1176 1160 CONTINUE ICASRA='EXV2' GOTO1177 1161 CONTINUE ICASRA='SEMI' GOTO1176 C CCCCC THE FOLLOWING 8 LINES WERE ADDED MAY 1993 1162 CONTINUE ICASRA='EXV1' GOTO1175 1163 CONTINUE ICASRA='EXV2' GOTO1175 C CCCCC THE FOLLOWING 8 LINES WERE ADDED MAY 1993 1164 CONTINUE ICASRA='GEP' GOTO1175 1165 CONTINUE ICASRA='GEP' GOTO1176 C CCCCC FOLLOWING SECTION ADDED APRIL 1995 1166 CONTINUE ICASRA='POWF' GOTO1176 C CCCCC FOLLOWING SECTION ADDED JUNE 1998 11166 CONTINUE ICASRA='POWL' GOTO1176 C CCCCC FOLLOWING SECTION ADDED AUGUST 1995 1167 CONTINUE ICASRA='HYPE' GOTO1176 C CCCCC FOLLOWING SECTION ADDED AUGUST 1995 1168 CONTINUE ICASRA='HYPE' GOTO1175 C CCCCC FOLLOWING SECTION ADDED AUGUST 1995 1169 CONTINUE ICASRA='NCCS' GOTO1176 C CCCCC FOLLOWING SECTION ADDED AUGUST 1995 2169 CONTINUE ICASRA='NCCS' GOTO1177 C CCCCC FOLLOWING SECTION ADDED AUGUST 1995 3169 CONTINUE ICASRA='NCCS' GOTO1178 C CCCCC FOLLOWING SECTION ADDED AUGUST 1995 1170 CONTINUE ICASRA='NCF ' GOTO1176 C CCCCC FOLLOWING SECTION ADDED AUGUST 1995 2170 CONTINUE ICASRA='NCF ' GOTO1177 C CCCCC FOLLOWING SECTION ADDED AUGUST 1995 1171 CONTINUE ICASRA='DNCF' GOTO1177 C CCCCC FOLLOWING SECTION ADDED AUGUST 1995 2171 CONTINUE ICASRA='DNCF' GOTO1178 C CCCCC FOLLOWING SECTION ADDED OCTOBER 1995 2181 CONTINUE ICASRA='FNRM' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOBER 1995 2191 CONTINUE ICASRA='HFCA' GOTO1176 C CCCCC FOLLOWING SECTION ADDED MAY 1998 2201 CONTINUE ICASRA='NMRM' GOTO1176 C CCCCC FOLLOWING SECTION ADDED AUGUST 2001 2211 CONTINUE ICASRA='GLAM' GOTO1176 C CCCCC FOLLOWING SECTION ADDED FEBRUARY 2006 2212 CONTINUE ICASRA='GLAM' GOTO1177 C CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2001 2221 CONTINUE ICASRA='IWEI' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOBER 2001 2222 CONTINUE ICASRA='DWEI' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2223 CONTINUE ICASRA='DGAM' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2224 CONTINUE ICASRA='LGAM' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2225 CONTINUE ICASRA='IGAM' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2226 CONTINUE ICASRA='COSI' GOTO1175 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2227 CONTINUE ICASRA='ANGL' GOTO1175 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2228 CONTINUE ICASRA='HSEC' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2229 CONTINUE ICASRA='ARCS' GOTO1175 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2230 CONTINUE ICASRA='LDEX' GOTO1177 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2231 CONTINUE ICASRA='GEVA' GOTO1177 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2232 CONTINUE ICASRA='EWEI' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2233 CONTINUE ICASRA='GOMP' GOTO1175 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2234 CONTINUE ICASRA='HALO' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2235 CONTINUE ICASRA='POEX' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2236 CONTINUE ICASRA='ALPH' GOTO1175 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2237 CONTINUE ICASRA='BRAD' GOTO1175 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2238 CONTINUE ICASRA='RECI' GOTO1175 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2239 CONTINUE ICASRA='JOSB' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2240 CONTINUE ICASRA='JOSU' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2241 CONTINUE ICASRA='PNOR' GOTO1176 C CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001 2242 CONTINUE ICASRA='LLOG' GOTO1176 C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2001 2244 CONTINUE ICASRA='GEEE' GOTO1177 C CCCCC FOLLOWING SECTION ADDED NOVEMBER 2001 2246 CONTINUE ICASRA='PLNO' GOTO1176 C CCCCC FOLLOWING SECTION ADDED DECEMBER 2001 2248 CONTINUE ICASRA='BBIN' GOTO1176 C CCCCC FOLLOWING SECTION ADDED MARCH 2006 2249 CONTINUE ICASRA='BNOR' GOTO1176 C CCCCC FOLLOWING SECTION ADDED MAY 2002 2250 CONTINUE ICASRA='STSP' GOTO1177 C CCCCC FOLLOWING SECTION ADDED MAY 2006 2251 CONTINUE ICASRA='BGEO' GOTO1176 C CCCCC FOLLOWING SECTION ADDED MAY 2002 2252 CONTINUE ICASRA='BIWE' GOTO1175 C CCCCC FOLLOWING SECTION ADDED MAY 2006 2253 CONTINUE ICASRA='BENB' GOTO1177 C CCCCC FOLLOWING SECTION ADDED MAY 2002 2254 CONTINUE ICASRA='BIWE' GOTO1176 C CCCCC FOLLOWING SECTION ADDED AUGUST 2002 2256 CONTINUE ICASRA='LOGS' GOTO1176 C CCCCC FOLLOWING SECTION ADDED JANUARY 2003 2258 CONTINUE ICASRA='GH ' GOTO1175 C CCCCC FOLLOWING SECTION ADDED JANUARY 2003 2260 CONTINUE ICASRA='GH ' GOTO1177 C CCCCC FOLLOWING SECTION ADDED JANUARY 2003 2262 CONTINUE ICASRA='SLAS' GOTO1175 C CCCCC FOLLOWING SECTION ADDED APRIL 2003 2264 CONTINUE ICASRA='LAND' GOTO1175 C 2266 CONTINUE ICASRA='IBET' GOTO1175 C 2267 CONTINUE ICASRA='ERRO' GOTO1175 C 2268 CONTINUE ICASRA='ERRO' GOTO1176 C 2270 CONTINUE ICASRA='TRAP' GOTO1175 C 2272 CONTINUE ICASRA='VONM' GOTO1176 C 2274 CONTINUE ICASRA='WRCA' GOTO1176 C 2276 CONTINUE ICASRA='PAR2' GOTO1177 C 2278 CONTINUE ICASRA='GTRA' GOTO1176 C 2280 CONTINUE ICASRA='TNOR' GOTO1176 C 2282 CONTINUE ICASRA='CHI ' GOTO1175 C 2284 CONTINUE ICASRA='FCAU' GOTO1176 C 2286 CONTINUE ICASRA='BKAP' GOTO1176 C 2288 CONTINUE ICASRA='BKAP' GOTO1177 C 2290 CONTINUE ICASRA='TEXP' GOTO1176 C 2292 CONTINUE ICASRA='GEXP' GOTO1176 C 2294 CONTINUE ICASRA='GGD ' GOTO1176 C 2296 CONTINUE ICASRA='FT ' GOTO1176 C 2298 CONTINUE ICASRA='SKWT' GOTO1176 C 2300 CONTINUE ICASRA='SKWN' GOTO1176 C 2302 CONTINUE ICASRA='ZIPF' GOTO1176 C 2303 CONTINUE ICASRA='ZETA' GOTO1176 C 2304 CONTINUE ICASRA='GMAK' GOTO1177 C 2306 CONTINUE ICASRA='GIG ' GOTO1178 C 2308 CONTINUE ICASRA='SKLT' GOTO1178 C 2310 CONTINUE ICASRA='SKLN' GOTO1178 C 2312 CONTINUE ICASRA='NCT ' GOTO1177 C 2313 CONTINUE ICASRA='NCT ' GOTO1178 C 2314 CONTINUE ICASRA='DNCT' GOTO1178 C 2315 CONTINUE ICASRA='DNCT' GOTO1179 C 2316 CONTINUE ICASRA='GLOG' GOTO1178 C 2318 CONTINUE ICASRA='GHLO' GOTO1177 C 2320 CONTINUE ICASRA='POLY' GOTO1175 C 2322 CONTINUE ICASRA='HERM' GOTO1175 C 2324 CONTINUE ICASRA='YULE' GOTO1175 C 2326 CONTINUE ICASRA='WARI' GOTO1175 C 2328 CONTINUE ICASRA='GWAR' GOTO1176 C 2330 CONTINUE ICASRA='NCBE' GOTO1177 C 2331 CONTINUE ICASRA='NCBE' GOTO1178 C 2332 CONTINUE ICASRA='DNCB' GOTO1178 C 2333 CONTINUE ICASRA='DNCB' GOTO1179 C 2334 CONTINUE ICASRA='SKDE' GOTO1178 C 2335 CONTINUE ICASRA='SKDE' GOTO1179 C 2336 CONTINUE ICASRA='ASDE' GOTO1178 C 2337 CONTINUE ICASRA='ASDE' GOTO1179 C 2338 CONTINUE ICASRA='GASD' GOTO1179 C 2339 CONTINUE ICASRA='GASD' GOTO1180 C 2340 CONTINUE ICASRA='MAXW' GOTO1177 C 2341 CONTINUE ICASRA='RAYL' GOTO1177 C 2343 CONTINUE ICASRA='MCLE' GOTO1177 C 2345 CONTINUE ICASRA='BESI' GOTO1179 C 2346 CONTINUE ICASRA='BESI' GOTO1178 C 2347 CONTINUE ICASRA='BESK' GOTO1179 C 2348 CONTINUE ICASRA='BESK' GOTO1178 C 2350 CONTINUE ICASRA='GMCL' GOTO1178 C 2352 CONTINUE ICASRA='HBOL' GOTO1177 C 2354 CONTINUE ICASRA='G5LO' GOTO1180 C 2356 CONTINUE ICASRA='G5LO' GOTO1179 C 2358 CONTINUE ICASRA='WAKE' GOTO1175 C 2360 CONTINUE ICASRA='G2LO' GOTO1180 C 2362 CONTINUE ICASRA='G3LO' GOTO1180 C 2364 CONTINUE ICASRA='G4LO' GOTO1180 C CCCCC FOLLOWING SECTION ADDED MARCH 2006 2366 CONTINUE ICASRA='LDEX' GOTO1176 C 2368 CONTINUE ICASRA='ALDE' GOTO1178 C 2370 CONTINUE ICASRA='ALDE' GOTO1177 C 2372 CONTINUE ICASRA='BTAN' GOTO1176 C 2374 CONTINUE ICASRA='LPOI' GOTO1176 C 2376 CONTINUE ICASRA='LPOI' GOTO1177 C 2378 CONTINUE ICASRA='LCTO' GOTO1178 C 2380 CONTINUE ICASRA='LCTO' GOTO1176 C 2382 CONTINUE ICASRA='MATC' GOTO1175 C 2384 CONTINUE ICASRA='LBET' GOTO1176 C 2386 CONTINUE ICASRA='OCCU' GOTO1176 C 2388 CONTINUE ICASRA='PAEP' GOTO1176 C 2390 CONTINUE ICASRA='LOST' GOTO1176 C 2392 CONTINUE ICASRA='NEYA' GOTO1177 C 2394 CONTINUE ICASRA='DXG ' GOTO1175 C 2396 CONTINUE ICASRA='GLSE' GOTO1177 C 2398 CONTINUE ICASRA='GNBI' GOTO1177 C 2400 CONTINUE ICASRA='GEET' GOTO1175 C 2402 CONTINUE ICASRA='POIG' GOTO1177 C 2404 CONTINUE ICASRA='QBTI' GOTO1177 C 2406 CONTINUE ICASRA='QBTI' GOTO1178 C 2408 CONTINUE ICASRA='CONS' GOTO1175 C 2410 CONTINUE ICASRA='LAGK' GOTO1175 C 2412 CONTINUE ICASRA='KATZ' GOTO1174 C 2414 CONTINUE ICASRA='DISW' GOTO1175 C 2416 CONTINUE ICASRA='GLGA' GOTO1176 C 1174 CONTINUE ILOCNU=4 GOTO1190 1175 CONTINUE ILOCNU=5 GOTO1190 1176 CONTINUE ILOCNU=6 GOTO1190 1177 CONTINUE ILOCNU=7 GOTO1190 1178 CONTINUE ILOCNU=8 GOTO1190 1179 CONTINUE ILOCNU=9 GOTO1190 1180 CONTINUE ILOCNU=10 GOTO1190 C 1190 CONTINUE IFOUND='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKRAND--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IFOUND,IERROR 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)ICASRA,ILOCNU 9013 FORMAT('ICASRA,ILOCNU = ',A4,I8) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CKSTAT(IBUGA3,IFOUN8,ICASL8,ILOCV) C C PURPOSE--CHECK TO SEE IF A TYPE 8 LET C COMMAND HAS BEEN GIVEN-- C NUMBER C SIZE C COUNT C SAMPLE SIZE C C SUM C PRODUCT C INTEGRAL C RATIO C C LOCATION STATISTICS (ONE RESPONSE VARIABLE) C MIDRANGE C MEAN C AVERAGE C MIDMEAN C MEDIAN C TRIMMED MEAN C WINSORIZED MEAN C GEOMETRIC MEAN C HARMONIC MEAN C BIWEIGHT LOCATION C HODGES LEHMAN LOCATION C STANDARD DEVIATION OF THE MEAN C STANDARD DEVIATION OF MEAN C STANDARD DEVIATION MEAN C VARIANCE OF THE MEAN C VARIANCE OF MEAN C VARIANCE MEAN C TRIMMED MEAN STANDARD ERROR C C SCALE STATISTICS (ONE RESPONSE VARIABLE) C STANDARD DEVIATION (& SD) C VARIANCE (& VAR) C AVERAGE ABSOLUTE DEVIATION C MAD (MEDIAN ABSOLUTE DEVIATION) C SN C QN C GEOMETRIC STANDARD DEVIATION C INTERQUARTILE RANGE C BIWEIGHT SCALE C BIWEIGHT MIDVARIANCE C BIWEIGHT MIDCOVARIANCE C BIWEIGHT MIDCORRELATION C WINSORIZED VARIANCE C WINSORIZED STANDARD DEVIATION (OR SD) C PERCENTAGE BEND MIDVARIANCE C PERCENTAGE BEND CORRELATION C RELATIVE STANDARD DEVIATION C RELATIVE VARIANCE C C PERCENTILE STATISTICS (ONE RESPONSE VARIABLE) C QUANTILE C QUANTILE STANDARD ERROR C PERCENTILE C COEFFICIENT OF VARIATION C RANGE C MINIMUM C MIN C MAXIMUM C MAX C EXTREME C C SKEWNESS/KURTOSIS STATISTICS (ONE RESPONSE VARIABLE) C STANDARDIZED THIRD CENTRAL MOMENT C SKEWNESS C STANDARDIZED FOURTH CENTRAL MOMENT C KURTOSIS C C LOCATION AND SCALE STATISTICS (TWO RESPONSE VARIABLES) C WEIGHTED MEAN C WEIGHTED MEDIAN C WEIGHTED STANDARD DEVIATION C WEIGHTED VARIANCE C WEIGHTED TRIMMED MEAN C C TIME SERIES STATISTICS (ONE RESPONSE VARIABLE) C AUTOCORRELATION C C QUALITY CONTROL STATISTICS (ONE RESPONSE VARIABLE) C CP C CPL C CPU C CPK C CPM C CC C CNPK C (ACTUAL) PERCENT DEFECTIVE C (THEORETICAL) PERCENT DEFECTIVE C EXPECTED LOSS C (TAGUCHI) SN- SN0 SN+ SN00 C C MISCELLANEOUS STATISTICS (ONE RESPONSE VARIABLE) C NORMAL PPCC C SIN FREQUENCY C SIN AMPLITUDE C COMMON DIGITS C NUMBER OF COMMON DIGITS C C CO-RELATION (TWO RESPONSE VARIABLES) C COVARIANCE C CORRELATION C RANK CORRELATION C KENDELL TAU C COMOVEMENT (LEIGH-PEARLMAN) C RANK COMOVEMENT C WINSORIZED COVARIANCE C WINSORIZED CORRELATION C C SCALE (ONE RESPONSE VARIABLES, ONE GROUP-ID VARIABLE) C REPEATABILITY STANDARD DEVIATION C REPRODUCABILITY STANDARD DEVIATION C C FOLLOWING STATISTICS COMPUTE DIFFERENCE IN C STATISTIC FOR TWO RESPONSE VARIABLES (USED FOR C LOCATION AND SCALE STATISTICS): C C LOCATION: C DIFFERENCE OF MEANS C DIFFERENCE OF MIDMEANS C DIFFERENCE OF MEDIANS C DIFFERENCE OF TRIMMED MEANS C DIFFERENCE OF WINSORIZED MEANS C DIFFERENCE OF GEOMETRIC MEANS C DIFFERENCE OF HARMONIC MEANS C DIFFERENCE OF HODGES-LEHMAN C DIFFERENCE OF BIWEIGHT LOCATION C C SCALE: C DIFFERENCE OF STANDARD DEVIATIONS C DIFFERENCE OF VARIANCES C DIFFERENCE OF AAD C DIFFERENCE OF MAD C DIFFERENCE OF SN C DIFFERENCE OF QN C DIFFERENCE OF INTERQUARTILE RANGE C DIFFERENCE OF WINSORIZED SD C DIFFERENCE OF WINSORIZED VARIANCE C DIFFERENCE OF BIWEIGHT MIDVARIANCE C DIFFERENCE OF BIWEIGHT SCALE C DIFFERENCE OF PERCENTAGE BEND C DIFFERENCE OF GEOMETRIC SD C DIFFERENCE OF RANGE C DIFFERENCE OF MIDRANGE C DIFFERENCE OF QUANTILE C DIFFERENCE OF SKEWNESS C DIFFERENCE OF KURTOSIS C DIFFERENCE OF RELATIVE SD C DIFFERENCE OF SD OF MEAN C DIFFERENCE OF RELATIVE VARIANCE C DIFFERENCE OF VARIANCE OF THE MEAN C DIFFERENCE OF MINIMUM C DIFFERENCE OF MAXIMUM C DIFFERENCE OF EXTREMES C C OUTPUT ARGUMENTS--IFOUN8 ('YES' OR 'NO') C --ICASL8 ('NUMB', 'SUM', ETC.) C --ILOCV (LOCATION IN THE ARGUMENT LIST IHARG(.) C OF THE VARIABLE OR COLUMN C TO BE OPERATED ON. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--MARCH 1979. C UPDATED --APRIL 1979. C UPDATED --JUNE 1979. C UPDATED --JUNE 1981. C UPDATED --SEPTEMBER 1981. C UPDATED --MAY 1982. C UPDATED --SEPTEMBER 1987. (DECILES) C UPDATED --AUGUST 1988. (WEIGHTED MEAN, MEDIAN, SD, VARIANCE) C UPDATED --JANUARY 1989. AVERAGE ABSOLUTE DEVIATION (ALAN) C UPDATED --APRIL 1990. EXTREME C UPDATED --SEPTEMBER 1990. CP, CPK, % DEF, EXP LOSS C UPDATED --SEPTEMBER 1990. SD FOR STAN. DEVIATION C UPDATED --SEPTEMBER 1990. WINDSORIZED TO WINSORIZED C UPDATED --AUGUST 1991. MOVE FORMS FOR CORR COEF C UPDATED --AUGUST 1991. COMOVEMENT C UPDATED --MAY 1993. CORRELATION => CORR C UPDATED --FEBRUARY 1994. CHANGE ICASL8: SDM => SDME C UPDATED --FEBRUARY 1994. CHANGE ICASL8: RSD => RESD C UPDATED --FEBRUARY 1994. EXTREME C UPDATED --FEBRUARY 1994. RENUMBER 3XX => 7XX STATEMENTS C UPDATED --FEBRUARY 1994. SYNONYM: ST. DEV. OF MEAN => C UPDATED --FEBRUARY 1994. SYNONYM: ST. DEV. => SD C UPDATED --FEBRUARY 1994. SYNONYM: VARI => VAR C UPDATED --FEBRUARY 1994. RELATIVE VARIANCE C UPDATED --FEBRUARY 1994. VARIANCE OF THE MEAN C UPDATED --FEBRUARY 1994. NORMAL PPCC C UPDATED --FEBRUARY 1994. TAGUCHI SN- SN0 SN+ SN00 C UPDATED --NOVEMBER 1994. DISTINGUISH RELATIVE SD AND C COEF OF VARIATION CASES C UPDATED --MARCH 1995. MEDIAN ABSOLUTE DEVIATION C UPDATED --NOVEMBER 1998. PERCENTILE C UPDATED --NOVEMBER 1998. CPM, CC C UPDATED --MARCH 1999. CNPK C UPDATED --MARCH 1999. GEOMETRIC MEAN C UPDATED --MARCH 1999. GEOMETRIC STANDARD DEVIATION C UPDATED --MARCH 1999. HARMONIC MEAN C UPDATED --APRIL 2001. CPL AND CPU C UPDATED --AUGUST 2001. COMMON DIGITS C UPDATED --SEPTEMBER 2001. INTERQUARTILE RANGE C UPDATED --NOVEMBER 2001. BIWEIGHT LOCATION C UPDATED --NOVEMBER 2001. BIWEIGHT SCALE C UPDATED --JULY 2002. WINSORIZED VARIANCE C UPDATED --JULY 2002. WINSORIZED STANDARD DEVIATION C UPDATED --JULY 2002. WINSORIZED COVARIANCE C UPDATED --JULY 2002. WINSORIZED CORRELATION C UPDATED --JULY 2002. HODGES LEHMAN C UPDATED --JULY 2002. PERCENTAGE BEND MIDVARIANCE C UPDATED --JULY 2002. BIWEIGHT MIDVARIANCE C UPDATED --JULY 2002. BIWEIGHT MIDCOVARIANCE C UPDATED --JULY 2002. BIWEIGHT MIDCORRELATION C UPDATED --MARCH 2003. 35 "DIFFERENCE OF" STATISTICS C UPDATED --APRIL 2003. SN AND QN (AND DIFFERENCE OF) C UPDATED --MAY 2003. WEIGHTED TRIMMED MEAN C UPDATED --OCTOBER 2004. KENDELL'S TAU C UPDATED --SEPTEMBER 2005. RATIO C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGA3 CHARACTER*4 IFOUN8 CHARACTER*4 ICASL8 C CHARACTER*4 IERROR CHARACTER*4 IH CHARACTER*4 IH2 CHARACTER*4 ISUBN0 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' INCLUDE 'DPCOHO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='CKST' ISUBN2='AT ' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 C IERROR='NO' C C *********************************** C ** CHECK FOR A TYPE 8 LET CASE ** C *********************************** C IFOUN8='NO' ICASL8='UNKN' ILOCV=-1 C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKSTAT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)NUMARG 53 FORMAT('NUMARG = ',I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ********************************* C ** STEP 1-- ** C ** DETERMINE IF OF THIS TYPE ** C ** AND BRANCH ACCORDINGLY. ** C ********************************* C ISTEPN='1' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMARG.LE.3)GOTO9000 C IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'NUMB'.AND.IHARG(4).EQ.'OF '.AND. 1IHARG(5).EQ.'COMM'.AND.IHARG(6).EQ.'DIGI')GOTO343 C IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'NUMB'.AND.IHARG2(3).EQ.'ER ')GOTO201 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'COUN'.AND.IHARG2(3).EQ.'T ')GOTO201 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'COUN'.AND.IHARG2(3).EQ.'TS ')GOTO201 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SIZE'.AND.IHARG2(3).EQ.' ')GOTO201 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SAMP'.AND.IHARG(4).EQ.'SIZE')GOTO202 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SUM '.AND.IHARG2(3).EQ.' ')GOTO203 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'PROD'.AND.IHARG2(3).EQ.'UCT ')GOTO204 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'INTE'.AND.IHARG2(3).EQ.'GRAL')GOTO205 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MIDR'.AND.IHARG2(3).EQ.'ANGE')GOTO206 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MEAN'.AND.IHARG2(3).EQ.' ')GOTO207 C SEPTEMBER, 1988: CHECK FOR "AVERAGE ABSOLUTE DEVIATION" CCCCC IF(NUMARG.GE.3.AND. CCCCC1IHARG(3).EQ.'AVER'.AND.IHARG2(3).EQ.'AGE ')GOTO208 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'AVER'.AND.IHARG2(3).EQ.'AGE '.AND. 1IHARG(4).NE.'ABSO')GOTO208 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MIDM'.AND.IHARG2(3).EQ.'EAN ')GOTO209 CCCCC MARCH 1995. CHECK FOR MEDIAN ABSOLUTE DEVIATION. CCCCC IF(NUMARG.GE.3.AND. CCCCC1IHARG(3).EQ.'MEDI'.AND.IHARG2(3).EQ.'AN ')GOTO210 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MEDI'.AND.IHARG(4).NE.'ABSO')GOTO210 C CCCCC THE FOLLOWING 8 LINES WERE ADDED FEBRUARY 1994 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF '.AND. 1IHARG(5).EQ.'THE '.AND.IHARG(6).EQ.'MEAN')GOTO306 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF '.AND. 1IHARG(5).EQ.'MEAN')GOTO307 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'MEAN')GOTO308 C CCCCC THE FOLLOWING 8 LINES WERE ADDED FEBRUARY 1994 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'VAR '.AND.IHARG(4).EQ.'OF '.AND. 1IHARG(5).EQ.'THE '.AND.IHARG(6).EQ.'MEAN')GOTO306 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'VAR '.AND.IHARG(4).EQ.'OF '.AND. 1IHARG(5).EQ.'MEAN')GOTO307 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'VAR '.AND.IHARG(4).EQ.'MEAN')GOTO308 C IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'VARI'.AND.IHARG2(3).EQ.'ANCE')GOTO211 C CCCCC THE FOLLOWING 4 LINES WERE ADDED FEBRUARY 1994 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'VARI'.AND.IHARG2(3).EQ.' ')GOTO211 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'VAR '.AND.IHARG2(3).EQ.' ')GOTO211 C IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'STAN'.AND. 1IHARG(5).EQ.'DEVI')GOTO212 C CCCCC THE FOLLOWING 6 LINES WERE ADDED FEBRUARY 1994 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'SD ')GOTO311 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'VARI')GOTO312 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'VAR ')GOTO312 C C SEPTEMBER, 1988. ADD AVERAGE ABSOLUTE DEVIATION IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'AVER'.AND.IHARG(4).EQ.'ABSO'.AND. 1IHARG(5).EQ.'DEVI')GOTO291 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'AAD ')GOTO287 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MAD ')GOTO288 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'MEDI'.AND.IHARG(4).EQ.'ABSO'.AND. 1IHARG(5).EQ.'DEVI')GOTO289 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'OF '.AND. 1IHARG(5).EQ.'VARI')GOTO212 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'VARI')GOTO214 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'RANG'.AND.IHARG2(3).EQ.'E ')GOTO215 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MINI'.AND.IHARG2(3).EQ.'MUM ')GOTO216 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MIN '.AND.IHARG2(3).EQ.' ')GOTO217 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MAXI'.AND.IHARG2(3).EQ.'MUM ')GOTO218 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'MAX '.AND.IHARG2(3).EQ.' ')GOTO219 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'THIR'.AND. 1IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'MOME')GOTO220 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'3RD '.AND. 1IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'MOME')GOTO221 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SKEW'.AND.IHARG2(3).EQ.'NESS')GOTO222 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'FOUR'.AND. 1IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'MOME')GOTO223 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'4TH '.AND. 1IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'MOME')GOTO224 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'KURT'.AND.IHARG2(3).EQ.'OSIS')GOTO225 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'AUTO'.AND.IHARG2(3).EQ.'COVA')GOTO226 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'AUTO'.AND.IHARG2(3).EQ.'CORR')GOTO227 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LOWE'.AND.IHARG(4).EQ.'HING')GOTO228 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'UPPE'.AND.IHARG(4).EQ.'HING')GOTO229 IF(NUMARG.GE.7.AND. 1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI'.AND. 1IHARG(5).EQ.'OF '.AND.IHARG(6).EQ.'THE '.AND. 1IHARG(7).EQ.'MEAN')GOTO230 C CCCCC THE FOLLOWING 8 LINES WERE ADDED FEBRUARY 1994 IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'SD '.AND.IHARG(4).EQ.'OF '.AND. 1IHARG(5).EQ.'THE '.AND.IHARG(6).EQ.'MEAN')GOTO301 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'SD '.AND.IHARG(4).EQ.'OF '.AND. 1IHARG(5).EQ.'MEAN')GOTO302 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SD '.AND.IHARG(4).EQ.'MEAN')GOTO303 C IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI'.AND. 1IHARG(5).EQ.'OF '.AND.IHARG(6).EQ.'MEAN')GOTO231 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI'.AND. 1IHARG(5).EQ.'MEAN')GOTO232 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI')GOTO233 C CCCCC THE FOLLOWING 2 LINES WERE ADDED FEBRUARY 1994 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SD ')GOTO304 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LOWE'.AND.IHARG(4).EQ.'QUAR')GOTO234 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'FIRS'.AND.IHARG(4).EQ.'QUAR')GOTO234 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SECO'.AND.IHARG(4).EQ.'QUAR')GOTO235 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'UPPE'.AND.IHARG(4).EQ.'QUAR')GOTO236 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'THIR'.AND.IHARG(4).EQ.'QUAR')GOTO236 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TRIM'.AND.IHARG(4).EQ.'MEAN'.AND. 1(IHARG(5).NE.'STAN'.AND.IHARG(6).NE.'ERRO'))GOTO237 IF(NUMARG.GE.4.AND. CCCCC THE FOLLOWING LINE WAS FIXED SEPTEMBER 1990 CCCCC1IHARG(3).EQ.'WIND'.AND.IHARG(4).EQ.'MEAN')GOTO238 1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'MEAN')GOTO238 CCCCC JULY 2002: ADD WINSORIZED VARIANCE, WINSORIZED SD, C WINSORIZED COVARIANCE, WINSORIZED CORRELATION IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'VARI')GOTO352 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'SD ')GOTO354 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'STAN'.AND. 1IHARG(5).EQ.'DEVI')GOTO356 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'COVA')GOTO364 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'CORR')GOTO366 CCCCC JULY 2002: ADD HODGES LEHMAN IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'HODG'.AND.IHARG(4).EQ.'LEHM'.AND. 1IHARG(5).EQ.'LOCA')GOTO358 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'HODG'.AND.IHARG(4).EQ.'LEHM')GOTO360 CCCCC JULY 2002: ADD PERCENTAGE BEND MIDVARIANCE IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'BEND'.AND. 1IHARG(5).EQ.'MIDV')GOTO362 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'BEND'.AND. 1IHARG(5).EQ.'CORR')GOTO363 CCCCC JULY 2002: ADD BIWEIGHT MIDVARIANCE AND BIWEIGHT MIDCOVARIANCE IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'MIDV')GOTO368 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'BIWE'.AND. 1IHARG(4).EQ.'MIDC'.AND.IHARG2(4).EQ.'ORRE')GOTO369 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'MIDC')GOTO370 CCCCC JULY 2002: ADD QUANTILE, QUANTILE STANDARD ERROR, TRIMEED MEAN CCCCC STANDARD ERROR IF(NUMARG.GE.6.AND.IHARG(4).EQ.'QUAN'.AND.IHARG(5).EQ.'STAN'.AND. 1 IHARG(6).EQ.'ERRO')THEN P100=ARG(3) IH='P100' IH2=' ' VALUE0=P100 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGA3,IERROR) GOTO372 ENDIF IF(NUMARG.GE.4.AND.IHARG(4).EQ.'QUAN')THEN P100=ARG(3) IH='P100' IH2=' ' VALUE0=P100 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGA3,IERROR) GOTO374 ENDIF C IF(NUMARG.GE.6.AND. 1IHARG(3).EQ.'TRIM'.AND.IHARG(4).EQ.'MEAN'.AND. 1IHARG(5).EQ.'STAN'.AND.IHARG(6).EQ.'ERRO')GOTO376 C CCCCC THE FOLLOWING 2 LINES WERE ADDED SEPTEMBER 1990 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SD'.AND.IHARG2(3).EQ.' ')GOTO239 C CCCCC THE FOLLOWING SECTION WAS CHANGED AND ADDED TO AUGUST 1991 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'COVA'.AND.IHARG2(3).EQ.'RIAN')GOTO250 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'CORR'.AND.IHARG(4).EQ.'COEF')GOTO251 CCCCC THE FOLLOWING 2 LINES WERE CHANGED MAY 1993 CCCCC IF(NUMARG.GE.3.AND. CCCCC1IHARG(3).EQ.'CORR'.AND.IHARG2(3).EQ.'ELAT')GOTO252 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CORR')GOTO252 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'COMO'.AND.IHARG(4).EQ.'COEF')GOTO253 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'COMO'.AND.IHARG(4).EQ.'INDE')GOTO253 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'COMO'.AND.IHARG2(3).EQ.'VEME')GOTO254 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'COVA')GOTO255 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'CORR'.AND. 1IHARG(5).EQ.'COEF')GOTO256 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'CORR')GOTO257 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'COMO'.AND. 1IHARG(5).EQ.'COEF')GOTO258 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'COMO'.AND. 1IHARG(5).EQ.'INDE')GOTO258 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'COMO')GOTO259 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'KEND'.AND.IHARG(4).EQ.'TAU '.AND. 1IHARG(5).EQ.'COEF')GOTO480 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'KEND'.AND.IHARG(4).EQ.'TAU ')GOTO481 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'REPE'.AND.IHARG(4).EQ.'STAN'.AND. 1IHARG(5).EQ.'DEVI')GOTO486 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'REPE'.AND.IHARG(4).EQ.'SD ')GOTO487 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'REPE')GOTO488 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'REPR'.AND.IHARG(4).EQ.'STAN'.AND. 1IHARG(5).EQ.'DEVI')GOTO491 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'REPR'.AND.IHARG(4).EQ.'SD ')GOTO492 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'REPR')GOTO493 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'RATI')GOTO494 C IF(NUMARG.GE.4.AND.IHARG(4).EQ.'DECI')GOTO111 GOTO119 111 CONTINUE IF(IHARG(3).EQ.'FIRS')GOTO261 IF(IHARG(3).EQ.'SECO')GOTO262 IF(IHARG(3).EQ.'THIR')GOTO263 IF(IHARG(3).EQ.'FOUR')GOTO264 IF(IHARG(3).EQ.'FIFT')GOTO265 IF(IHARG(3).EQ.'SIXT')GOTO266 IF(IHARG(3).EQ.'SEVE')GOTO267 IF(IHARG(3).EQ.'EIGH')GOTO268 IF(IHARG(3).EQ.'NINT')GOTO269 119 CONTINUE C IF(NUMARG.GE.4.AND.IHARG(4).EQ.'PERC')THEN P100=ARG(3) IH='P100' IH2=' ' VALUE0=P100 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1 IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1 IANS,IWIDTH,IBUGA3,IERROR) C GOTO270 ENDIF C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'MEAN')GOTO271 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'MEDI')GOTO272 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'STAN'.AND. 1IHARG(5).EQ.'DEVI')GOTO273 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'VARI')GOTO274 C CCCCC THE FOLLOWING 2 LINES WERE ADDED FEBRUARY 1994 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'VAR ')GOTO274 C IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'TRIM'.AND. 1IHARG(5).EQ.'MEAN')GOTO1274 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'MEAN')GOTO339 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'STAN'.AND. 1IHARG(5).EQ.'DEVI')GOTO340 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'SD ')GOTO3340 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'HARM'.AND.IHARG(4).EQ.'MEAN')GOTO341 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'RANG')GOTO344 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'IQ '.AND.IHARG(4).EQ.'RANG')GOTO344 C CCCCC THE FOLLOWING 2 LINES WERE ADDED APRIL 1990 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'EXTR'.AND.IHARG2(3).EQ.'EME ')GOTO292 C CCCCC THE FOLLOWING 12 LINES WERE ADDED APRIL 1990 C ISTEPN='2' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CP')GOTO281 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CPL')GOTO275 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CPU')GOTO276 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CPK')GOTO282 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CNPK')GOTO278 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'DEFE')GOTO283 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'ACTU'.AND.IHARG(4).EQ.'PERC'.AND. 1IHARG(5).EQ.'DEFE')GOTO284 IF(NUMARG.GE.5.AND. 1IHARG(3).EQ.'THEO'.AND.IHARG(4).EQ.'PERC'.AND. 1IHARG(5).EQ.'DEFE')GOTO285 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'EXPE'.AND.IHARG(4).EQ.'LOSS')GOTO286 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CPM')GOTO280 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'CC')GOTO279 C CCCCC THE FOLLOWING 2 LINES WERE ADDED FEBRUARY 1994 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'NORM'.AND.IHARG(4).EQ.'PPCC')GOTO321 C CCCCC THE FOLLOWING 4 LINES WERE ADDED MARCH 2003 IF(NUMARG.GE.4.AND. 1IHARG(3)(1:3).EQ.'SIN'.AND.IHARG(4).EQ.'FREQ')GOTO293 IF(NUMARG.GE.4.AND. 1IHARG(3)(1:3).EQ.'SIN'.AND.IHARG(4)(1:3).EQ.'AMP')GOTO294 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'INTE')GOTO295 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'SLOP')GOTO296 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'RESS')GOTO297 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'CORR')GOTO298 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'SN '.AND.IHARG(4).EQ.'SCAL')GOTO378 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'QN '.AND.IHARG(4).EQ.'SCAL')GOTO380 C CCCCC THE FOLLOWING 2 LINES WERE ADDED FEBRUARY 1994 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TAGU'.AND.IHARG(4).EQ.'SN- ')GOTO331 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TAGU'.AND.IHARG(4).EQ.'SN0 ')GOTO332 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TAGU'.AND.IHARG(4).EQ.'SN+ ')GOTO333 IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'TAGU'.AND.IHARG(4).EQ.'SN00')GOTO334 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SN- ')GOTO335 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SN0 ')GOTO336 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SN+ ')GOTO337 IF(NUMARG.GE.3.AND. 1IHARG(3).EQ.'SN00')GOTO338 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'COMM'.AND.IHARG(4).EQ.'DIGI')GOTO342 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'LOCA')GOTO346 C IF(NUMARG.GE.4.AND. 1IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'SCAL')GOTO348 C CCCCC MARCH 2003: ADD 35 "DIFFERENCE OF" STATISTICS C IF(NUMARG.GE.5.AND.IHARG(3).EQ.'DIFF'.AND.IHARG(4).EQ.'OF')THEN IF(IHARG(5).EQ.'AVER'.AND.IHARG(6).EQ.'ABSO'.AND. 1 IHARG(7).EQ.'DEVI')GOTO523 IF(IHARG(5).EQ.'AAD')GOTO423 IF(IHARG(5).EQ.'MEAN' .OR. IHARG(5).EQ.'AVER')GOTO401 IF(IHARG(5).EQ.'MIDM')GOTO402 IF(IHARG(5).EQ.'MEDI'.AND.IHARG(6).EQ.'ABSO'.AND. 1 IHARG(7).EQ.'DEVI')GOTO524 IF(IHARG(5).EQ.'MAD')GOTO424 IF(IHARG(5).EQ.'MEDI')GOTO403 IF(IHARG(5).EQ.'TRIM'.AND.IHARG(6).EQ.'MEAN')GOTO404 IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'MEAN')GOTO405 IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'MEAN')GOTO406 IF(IHARG(5).EQ.'HARM'.AND.IHARG(6).EQ.'MEAN')GOTO407 IF(IHARG(5).EQ.'HODG'.AND.IHARG(6).EQ.'LEHM')GOTO408 IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'LOCA')GOTO409 IF(IHARG(5).EQ.'SD'.AND.IHARG(6).EQ.'OF'.AND. 1 IHARG(7).EQ.'THE'.AND.IHARG(8).EQ.'MEAN')GOTO638 IF(IHARG(5).EQ.'SD'.AND.IHARG(6).EQ.'OF'.AND. 1 IHARG(7).EQ.'MEAN')GOTO538 IF(IHARG(5).EQ.'SD'.AND.IHARG(6).EQ.'MEAN')GOTO438 IF(IHARG(5).EQ.'SD')GOTO420 IF(IHARG(5).EQ.'STAN'.AND.IHARG(6).EQ.'DEVI')GOTO421 IF(IHARG(5).EQ.'VARI'.AND.IHARG(6).EQ.'OF'.AND. 1 IHARG(7).EQ.'THE'.AND.IHARG(8).EQ.'MEAN')GOTO640 IF(IHARG(5).EQ.'VARI'.AND.IHARG(6).EQ.'OF'.AND. 1 IHARG(7).EQ.'MEAN')GOTO540 IF(IHARG(5).EQ.'VARI'.AND.IHARG(6).EQ.'MEAN')GOTO440 IF(IHARG(5).EQ.'VARI')GOTO422 IF(IHARG(5).EQ.'INTE'.AND.IHARG(6).EQ.'RANG')GOTO425 IF(IHARG(5).EQ.'IQ '.AND.IHARG(6).EQ.'RANG')GOTO425 IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'STAN'.AND. 1 IHARG(7).EQ.'DEVI')GOTO526 IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'SD')GOTO426 IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'VARI')GOTO427 IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'MIDV')GOTO428 IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'SCAL')GOTO429 IF(IHARG(5).EQ.'PERC'.AND.IHARG(6).EQ.'BEND'.AND. 1 IHARG(7).EQ.'MIDV')GOTO430 IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'STAN'.AND. 1 IHARG(7).EQ.'DEVI')GOTO531 IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'SD')GOTO431 IF(IHARG(5).EQ.'RANG')GOTO432 IF(IHARG(5).EQ.'MIDR')GOTO433 IF(IHARG(5).EQ.'QUAN')GOTO434 IF(IHARG(5).EQ.'SKEW')GOTO435 IF(IHARG(5).EQ.'KURT')GOTO436 IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'SD')GOTO437 IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'VARI')GOTO439 IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'VARI')GOTO439 IF(IHARG(5).EQ.'MINI')GOTO441 IF(IHARG(5).EQ.'MAXI')GOTO442 IF(IHARG(5).EQ.'EXTR')GOTO443 IF(IHARG(5).EQ.'COEF'.AND.IHARG(6).EQ.'OF'.AND. 1 IHARG(7).EQ.'VARI')GOTO544 IF(IHARG(5).EQ.'COEF'.AND.IHARG(6).EQ.'VARI')GOTO444 IF(IHARG(5).EQ.'SN')GOTO545 IF(IHARG(5).EQ.'SN'.AND.IHARG(6).EQ.'SCAL')GOTO445 IF(IHARG(5).EQ.'QN')GOTO546 IF(IHARG(5).EQ.'QN'.AND.IHARG(6).EQ.'SCAL')GOTO446 IF(IHARG(5).EQ.'SUM')GOTO451 IF(IHARG(5).EQ.'SUMS')GOTO451 IF(IHARG(5).EQ.'SIZE')GOTO452 IF(IHARG(5).EQ.'NUMB')GOTO452 IF(IHARG(5).EQ.'COUN')GOTO452 ENDIF C IFOUN8='NO' GOTO9000 C C ********************** C ** STEP 2-- ** C ** DEFINE ICASL8. ** C ********************** C 201 CONTINUE ICASL8='NUMB' GOTO704 C 202 CONTINUE ICASL8='NUMB' GOTO705 C 203 CONTINUE ICASL8='SUM' GOTO704 C 204 CONTINUE ICASL8='PROD' GOTO704 C 205 CONTINUE ICASL8='INTE' GOTO704 C 206 CONTINUE ICASL8='MIDR' GOTO704 C 207 CONTINUE ICASL8='MEAN' GOTO704 C 208 CONTINUE ICASL8='MEAN' GOTO704 C 209 CONTINUE ICASL8='MIDM' GOTO704 C 210 CONTINUE ICASL8='MEDI' GOTO704 C 211 CONTINUE ICASL8='VARI' GOTO704 C 212 CONTINUE CCCCC NOVEMBER 1994. DISTINGUISH RELATIVE SD AND COEF OF VARIATION. CCCCC ICASL8='RESD' ICASL8='CVAR' GOTO706 C 214 CONTINUE CCCCC NOVEMBER 1994. DISTINGUISH RELATIVE SD AND COEF OF VARIATION. CCCCC ICASL8='RESD' ICASL8='CVAR' GOTO705 C 215 CONTINUE ICASL8='RANG' GOTO704 C 216 CONTINUE ICASL8='MINI' GOTO704 C 217 CONTINUE ICASL8='MINI' GOTO704 C 218 CONTINUE ICASL8='MAXI' GOTO704 C 219 CONTINUE ICASL8='MAXI' GOTO704 C 220 CONTINUE ICASL8='SKEW' GOTO707 C 221 CONTINUE ICASL8='SKEW' GOTO707 C 222 CONTINUE ICASL8='SKEW' GOTO704 C 223 CONTINUE ICASL8='KURT' GOTO707 C 224 CONTINUE ICASL8='KURT' GOTO707 C 225 CONTINUE ICASL8='KURT' GOTO704 C 226 CONTINUE ICASL8='AUCV' GOTO704 C 227 CONTINUE ICASL8='AUCR' GOTO704 C 228 CONTINUE ICASL8='LOWH' GOTO705 C 229 CONTINUE ICASL8='UPPH' GOTO705 C 230 CONTINUE ICASL8='SDME' GOTO708 C 231 CONTINUE ICASL8='SDME' GOTO707 C 232 CONTINUE ICASL8='SDME' GOTO706 C 233 CONTINUE ICASL8='SD' GOTO705 C 234 CONTINUE ICASL8='LOWQ' GOTO705 C 235 CONTINUE ICASL8='MIDQ' GOTO705 C 236 CONTINUE ICASL8='UPPQ' GOTO705 C 237 CONTINUE ICASL8='TRIM' GOTO705 C 238 CONTINUE ICASL8='WINM' GOTO705 C CCCCC THE FOLLOWING 3 LINES WERE ADDED SEPTEMBER 1990 239 CONTINUE ICASL8='SD' GOTO704 C CCCCC THE FOLLOWING 40 LINES WERE CHANGED AND ADDED TO AUGUST 1991 250 CONTINUE ICASL8='COVA' GOTO704 C 251 CONTINUE ICASL8='CORR' GOTO705 C 252 CONTINUE ICASL8='CORR' GOTO704 C 253 CONTINUE ICASL8='COMO' GOTO705 C 254 CONTINUE ICASL8='COMO' GOTO704 C 255 CONTINUE ICASL8='RACV' GOTO705 C 256 CONTINUE ICASL8='RACR' GOTO706 C 257 CONTINUE ICASL8='RACR' GOTO705 C 258 CONTINUE ICASL8='RACM' GOTO706 C 259 CONTINUE ICASL8='RACM' GOTO705 C 261 CONTINUE ICASL8='1DEC' GOTO705 C 262 CONTINUE ICASL8='2DEC' GOTO705 C 263 CONTINUE ICASL8='3DEC' GOTO705 C 264 CONTINUE ICASL8='4DEC' GOTO705 C 265 CONTINUE ICASL8='5DEC' GOTO705 C 266 CONTINUE ICASL8='6DEC' GOTO705 C 267 CONTINUE ICASL8='7DEC' GOTO705 C 268 CONTINUE ICASL8='8DEC' GOTO705 C 269 CONTINUE ICASL8='9DEC' GOTO705 C 270 CONTINUE ICASL8='PERC' GOTO705 C 271 CONTINUE ICASL8='WEME' GOTO705 C 272 CONTINUE ICASL8='WEMD' GOTO705 C 273 CONTINUE ICASL8='WESD' GOTO706 C 274 CONTINUE ICASL8='WEVA' GOTO705 C 1274 CONTINUE ICASL8='WETM' GOTO706 C 275 CONTINUE ICASL8='CPL' GOTO704 C 276 CONTINUE ICASL8='CPU' GOTO704 C 278 CONTINUE ICASL8='CNPK' GOTO704 C 279 CONTINUE ICASL8='CC' GOTO704 C 280 CONTINUE ICASL8='CPM' GOTO704 C CCCCC THE FOLLOWING 6 SECTIONS WERE ADDED SEPTEMBER 1990 281 CONTINUE ICASL8='CP' GOTO704 C 282 CONTINUE ICASL8='CPK' GOTO704 C 283 CONTINUE ICASL8='ACPD' GOTO705 C 284 CONTINUE ICASL8='ACPD' GOTO706 C 285 CONTINUE ICASL8='THPD' GOTO706 C 286 CONTINUE ICASL8='EXPL' GOTO705 C 287 CONTINUE ICASL8='AAD ' GOTO704 C 288 CONTINUE ICASL8='MAD ' GOTO704 C 289 CONTINUE ICASL8='MAD ' GOTO706 C 291 CONTINUE ICASL8='AAD ' GOTO706 C CCCCC THE FOLLOWING 3 LINES WERE ADDED FEBRUARY 1994 292 CONTINUE ICASL8='EXTR' GOTO704 C CCCCC THE FOLLOWING 3 LINES WERE ADDED MARCH 2003 293 CONTINUE ICASL8='SIFR' GOTO705 C CCCCC THE FOLLOWING 3 LINES WERE ADDED MARCH 2003 294 CONTINUE ICASL8='SIAM' GOTO705 C CCCCC THE FOLLOWING 3 LINES WERE ADDED MARCH 2003 295 CONTINUE ICASL8='LIIN' GOTO705 C CCCCC THE FOLLOWING 3 LINES WERE ADDED MARCH 2003 296 CONTINUE ICASL8='LISL' GOTO705 C CCCCC THE FOLLOWING 3 LINES WERE ADDED MARCH 2003 297 CONTINUE ICASL8='LIRE' GOTO705 C CCCCC THE FOLLOWING 3 LINES WERE ADDED MARCH 2003 298 CONTINUE ICASL8='LICO' GOTO705 C CCCCC THE FOLLOWING 7 SECTIONS WERE ADDED FEBRUARY 1994 301 CONTINUE ICASL8='SDME' GOTO707 C 302 CONTINUE ICASL8='SDME' GOTO706 C 303 CONTINUE ICASL8='SDME' GOTO705 C 304 CONTINUE ICASL8='SD' GOTO704 C 306 CONTINUE ICASL8='VAME' GOTO707 C 307 CONTINUE ICASL8='VAME' GOTO706 C 308 CONTINUE ICASL8='VAME' GOTO705 C 311 CONTINUE ICASL8='RESD' GOTO705 C 312 CONTINUE ICASL8='REVA' GOTO705 C 321 CONTINUE ICASL8='NOPP' GOTO705 C CCCCC THE FOLLOWING 6 SECTIONS WERE ADDED FEBRUARY 1994 331 CONTINUE ICASL8='SN-' GOTO705 C 332 CONTINUE ICASL8='SN0' GOTO705 C 333 CONTINUE ICASL8='SN+' GOTO705 C 334 CONTINUE ICASL8='SN00' GOTO705 C 335 CONTINUE ICASL8='SN-' GOTO704 C 336 CONTINUE ICASL8='SN0' GOTO704 C 337 CONTINUE ICASL8='SN+' GOTO704 C 338 CONTINUE ICASL8='SN00' GOTO704 C 339 CONTINUE ICASL8='GEME' GOTO705 C 3340 CONTINUE ICASL8='GESD' GOTO705 C 340 CONTINUE ICASL8='GESD' GOTO706 C 341 CONTINUE ICASL8='HAME' GOTO705 C 342 CONTINUE ICASL8='CDIG' GOTO705 C 343 CONTINUE ICASL8='NCDI' GOTO707 C 344 CONTINUE ICASL8='IQRA' GOTO705 C 346 CONTINUE ICASL8='BILO' GOTO705 C 348 CONTINUE ICASL8='BISC' GOTO705 C 352 CONTINUE ICASL8='WIVA' GOTO705 C 354 CONTINUE ICASL8='WISD' GOTO705 C 356 CONTINUE ICASL8='WISD' GOTO706 C 358 CONTINUE ICASL8='HLEH' GOTO706 C 360 CONTINUE ICASL8='HLEH' GOTO705 C 362 CONTINUE ICASL8='PBMV' GOTO706 C 363 CONTINUE ICASL8='PBCR' GOTO706 C 364 CONTINUE ICASL8='WICV' GOTO705 C 366 CONTINUE ICASL8='WICR' GOTO705 C 368 CONTINUE ICASL8='BIMV' GOTO705 C 369 CONTINUE ICASL8='BICR' GOTO705 C 370 CONTINUE ICASL8='BIMC' GOTO705 C 372 CONTINUE ICASL8='QUSE' GOTO707 C 374 CONTINUE ICASL8='QUAN' GOTO705 C 376 CONTINUE ICASL8='TMSE' GOTO707 C 378 CONTINUE ICASL8='SNSC' GOTO705 C 380 CONTINUE ICASL8='QNSC' GOTO705 C 401 CONTINUE ICASL8='DMEA' GOTO706 C 402 CONTINUE ICASL8='DMDM' GOTO706 C 403 CONTINUE ICASL8='DMED' GOTO706 C 404 CONTINUE ICASL8='DTRM' GOTO707 C 405 CONTINUE ICASL8='DWNM' GOTO707 C 406 CONTINUE ICASL8='DGEO' GOTO707 C 407 CONTINUE ICASL8='DHAR' GOTO707 C 408 CONTINUE ICASL8='DHDL' GOTO707 C 409 CONTINUE ICASL8='DBIW' GOTO707 C 420 CONTINUE ICASL8='DSD ' GOTO706 C 421 CONTINUE ICASL8='DSD ' GOTO707 C 422 CONTINUE ICASL8='DVAR' GOTO706 C 523 CONTINUE ICASL8='DAAD' GOTO708 C 423 CONTINUE ICASL8='DAAD' GOTO706 C 524 CONTINUE ICASL8='MAAD' GOTO708 C 424 CONTINUE ICASL8='DMAD' GOTO706 C 425 CONTINUE ICASL8='DIQR' GOTO707 C 526 CONTINUE ICASL8='DWSD' GOTO708 C 426 CONTINUE ICASL8='DWSD' GOTO707 C 427 CONTINUE ICASL8='DWVA' GOTO707 C 428 CONTINUE ICASL8='DBIM' GOTO707 C 429 CONTINUE ICASL8='DBIS' GOTO707 C 430 CONTINUE ICASL8='DPBN' GOTO708 C 531 CONTINUE ICASL8='DGSD' GOTO708 C 431 CONTINUE ICASL8='DGSD' GOTO707 C 432 CONTINUE ICASL8='DRAN' GOTO706 C 433 CONTINUE ICASL8='DMDR' GOTO706 C 434 CONTINUE ICASL8='DQUA' GOTO706 C 435 CONTINUE ICASL8='DSKE' GOTO706 C 436 CONTINUE ICASL8='DKUR' GOTO706 C 437 CONTINUE ICASL8='DRSD' GOTO707 C 638 CONTINUE ICASL8='DSDM' GOTO709 C 538 CONTINUE ICASL8='DSDM' GOTO708 C 438 CONTINUE ICASL8='DSDM' GOTO707 C 439 CONTINUE ICASL8='DRVA' GOTO707 C 640 CONTINUE ICASL8='DVAM' GOTO709 C 540 CONTINUE ICASL8='DVAM' GOTO708 C 440 CONTINUE ICASL8='DVAM' GOTO707 C 441 CONTINUE ICASL8='DMIN' GOTO706 C 442 CONTINUE ICASL8='DMAX' GOTO706 C 443 CONTINUE ICASL8='DEXT' GOTO706 C 544 CONTINUE ICASL8='DCVA' GOTO708 C 444 CONTINUE ICASL8='DCVA' GOTO707 C 545 CONTINUE ICASL8='DSN' GOTO706 C 445 CONTINUE ICASL8='DSN' GOTO707 C 546 CONTINUE ICASL8='DQN' GOTO706 C 446 CONTINUE ICASL8='DQN' GOTO707 C 451 CONTINUE ICASL8='DSUM' GOTO706 C 452 CONTINUE ICASL8='DCOU' GOTO706 C 480 CONTINUE ICASL8='KTAU' GOTO706 C 481 CONTINUE ICASL8='KTAU' GOTO705 C 486 CONTINUE ICASL8='REPE' GOTO706 C 487 CONTINUE ICASL8='REPE' GOTO705 C 488 CONTINUE ICASL8='REPE' GOTO704 C 491 CONTINUE ICASL8='REPR' GOTO706 C 492 CONTINUE ICASL8='REPR' GOTO705 C 493 CONTINUE ICASL8='REPR' GOTO704 C 494 CONTINUE ICASL8='RATI' GOTO704 C C ***************************************************** C ** STEP 3-- ** C ** DETERMINE IF THE WORD (OR COLUMN DESIGNATION) ** C ** AFTER THE KEY WORD (SORT, RANK, ETC.) IS A ** C ** VALID DATA VARIABLE OR COLUMN. ** C ** DEFINE ILOCV. ** C ***************************************************** C 704 CONTINUE ILOCV=4 GOTO720 C 705 CONTINUE ILOCV=5 GOTO720 C 706 CONTINUE ILOCV=6 GOTO720 C 707 CONTINUE ILOCV=7 GOTO720 C 708 CONTINUE ILOCV=8 GOTO720 C 709 CONTINUE ILOCV=9 GOTO720 C 720 CONTINUE IF(ILOCV.GT.NUMARG)GOTO739 IH=IHARG(ILOCV) IH2=IHARG2(ILOCV) DO730I=1,NUMNAM IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO740 730 CONTINUE 739 CONTINUE IFOUN8='NO' ICASL8='UNKN' GOTO9000 740 CONTINUE IFOUN8='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE C IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKSTAT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IFOUN8,ICASL8,ILOCV,NUMARG 9014 FORMAT('IFOUN8,ICASL8,ILOCV,NUMARG = ',A4,2X,A4,2I8) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE CKTMPA(PROP1,PROP2,IBUGG3,ISUBRO,IERROR) C C PURPOSE--CHECK THE PARAMETERS NEEDED C FOR THE TRIMMED MEAN STATISTIC C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--89/6 C ORIGINAL VERSION--MAY 1988. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGG3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 IHP CHARACTER*4 IHP2 CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CCCCC CHARACTER*4 IWRITE C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CCCCC CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.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='CKTM' ISUBN2='PA ' C IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'TMPA')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF CKTMPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR 52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C -------------------------- C IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO1110 PROP1=VALUE(ILOCP) GOTO1119 C 1110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1111) 1111 FORMAT('***** ERROR IN CKCPPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1112) 1112 FORMAT(' IN COMPUTING THE TRIMMED MEAN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1113) 1113 FORMAT(' AND THE WINSORIZED MEAN STATISTICS,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1114) 1114 FORMAT(' THE VALUE OF THE PROPORTION (%)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115) 1115 FORMAT(' TO BE TRIMMED/WINSORIZED BELOW') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1116) 1116 FORMAT(' MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117) 1117 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE P1,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1118) 1118 FORMAT(' AS IN LET P1 = 25') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1119 CONTINUE C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO1149 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1131) 1131 FORMAT('***** ERROR IN CKCPPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1132) 1132 FORMAT(' IN COMPUTING THE TRIMMED MEAN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1133) 1133 FORMAT(' AND THE WINSORIZED MEAN STATISTICS,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1134) 1134 FORMAT(' THE VALUE OF THE PROPORTION (%)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1135) 1135 FORMAT(' TO BE TRIMMED/WINSORIZED BELOW') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1136) 1136 FORMAT(' MUST BE BETWEEN 0 AND 100.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1137) 1137 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1138) 1138 FORMAT(' THE CURRENT VALUE OF THE PARAMETER P1 = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1139) 1139 FORMAT(' USE THE LET COMMAND TO RE-DEFINE P1,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1140) 1140 FORMAT(' AS IN LET P1 = 25') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1149 CONTINUE C C -------------------------- C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO2110 PROP2=VALUE(ILOCP) GOTO2119 C 2110 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2111) 2111 FORMAT('***** ERROR IN CKCPPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2112) 2112 FORMAT(' IN COMPUTING THE TRIMMED MEAN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2113) 2113 FORMAT(' AND THE WINSORIZED MEAN STATISTICS,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2114) 2114 FORMAT(' THE VALUE OF THE PROPORTION (%)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2115) 2115 FORMAT(' TO BE TRIMMED/WINSORIZED ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2116) 2116 FORMAT(' MUST BE PRE-DEFINED.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2117) 2117 FORMAT(' USE THE LET COMMAND TO PRE-DEFINE P2,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2118) 2118 FORMAT(' AS IN LET P2 = 25') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 2119 CONTINUE C IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO2149 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2131) 2131 FORMAT('***** ERROR IN CKCPPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2132) 2132 FORMAT(' IN COMPUTING THE TRIMMED MEAN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2133) 2133 FORMAT(' AND THE WINSORIZED MEAN STATISTICS,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2134) 2134 FORMAT(' THE VALUE OF THE PROPORTION (%)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2135) 2135 FORMAT(' TO BE TRIMMED/WINSORIZED ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2136) 2136 FORMAT(' MUST BE BETWEEN 0 AND 100.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2137) 2137 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2138) 2138 FORMAT(' THE CURRENT VALUE OF THE PARAMETER P2 = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2139) 2139 FORMAT(' USE THE LET COMMAND TO RE-DEFINE P2,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2140) 2140 FORMAT(' AS IN LET P2 = 25') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 2149 CONTINUE C C ****************** C ** STEP 90-- ** C ** EXIT ** C ****************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'TMPA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CKTMPA--') 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)PROP1,PROP2 9013 FORMAT('PROP1,PROP2 = ',2E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END DOUBLE PRECISION FUNCTION CLAUSN(XVALUE) C C DESCRIPTION: C C This program calculates Clausen's integral defined by C C CLAUSN(x) = integral 0 to x of (-ln(2*sin(t/2))) dt C C The code uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C C ERROR RETURNS: C C If |x| is too large it is impossible to reduce the argument C to the range [0,2*pi] with any precision. An error message C is printed and the program returns the value 0.0 C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - the no. of terms of the array ACLAUS C to be used. The recommended value is C such that ABS(ACLAUS(NTERMS)) < EPS/100 C subject to 1 <= NTERMS <= 15 C C XSMALL - DOUBLE PRECISION - the value below which Cl(x) can be C approximated by x (1-ln x). The recommended C value is pi*sqrt(EPSNEG/2). C C XHIGH - DOUBLE PRECISION - The value of |x| above which we cannot C reliably reduce the argument to [0,2*pi]. C The recommended value is 1/EPS. C C For values of EPS and EPSNEG refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St. C PAISLEY C SCOTLAND C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 23 January, 1996 C INTEGER INDX,NTERMS DOUBLE PRECISION ACLAUS(0:15),CHEVAL,HALF,ONE,ONEHUN,PI,PISQ,T, & TWOPI,TWOPIA,TWOPIB,X,XHIGH,XSMALL,XVALUE,ZERO CCCCC CHARACTER FNNAME*6,ERRMSG*26 C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOMC.INC' 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 CCCCC DATA FNNAME/'CLAUSN'/ CCCCC DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA PI/3.14159 26535 89793 2385 D 0/ DATA PISQ/9.86960 44010 89358 6188 D 0/ DATA TWOPI/6.28318 53071 79586 4769 D 0/ DATA TWOPIA,TWOPIB/6.28125 D 0 , 0.19353 07179 58647 69253 D -2/ DATA ACLAUS/2.14269 43637 66688 44709 D 0, 1 0.72332 42812 21257 9245 D -1, 2 0.10164 24750 21151 164 D -2, 3 0.32452 50328 53164 5 D -4, 4 0.13331 51875 71472 D -5, 5 0.62132 40591 653 D -7, 6 0.31300 41353 37 D -8, 7 0.16635 72305 6 D -9, 8 0.91965 9293 D -11, 9 0.52400 462 D -12, X 0.30580 40 D -13, 1 0.18196 9 D -14, 2 0.11004 D -15, 3 0.675 D -17, 4 0.42 D -18, 5 0.3 D -19/ C C Start execution C X = XVALUE C C Compute the machine-dependent constants. C T = D1MACH(3) XHIGH = ONE / T C C Error test C IF ( ABS(X) .GT. XHIGH ) THEN CCCCC CALL ERRPRN(FNNAME,ERRMSG) WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,101) CALL DPWRST('XXX','BUG ') CLAUSN = ZERO RETURN ENDIF 999 FORMAT(1X) 101 FORMAT('***** ERROR FROM CLAUSN--ARGUMENT TOO LARGE. ', 1 'ARGUMENT = ',G15.7) C C Continue with machine-dependent constants C XSMALL = PI * SQRT ( HALF * T ) T = T / ONEHUN DO 10 NTERMS = 15 , 0 , -1 IF ( ABS(ACLAUS(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Continue with computation C 19 INDX = 1 IF ( X .LT. ZERO ) THEN X = -X INDX = -1 ENDIF C C Argument reduced using simulated extra precision C IF ( X .GT. TWOPI ) THEN T = AINT( X / TWOPI ) X = ( X - T * TWOPIA ) - T * TWOPIB ENDIF IF ( X .GT. PI ) THEN X = ( TWOPIA - X ) + TWOPIB INDX = -INDX ENDIF C C Set result to zero if X multiple of PI C IF ( X .EQ. ZERO ) THEN CLAUSN = ZERO RETURN ENDIF C C Code for X < XSMALL C IF ( X .LT. XSMALL ) THEN CLAUSN = X * ( ONE - LOG( X ) ) ELSE C C Code for XSMALL < = X < = PI C T = ( X * X ) / PISQ - HALF T = T + T IF ( T .GT. ONE ) T = ONE CLAUSN = X * CHEVAL( NTERMS,ACLAUS,T ) - X * LOG( X ) ENDIF IF ( INDX .LT. 0 ) CLAUSN = -CLAUSN RETURN END COMPLEX FUNCTION CLBETA(A,B) C***BEGIN PROLOGUE CLBETA C***DATE WRITTEN 770701 (YYMMDD) C***REVISION DATE 820801 (YYMMDD) C***CATEGORY NO. C7B C***KEYWORDS BETA FUNCTION,COMPLETE BETA FUNCTION,COMPLEX,LOGARITHM, C SPECIAL FUNCTION C***AUTHOR FULLERTON, W., (LANL) C***PURPOSE CLBETA computes the natural log of the complex valued C complete Beta function of complex parameters A and B. C***DESCRIPTION C C CLBETA computes the natural log of the complex valued complete beta C function of complex parameters A and B. This is a preliminary version C which is not accurate. C C Input Parameters: C A complex and the real part of A positive C B complex and the real part of B positive C***REFERENCES (NONE) C***ROUTINES CALLED CLNGAM,XERROR C***END PROLOGUE CLBETA COMPLEX A, B, CLNGAM 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***FIRST EXECUTABLE STATEMENT CLBETA IF (REAL(A).LE.0.0 .OR. REAL(B).LE.0.0) THEN CCCCC CALL XERROR ( 'CLBETA REA CCCCC1L PART OF BOTH ARGUMENTS MUST BE GT 0', 48, 1, 2) WRITE(ICOUT,11) CALL DPWRST('XXX','BUG ') ENDIF 11 FORMAT('***** ERROR FROM CLBETA: REAL PARTS OF PARAMETER', 1 'MUST BE POSITIVE') C CLBETA = CLNGAM(A) + CLNGAM(B) - CLNGAM(A+B) C RETURN END COMPLEX FUNCTION CLNGAM(ZIN) C***BEGIN PROLOGUE CLNGAM C***DATE WRITTEN 780401 (YYMMDD) C***REVISION DATE 820801 (YYMMDD) C***CATEGORY NO. C7A C***KEYWORDS ABSOLUTE VALUE,COMPLETE GAMMA FUNCTION,COMPLEX, C GAMMA FUNCTION,LOGARITHM,SPECIAL FUNCTION C***AUTHOR FULLERTON, W., (LANL) C***PURPOSE CLNGAM computes the natural log of the complex valued Gamma C function at ZIN, where ZIN is a complex number. C***DESCRIPTION C C CLNGAM computes the natural log of the complex valued gamma function C at ZIN, where ZIN is a complex number. This is a preliminary version, C which is not accurate. C***REFERENCES (NONE) C***ROUTINES CALLED C9LGMC,CARG,CLNREL,R1MACH,XERROR C***END PROLOGUE CLNGAM COMPLEX ZIN, Z, CORR, CEXP, CLOG, CLNREL, C9LGMC C INCLUDE 'DPCOMC.INC' 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 EXTERNAL CARG DATA PI / 3.1415926535 8979324E0 / DATA SQ2PIL / 0.9189385332 0467274E0 / DATA BOUND, DXREL / 2*0.0 / C***FIRST EXECUTABLE STATEMENT CLNGAM IF (BOUND.NE.0.) GO TO 10 N = -0.30*ALOG(R1MACH(3)) C BOUND = N*(0.1*EPS)**(-1/(2*N-1))/(PI*EXP(1)) BOUND = 0.1171*FLOAT(N)*(0.1*R1MACH(3))**(-1./(2.*FLOAT(N)-1.)) DXREL = SQRT (R1MACH(4)) C 10 Z = ZIN X = REAL(ZIN) Y = AIMAG(ZIN) C CORR = (0.0, 0.0) CABSZ = CABS(Z) IF (X.GE.0.0 .AND. CABSZ.GT.BOUND) GO TO 50 IF (X.LT.0.0 .AND. ABS(Y).GT.BOUND) GO TO 50 C IF (CABSZ.LT.BOUND) GO TO 20 C C USE THE REFLECTION FORMULA FOR REAL(Z) NEGATIVE, CABS(Z) LARGE, AND C ABS(AIMAG(Y)) SMALL. C IF (Y.GT.0.0) Z = CONJG (Z) CORR = CEXP (-CMPLX(0.0,2.0*PI)*Z) IF (REAL(CORR).EQ.1.0 .AND. AIMAG(CORR).EQ.0.0) THEN CCCCC CALL XERROR ( 'CLN CCCCC1GAM Z IS A NEGATIVE INTEGER', 31, 3, 2) WRITE(ICOUT,11) CALL DPWRST('XXX','BUG ') ENDIF 11 FORMAT('***** ERROR FROM CLNGAM: ARGUMENT IS A NEGATIVE ', 1 'INTEGER') C CLNGAM = SQ2PIL + 1.0 - CMPLX(0.0,PI)*(Z-0.5) - CLNREL(-CORR) 1 + (Z-0.5)*CLOG(1.0-Z) - Z - C9LGMC(1.0-Z) IF (Y.GT.0.0) CLNGAM = CONJG (CLNGAM) RETURN C C USE THE RECURSION RELATION FOR CABS(Z) SMALL. C 20 IF (X.GE.(-0.5) .OR. ABS(Y).GT.DXREL) GO TO 30 IF (CABS((Z-AINT(X-0.5))/X).LT.DXREL) THEN CCCCC CALL XERROR ( 'CLNGAM ANSWE CCCCC1R LT HALF PRECISION BECAUSE Z TOO NEAR NEGATIVE INTEGER', 68,1,1) WRITE(ICOUT,21) CALL DPWRST('XXX','BUG ') ENDIF 21 FORMAT('***** ERROR FROM CLNGAM: ARGUMENT IS TOO NEAR A ', 1'NEGATIVE INTEGER') C C 30 N = SQRT (BOUND**2 - Y**2) - X + 1.0 ARGSUM = 0.0 CORR = (1.0, 0.0) DO 40 I=1,N ARGSUM = ARGSUM + CARG(Z) CORR = Z*CORR Z = 1.0 + Z 40 CONTINUE C IF (REAL(CORR).EQ.0.0 .AND. AIMAG(CORR).EQ.0.0) THEN CCCCC CALL XERROR ( 'CLN CCCCC1GAM Z IS A NEGATIVE INTEGER', 31, 3, 2) WRITE(ICOUT,31) CALL DPWRST('XXX','BUG ') ENDIF 31 FORMAT('***** ERROR FROM CLNGAM: ARGUMENT IS A NEGATIVE ', 1 'INTEGER') C CORR = -CMPLX (ALOG(CABS(CORR)), ARGSUM) C C USE STIRLING-S APPROXIMATION FOR LARGE Z. C 50 CLNGAM = SQ2PIL + (Z-0.5)*CLOG(Z) - Z + CORR + C9LGMC(Z) RETURN C END COMPLEX FUNCTION CLNREL(Z) C***BEGIN PROLOGUE CLNREL C***DATE WRITTEN 770401 (YYMMDD) C***REVISION DATE 820801 (YYMMDD) C***CATEGORY NO. C4B C***KEYWORDS COMPLEX,ELEMENTARY FUNCTION,LOGARITHM,RELATIVE ERROR C***AUTHOR FULLERTON, W., (LANL) C***PURPOSE Computes the principal value of the complex natural C logarithm of 1+Z with relative error accuracy for small C CABS(Z). C***DESCRIPTION C C CLNREL(Z) = CLOG(1+Z) with relative error accuracy near Z = 0. C Let RHO = CABS(Z) and C R**2 = CABS(1+Z)**2 = (1+X)**2 + Y**2 = 1 + 2*X + RHO**2 . C Now if RHO is small we may evaluate CLNREL(Z) accurately by C CLOG(1+Z) = CMPLX (ALOG(R), CARG(1+Z)) C = CMPLX (0.5*ALOG(R**2), CARG(1+Z)) C = CMPLX (0.5*ALNREL(2*X+RHO**2), CARG(1+Z)) C***REFERENCES (NONE) C***ROUTINES CALLED ALNREL,CARG,R1MACH,XERROR C***END PROLOGUE CLNREL COMPLEX Z, CLOG C INCLUDE 'DPCOMC.INC' 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 EXTERNAL CARG DATA SQEPS /0.0/ C***FIRST EXECUTABLE STATEMENT CLNREL IF (SQEPS.EQ.0.) SQEPS = SQRT (R1MACH(4)) C IF (CABS(1.+Z).LT.SQEPS) THEN CCCCC CALL XERROR ( 'CLNREL ANSWER LT HALF PRE CCCCC1CISION BECAUSE Z TOO NEAR -1', 54, 1, 1) WRITE(ICOUT,102) CALL DPWRST('XXX','BUG ') ENDIF 102 FORMAT('***** INTERNAL WARNING FROM CLNREL: ANSWER IS LESS THAN' 1,' HALF PRECISION BECAUSE ARGUMENT TOO NEAR -1') C RHO = CABS(Z) IF (RHO.GT.0.375) CLNREL = CLOG (1.0+Z) IF (RHO.GT.0.375) RETURN C X = REAL(Z) CLNREL = CMPLX (0.5*ALNREL(2.*X+RHO**2), CARG(1.0+Z)) C RETURN END SUBROUTINE CMESUB(X,N,SLOPE,R1,X2,R,NX,INDR,SDC) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SUBROUTINE TO COMPUTE CME C C (=MRL) FUNCTION : C C MAIN FORMULA: C C E[X-u | X > u] = (A + cu)/(1 - c) C C INPUT ARGUMENTS: C C X - ARRAY OF DATA (ALREADY C C SORTED) C C N - NUMBER OF POINTS IN X TO C C USE C C OUTPUT ARGUMENTS: C C SLOPE - = c/(1-c) C C (OR c = SLOPE/(1+SLOPE) C C R1 - R(1) (= INTERCEPT) C C NOTE THAT THE CALLING ROUTINE IS C C REALLY INTERESTED IN A AND C. C C C = SLOPE/(1+SLOPE) C C A = R(1)*(1 - C) C C THE CALCULATIONS FOR A AND C ARE DONE C C IN THE CALLING ROUTINE FROM THE C C RETURNED VALUES OF SLOPE AND R(1) C C C C NOTE THAT A AND C ARE THE SCALE AND C C SHAPE PARAMETERS FOR THE GENERALIZED C C PARETO DISTRIBUTION. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C MAY 2005: ADD COMPUTATION OF SD(CHAT) C C SD(CHAT) = SQRT(TERM1)*SQRT(TERM2)/(TERM3*TERM4*SQRT(TERM5 - TERM6)) C C WHERE C C TERM1 = SUM[i=1 to n-1][n-i] C TERM2 = SUM[i=1 to n-1][(n-i)*(y(i) - intercept - x(i)*slope))**2] C TERM3 = SQRT(N-3) C TERM4 = (1 + SLOPE)**2 C TERM5 = SUM[i=1 to n-1][n-i]*SUM[i=1 to n-1][(n-i)**x(i)**2] C TERM6 = {SUM[i=1 to n-1][(n-i)*x(i)]}**2 C C x(i) = INPUT WIND SPEEDS C y(i) = R(i) C REFERENCE: GROSS, HECKERT, LECHNER, AND SIMIU (1995). "EXTREME C WIND ESTIMATES BY THE CONDITIONAL MEAN EXCEEDANCE C PROCEDURE", NISTIT 5531. C REAL X(*) REAL X2(*) REAL R(*) REAL NX(*) INTEGER INDR(*) C INTEGER NM1 REAL SMALLX,RSUM,NSUM,SLOPE C DOUBLE PRECISION SUMRX DOUBLE PRECISION SUMXSQ DOUBLE PRECISION SUMI DOUBLE PRECISION SUMX DOUBLE PRECISION SUMR DOUBLE PRECISION DTERM1 DOUBLE PRECISION DTERM2 DOUBLE PRECISION DTERM3 DOUBLE PRECISION DTERM4 DOUBLE PRECISION DTERM5 DOUBLE PRECISION DTERM6 DOUBLE PRECISION DSD DOUBLE PRECISION DR1 DOUBLE PRECISION DSLOPE DOUBLE PRECISION DX DOUBLE PRECISION DY C NM1=N-1 C DO 10 I=1,N INDR(I)=1 10 CONTINUE C DO 11 I=1,NM1 R(I)=0. NX(I)=1. 11 CONTINUE CC CC DO 50 K=1,NM1 C SMALLX=X(K) C NSUM=0. C DO 21 I=K,N IF(X(I).GT.SMALLX) NSUM=NSUM+1. 21 CONTINUE C NX(K)=NSUM C DO 22 I=1,N X2(I)=X(I)-SMALLX 22 CONTINUE C RSUM=0. DO 23 I=K,N IF(X(I).GT.SMALLX) RSUM=RSUM+X2(I) 23 CONTINUE C R(K)=RSUM CC 50 CONTINUE CC DO 60 I=1,NM1 R(I)=R(I)/NX(I) 60 CONTINUE CC CCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CME HAVING BEEN COMPUTED C C AT THIS POINT, IT REMAINS C TO COMPUTE THE TERMINAL C C SLOPE. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCC CC CCCCCCCCCCCCCCCCCC C DOT PRODUCT C C NUMERATOR & C C SSQ(X) DEN- C C OMINATOR. C CCCCCCCCCCCCCCCCCC C SUMI=0.0D0 SUMX=0.0D0 SUMR=0.0D0 SUMRX=0.0D0 SUMXSQ=0.0D0 C DO 100 I=1,NM1 C SUMRX=SUMRX+DBLE(R(I))*DBLE(X(I)) SUMXSQ=SUMXSQ+DBLE(X(I))*DBLE(X(I)) SUMI = SUMI + 1.0D0 SUMX = SUMX + DBLE(X(I)) SUMR = SUMR + DBLE(R(I)) C 100 CONTINUE C DSLOPE=(SUMRX - SUMR*SUMX/SUMI)/(SUMXSQ-SUMX**2/SUMI) SLOPE=REAL(DSLOPE) R1=R(1) C CCCCC MAY 2005. NOW COMPUTE THE STANDARD DEVIAITION C DR1=DBLE(R(1)) DSLOPE=DBLE(SLOPE) C DTERM1=0.0D0 DTERM2=0.0D0 DTERM3=DSQRT(DBLE(N-3)) DTERM4=(1.0D0 + DSLOPE)**2 DTERM6=0.0D0 C DO 900 I=1,NM1 C DY=DBLE(R(I)) DX=DBLE(X(I)) C DTERM1=DTERM1 + DBLE(N-I) DTERM2=DTERM2 + DBLE(N-I)*(DY - DR1 - DSLOPE*DY)**2 DTERM6=DTERM6 + DBLE(N-I)*DX DTERM5=DTERM5 + DBLE(N-I)*DX**2 C 900 CONTINUE DTERM5=DTERM1*DTERM5 DTERM6=DTERM6*DTERM6 C DSD=DSQRT(DTERM1)*DSQRT(DTERM2)/ 1 (DTERM3*DTERM4*DSQRT(DTERM5 - DTERM6)) SDC=REAL(DSD) C CCCCCCCCCCCCCCCCCCCCCCCC C RETURN CONTROL TO C C DRIVER ROUTINE C CCCCCCCCCCCCCCCCCCCCCCCC C RETURN END SUBROUTINE CMPSTA( 1TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3, 1MAXNXT,NS2,NSZ,NUMV2,ICASPL, 1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6, 1IQUAME,IQUASE, 1RIGHT, 1ISUBRO,IBUGG3,IERROR) C C PURPOSE--COMPUTE THE VALUE OF ONE OF 90+ STATISTICS. THIS C IS A COMMON ROUTINE CALLED BY: C 1) DPSTAC = LET A = C 2) DPSP2 = STATISTIC PLOT C 3) DPCRP2 = CROSS TABULATE PLOT C 4) DPBLO2 = BLOCK PLOT C 5) DPJBS2 = BOOTSTRAP/JACKNIFE PLOT C 6) DPDEX2 = DEX PLOT C 7) DPINF2 = INFLUENCE CURVE C 8) DPTAB2 = TABULATE C 9) DPCRT2 = CROSS TABULATE C 10) MATAR3 = MATRIX C 11) DPMATC = LET ... = CROSS TABULATE C C NOTE THAT THE DEX ... PLOT, ... BLOCK PLOT, AND C ... INFLUENCE CURVE, MATRIX ONLY SUPPORT C STATISTICS COMPUTED FROM A SINGLE RESPONSE VARIABLE. C ALSO, SOME COMMANDS MAY NOT SUPPORT ALL STATISTICS IN C THIS LIST (OR, LESS FREQUENTLY, A COMMAND MAY SUPPORT C SOME ADDITIONAL STATISTICS NOT COMPUTED HERE). C C USING A COMMON ROUTINE MAKES IT EASIER TO ADD C A STATISTIC AND INCORPORATE IT INTO ALL THE C RELEVANT PLOTS/TABULATIONS. SHOULD ALSO REDUCE C THE LIKELIHOOD OF BUGS, ETC. C C FOLLOWING STATISTICS ARE SUPPORTED: C C FOLLOWING STATISTICS REQUIRE ONE RESPONSE VARIABLE: C NUMBER (OR COUNT OR SIZE) C SUM C PRODUCT C INTEGRAL C C MIDRANGE C MEAN (OR AVERAGE) C MIDMEAN C MEDIAN C TRIMMED MEAN C WINSORIZED MEAN C BIWEIGHT LOCATION C GEOMETRIC MEAN C HODGES-LEHMAN C C SD (OR STANDARD DEVIATION) C VARIANCE C AERAGE ABSOLUTE DEVIATION (AAD) C MEDIAN ABSOLUTE DEVIATION (MAD) C SN C QN C GEOMETRIC STANDARD DEVIATION C BIWEIGHT SCALE C WINSORIZED VARIANCE C WINSORIZED SD C BIWEIGHT MIDVARIANCE C PERCENTAGE BEND MIDVARIANCE C COEFFICIENT OF VARIATION C RELATIVE SD C SD OF THE MEAN C RELATIVE VARIANCE C VARIANCE OF THE MEAN C TRIMMED MEAN STANDARD ERROR C RANGE C C SKEWNESS C KURTOSIS C AUTOCORRELATION C AUTOCOVARIANCE C LOWER HINGE C UPPER HINGE C LOWER QUARTILE C UPPER QUARTILE C INTERQUARTILE RANGE C MINIMUM C MAXIMUM C EXTREME C FIRST/SECOND/THIRD/FOURTH/FIFTH/SIXTH/SEVENTH/ C EIGHTH/NINTH DECILE C PERCENTILE C QUANTILE C QUANTILE STANDARD ERROR C SINE FREQUENCY C SINE AMPLITUDE C TAGUCHI SIGNAL-TO-NOISE (SN+, SN-, SN0, SN00) C CP C CPK C CNPK C CPM C CC C CPL C CPU C PERCENT DEFECTIVE C EXPECTED LOSS C NORMAL PPCC C COMMON DIGITS C NUMBER OF DIGITS C C FOLLOWING STATISTICS REQUIRE TWO RESPONSE VARIABLES: C COVARIANCE C RANK COVARIANCE C CORRELATION C RANK CORRELATION C COMOVEMENT C RANK COMOVEMENT C WINSORIZED COVARIANCE C WINSORIZED CORRELATION C BIWEIGHT MIDCOVARIANCE C BIWEIGHT MIDCORRELATION C PERCENTAGE BEND CORRELATION C KENDELLS TAU C RATIO (= SUM1/SUM2) C C FOLLOWING STATISTICS REQUIRE ONE RESPONSE C AND ONE GROUP OR WEIGHT VARIABLE: C LINEAR INTERCEPT C LINEAR SLOPE C LINEAR RESSD C LINEAR CORRELATION C REPEATABILITY SD C REPRODUCABILITY SD C WEIGHTED MEAN C WEIGHTED MEDIAN (NOT YET IMPLEMENTED) C WEIGHTED STANDARD DEVIATION C WEIGHTED VARIANCE C WEIGHTED TRIMMED MEAN C C FOLLOWING STATISTICS COMPUTE DIFFERENCE IN C STATISTIC FOR TWO RESPONSE VARIABLES (USED FOR C LOCATION AND SCALE STATISTICS): C C LOCATION: C DIFFERENCE OF MEANS C DIFFERENCE OF MIDMEANS C DIFFERENCE OF MEDIANS C DIFFERENCE OF TRIMMED MEANS C DIFFERENCE OF WINSORIZED MEANS C DIFFERENCE OF GEOMETRIC MEANS C DIFFERENCE OF HARMONIC MEANS C DIFFERENCE OF HODGES-LEHMAN C DIFFERENCE OF BIWEIGHT LOCATION C C SCALE: C DIFFERENCE OF STANDARD DEVIATIONS C DIFFERENCE OF VARIANCES C DIFFERENCE OF AAD C DIFFERENCE OF MAD C DIFFERENCE OF SN C DIFFERENCE OF QN C DIFFERENCE OF INTERQUARTILE RANGE C DIFFERENCE OF WINSORIZED SD C DIFFERENCE OF WINSORIZED VARIANCE C DIFFERENCE OF BIWEIGHT MIDVARIANCE C DIFFERENCE OF BIWEIGHT SCALE C DIFFERENCE OF PERCENTAGE BEND C DIFFERENCE OF GEOMETRIC SD C DIFFERENCE OF RANGE C DIFFERENCE OF MIDRANGE C DIFFERENCE OF QUANTILE C DIFFERENCE OF SKEWNESS C DIFFERENCE OF KURTOSIS C DIFFERENCE OF RELATIVE SD C DIFFERENCE OF SD OF MEAN C DIFFERENCE OF RELATIVE VARIANCE C DIFFERENCE OF VARIANCE OF THE MEAN C DIFFERENCE OF MINIMUM C DIFFERENCE OF MAXIMUM C DIFFERENCE OF EXTREMES C DIFFERENCE OF COEFFICIENT OF VARIATION C C MISCELLANEOUS: C DIFFERENCE OF COUNTS C DIFFERENCE OF SUMS C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105 C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--2002/8 C ORIGINAL VERSION--AUGUST 2002. C UPDATED --FEBRUARY 2003. ADD SUPPORT FOR DIFFERENCE C OF LOCATION AND SCALE C STATISTICS C UPDATED --APRIL 2003. ADD SUPPORT FOR SN, QN ROBUST C SCALE ESTIMATES (AND THEIR C DIFFERENCE), REQUIRED ADDING C ADDITIONAL SCRATCH ARRAYS. C UPDATED --MAY 2003. ADD SUPPORT FOR WEIGHTED TRIMMED C MEAN. C UPDATED --FEBRUARY 2004. RESTORE COMOVEMENT, RANK C COMOVEMENT C UPDATED --OCTOBER 2004. KENDELLS TAU C UPDATED --FEBRUARY 2005. REPEATABILITY SD C UPDATED --FEBRUARY 2005. REPRODUCABILITY SD C UPDATED --SEPTEMBER 2005. RATIO (=SUM1/SUM2) C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C EXTERNAL SUM EXTERNAL RANGE C CHARACTER*4 ICASPL CHARACTER*4 ISUBRO CHARACTER*4 IBUGG3 CHARACTER*4 IERROR C CHARACTER*4 IHP CHARACTER*4 IHP2 CHARACTER*4 IHWUSE CHARACTER*4 MESSAG C CHARACTER*4 IWRITE CHARACTER*4 IFLAG CHARACTER*4 IQUAME CHARACTER*4 IQUASE C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 C C--------------------------------------------------------------------- C DIMENSION TEMP(*) DIMENSION TEMPZ(*) DIMENSION XTEMP1(*) DIMENSION XTEMP2(*) DIMENSION XTEMP3(*) C INTEGER ITEMP1(*) INTEGER ITEMP2(*) INTEGER ITEMP3(*) INTEGER ITEMP4(*) INTEGER ITEMP5(*) INTEGER ITEMP6(*) C EXTERNAL REPEAT C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHK.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='CMPS' ISUBN2='TA ' C IWRITE='OFF' C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(NS2.GE.1)GOTO39 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,31) 31 FORMAT('***** ERROR IN CMPSTA--THE NUMBER OF OBSERVATIONS MUST ', 1 'BE AT LEAST 1;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,34)NS2 34 FORMAT(' THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 39 CONTINUE C IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PSTA')GOTO90 WRITE(ICOUT,70) 70 FORMAT('AT THE BEGINNING OF CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71)IBUGG3,ISUBRO 71 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,72)NS2,ICASPL 72 FORMAT('NS2,ICASPL = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') DO73I=1,NS2 WRITE(ICOUT,74)I,TEMP(I),TEMPZ(I) 74 FORMAT('I, TEMP(I),TEMPZ(I) = ',I8,2F15.7) CALL DPWRST('XXX','BUG ') 73 CONTINUE 90 CONTINUE C IF(ICASPL.EQ.'NUMB')GOTO11310 IF(ICASPL.EQ.'COUN')GOTO11310 IF(ICASPL.EQ.'SIZE')GOTO11310 IF(ICASPL.EQ.'SUM')GOTO11320 IF(ICASPL.EQ.'PROD')GOTO11330 IF(ICASPL.EQ.'INTE')GOTO11340 IF(ICASPL.EQ.'MIDR')GOTO11350 IF(ICASPL.EQ.'MEAN'.OR.ICASPL.EQ.'AVER')GOTO11360 IF(ICASPL.EQ.'MIDM')GOTO11370 IF(ICASPL.EQ.'MEDI')GOTO11380 IF(ICASPL.EQ.'SD')GOTO11390 IF(ICASPL.EQ.'VARI')GOTO11400 IF(ICASPL.EQ.'RESD')GOTO11410 IF(ICASPL.EQ.'REVA')GOTO11415 IF(ICASPL.EQ.'CVAR')GOTO11418 IF(ICASPL.EQ.'RANG')GOTO11420 IF(ICASPL.EQ.'MINI')GOTO11430 IF(ICASPL.EQ.'MAXI')GOTO11440 IF(ICASPL.EQ.'SKEW')GOTO11450 IF(ICASPL.EQ.'KURT')GOTO11460 IF(ICASPL.EQ.'AUCR')GOTO11470 IF(ICASPL.EQ.'COVA')GOTO11480 IF(ICASPL.EQ.'CORR')GOTO11490 IF(ICASPL.EQ.'RACR')GOTO11500 IF(ICASPL.EQ.'SDME')GOTO11510 IF(ICASPL.EQ.'AUCV')GOTO11520 IF(ICASPL.EQ.'RACV')GOTO11530 IF(ICASPL.EQ.'COMO')GOTO31480 IF(ICASPL.EQ.'RACM')GOTO31530 IF(ICASPL.EQ.'KTAU')GOTO31540 IF(ICASPL.EQ.'RATI')GOTO31550 C IF(ICASPL.EQ.'LOWH')GOTO11540 IF(ICASPL.EQ.'UPPH')GOTO11550 IF(ICASPL.EQ.'LOWQ')GOTO11560 IF(ICASPL.EQ.'UPPQ')GOTO11570 C IF(ICASPL.EQ.'TRIM')GOTO11580 IF(ICASPL.EQ.'WINM')GOTO11590 C IF(ICASPL.EQ.'MIDQ')GOTO11610 IF(ICASPL.EQ.'1DEC')GOTO11610 IF(ICASPL.EQ.'2DEC')GOTO11610 IF(ICASPL.EQ.'3DEC')GOTO11610 IF(ICASPL.EQ.'4DEC')GOTO11610 IF(ICASPL.EQ.'5DEC')GOTO11610 IF(ICASPL.EQ.'6DEC')GOTO11610 IF(ICASPL.EQ.'7DEC')GOTO11610 IF(ICASPL.EQ.'8DEC')GOTO11610 IF(ICASPL.EQ.'9DEC')GOTO11610 C IF(ICASPL.EQ.'PERC')GOTO11615 C IF(ICASPL.EQ.'WEME')GOTO11620 IF(ICASPL.EQ.'WEMD')GOTO11630 IF(ICASPL.EQ.'WESD')GOTO11640 IF(ICASPL.EQ.'WEVA')GOTO11650 IF(ICASPL.EQ.'WETM')GOTO11660 C IF(ICASPL.EQ.'VM')GOTO11700 IF(ICASPL.EQ.'VAME')GOTO11700 C IF(ICASPL.EQ.'SIFR')GOTO11710 IF(ICASPL.EQ.'SIAM')GOTO11720 IF(ICASPL.EQ.'LIIN')GOTO11730 IF(ICASPL.EQ.'LISL')GOTO11740 IF(ICASPL.EQ.'LIRE')GOTO11750 IF(ICASPL.EQ.'LICO')GOTO11760 IF(ICASPL.EQ.'REPE')GOTO11770 IF(ICASPL.EQ.'REPR')GOTO11780 C IF(ICASPL.EQ.'SN0')GOTO11810 IF(ICASPL.EQ.'SN+')GOTO11810 IF(ICASPL.EQ.'SN-')GOTO11810 IF(ICASPL.EQ.'SN00')GOTO11810 C IF(ICASPL.EQ.'CP')GOTO11900 IF(ICASPL.EQ.'CPK')GOTO11900 IF(ICASPL.EQ.'CNPK')GOTO11900 IF(ICASPL.EQ.'CPM')GOTO11900 IF(ICASPL.EQ.'CC')GOTO11900 IF(ICASPL.EQ.'CPL')GOTO11900 IF(ICASPL.EQ.'CPU')GOTO11900 IF(ICASPL.EQ.'PEDE')GOTO11900 IF(ICASPL.EQ.'EXLO')GOTO11900 C IF(ICASPL.EQ.'NOPP')GOTO11910 C IF(ICASPL.EQ.'EXTR')GOTO11920 IF(ICASPL.EQ.'AAD ')GOTO11930 IF(ICASPL.EQ.'MAD ')GOTO11940 IF(ICASPL.EQ.'GEME')GOTO11950 IF(ICASPL.EQ.'GESD')GOTO11960 IF(ICASPL.EQ.'HAME')GOTO11970 IF(ICASPL.EQ.'IQRA')GOTO11980 IF(ICASPL.EQ.'BILO')GOTO11990 IF(ICASPL.EQ.'BISC')GOTO12000 IF(ICASPL.EQ.'WIVA')GOTO12010 IF(ICASPL.EQ.'WISD')GOTO12030 IF(ICASPL.EQ.'WICV')GOTO12050 IF(ICASPL.EQ.'WICR')GOTO12070 IF(ICASPL.EQ.'BIMV')GOTO12090 IF(ICASPL.EQ.'BIMC')GOTO12100 IF(ICASPL.EQ.'PBMV')GOTO12110 IF(ICASPL.EQ.'PBCR')GOTO12115 IF(ICASPL.EQ.'HLEH')GOTO12120 IF(ICASPL.EQ.'QUAN')GOTO12130 IF(ICASPL.EQ.'QUSE')GOTO12140 IF(ICASPL.EQ.'TMSE')GOTO12150 IF(ICASPL.EQ.'BICR')GOTO12160 IF(ICASPL.EQ.'PBCR')GOTO12170 IF(ICASPL.EQ.'CDIG')GOTO12172 IF(ICASPL.EQ.'NCDI')GOTO12174 IF(ICASPL.EQ.'SNSC')GOTO12176 IF(ICASPL.EQ.'QNSC')GOTO12178 C IF(ICASPL.EQ.'DMEA')GOTO12180 IF(ICASPL.EQ.'DMDM')GOTO12190 IF(ICASPL.EQ.'DMED')GOTO12200 IF(ICASPL.EQ.'DTRM')GOTO12210 IF(ICASPL.EQ.'DWNM')GOTO12220 IF(ICASPL.EQ.'DGEO')GOTO12230 IF(ICASPL.EQ.'DHAR')GOTO12240 IF(ICASPL.EQ.'DHDL')GOTO12250 IF(ICASPL.EQ.'DBIW')GOTO12260 IF(ICASPL.EQ.'DSD ')GOTO12270 IF(ICASPL.EQ.'DVAR')GOTO12280 IF(ICASPL.EQ.'DAAD')GOTO12290 IF(ICASPL.EQ.'DMAD')GOTO12300 IF(ICASPL.EQ.'DIQR')GOTO12310 IF(ICASPL.EQ.'DWSD')GOTO12320 IF(ICASPL.EQ.'DWVA')GOTO12330 IF(ICASPL.EQ.'DBIM')GOTO12340 IF(ICASPL.EQ.'DBIS')GOTO12350 IF(ICASPL.EQ.'DPBN')GOTO12360 IF(ICASPL.EQ.'DGSD')GOTO12370 IF(ICASPL.EQ.'DRAN')GOTO12380 IF(ICASPL.EQ.'DMDR')GOTO12390 IF(ICASPL.EQ.'DQUA')GOTO12400 IF(ICASPL.EQ.'DSKE')GOTO12410 IF(ICASPL.EQ.'DKUR')GOTO12420 IF(ICASPL.EQ.'DRSD')GOTO12430 IF(ICASPL.EQ.'DSDM')GOTO12440 IF(ICASPL.EQ.'DRVA')GOTO12450 IF(ICASPL.EQ.'DVAM')GOTO12460 IF(ICASPL.EQ.'DMIN')GOTO12470 IF(ICASPL.EQ.'DMAX')GOTO12480 IF(ICASPL.EQ.'DEXT')GOTO12490 IF(ICASPL.EQ.'DCVA')GOTO12495 IF(ICASPL.EQ.'DCOU')GOTO12500 IF(ICASPL.EQ.'DSUM')GOTO12510 IF(ICASPL.EQ.'DSN')GOTO12520 IF(ICASPL.EQ.'DQN')GOTO12530 C 80000 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,80001) 80001 FORMAT('***** INTERNAL ERROR IN CMPSTA') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,80002) 80002 FORMAT(' AT BRANCH POINT 11800--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,80003) 80003 FORMAT(' ICASPL NOT EQUAL ONE OF THE ALLOWABLE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,80004) 80004 FORMAT(' MEAN, MEDI, SD, RANG, ETC.,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,80006)ICASPL 80006 FORMAT(' ICASPL = ',A4) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C C --------------------------- C 11310 CONTINUE CALL SIZE(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11320 CONTINUE CALL SUM(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11330 CONTINUE CALL PROD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11340 CONTINUE CCCCC CALL INTVEC(TEMP,TEMPZ,NS2,NUMVIN,IWRITE,RIGHT,IBUGG3,IERROR) CALL INTVEC(TEMP,TEMPZ,NS2,NUMV2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11350 CONTINUE CALL MIDRAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11360 CONTINUE CALL MEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11370 CONTINUE CALL MIDMEA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR) GOTO79000 11380 CONTINUE CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR) GOTO79000 11390 CONTINUE CALL SD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11400 CONTINUE CALL VAR(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11410 CONTINUE CALL RELSD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11415 CONTINUE CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR) CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR) RIGHT=0.0 CCCCC NOVEMBER 1994. TO BE CONSISTENT WITH RELATIVE SD PLOT, USE CCCCC ABS(MEAN) RATHER THAN MEAN. CCCCC IF(RIGHTM.NE.0.0)RIGHT=100.0*RIGHTV/RIGHTM IF(RIGHTM.NE.0.0)RIGHT=100.0*RIGHTV/ABS(RIGHTM) GOTO79000 11418 CONTINUE CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR) CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR) RIGHT=0.0 IF(RIGHTM.NE.0.0)RIGHT=RIGHTV/RIGHTM GOTO79000 11420 CONTINUE CALL RANGE(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11430 CONTINUE CALL MINIM(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11440 CONTINUE CALL MAXIM(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11450 CONTINUE CALL STMOM3(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11460 CONTINUE CALL STMOM4(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11470 CONTINUE CALL AUTOCR(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11480 CONTINUE CALL COV(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 31480 CONTINUE CALL COMOVE(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11490 CONTINUE CALL CORR(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11500 CONTINUE CALL RANKCR(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 11510 CONTINUE CALL SDMEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11520 CONTINUE CALL AUTOCV(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11530 CONTINUE CALL RANKCV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 31530 CONTINUE CALL RANKCM(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 31540 CONTINUE CALL KENTAU(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 31550 CONTINUE CALL SUM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL SUM(TEMPZ,NS2,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=0.0 IF(RIGH2.NE.0.0)RIGHT=RIGH1/RIGH2 GOTO79000 11540 CONTINUE CALL LOWHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR) GOTO79000 11550 CONTINUE CALL UPPHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR) GOTO79000 11560 CONTINUE CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR) GOTO79000 11570 CONTINUE CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR) GOTO79000 C 11580 CONTINUE C IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO11589 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO11589 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11581) 11581 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11582) 11582 FORMAT('THE PROPORTION TO BE TRIMMED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11583) 11583 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11584)PROP1 11584 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11585)PROP2 11585 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11586) 11586 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11587) 11587 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11588) 11588 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 11589 CONTINUE CALL TRIMME(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 C 11590 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO11599 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO11599 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11591) 11591 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11592) 11592 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11593) 11593 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11594)PROP1 11594 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11595)PROP2 11595 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11596) 11596 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11597) 11597 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11598) 11598 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 11599 CONTINUE CALL WINDME(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 C 11610 CONTINUE IF(ICASPL.EQ.'MIDQ')P100=50.0 IF(ICASPL.EQ.'1DEC')P100=10.0 IF(ICASPL.EQ.'2DEC')P100=20.0 IF(ICASPL.EQ.'3DEC')P100=30.0 IF(ICASPL.EQ.'4DEC')P100=40.0 IF(ICASPL.EQ.'5DEC')P100=50.0 IF(ICASPL.EQ.'6DEC')P100=60.0 IF(ICASPL.EQ.'7DEC')P100=70.0 IF(ICASPL.EQ.'8DEC')P100=80.0 IF(ICASPL.EQ.'9DEC')P100=90.0 CALL PERCEN(P100,TEMP,NS2,IWRITE,XTEMP1,MAXNXT, 1RIGHT,IBUGG3,IERROR) GOTO79000 C 11615 CONTINUE IHP='P100' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 P100=VALUE(ILOCP) C CALL PERCEN(P100,TEMP,NS2,IWRITE,XTEMP1,MAXNXT, 1RIGHT,IBUGG3,IERROR) GOTO79000 C 11620 CONTINUE CALL WEMEAN(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11630 CONTINUE CALL WEMEDI(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11640 CONTINUE CALL WESD(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11650 CONTINUE CALL WEVARI(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11660 CONTINUE C IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) IF(PROP1.GE.0.0 .AND. PROP1.LT.1.0)PROP1=PROP1/100.0 C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) IF(PROP2.GE.0.0 .AND. PROP2.LT.1.0)PROP2=PROP2/100.0 C IF(PROP1.LT.0.0 .OR. PROP1.GT.100.0 .OR. 1 PROP2.LT.0.0 .OR. PROP2.GT.100.0)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11661) 11661 FORMAT('***** ERROR IN THE WEIGHTED TRIMMED MEAN--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11662) 11662 FORMAT('THE PROPORTION TO BE TRIMMED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11663) 11663 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11664)PROP1 11664 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11665)PROP2 11665 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11666) 11666 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11667) 11667 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11668) 11668 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF C CALL WETRME(TEMP,TEMPZ,NS2,PROP1,PROP2,IWRITE,XTEMP1,XTEMP2, 1 MAXNXT,RIGHT, 1 IBUGG3,ISUBRO,IERROR) GOTO79000 C 11700 CONTINUE CALL SDMEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) RIGHT=RIGHT**2 GOTO79000 C 11710 CONTINUE CALL SINFIT(TEMP,XTEMP2,NS2,IWRITE,XSINFR,XSINAM,XRESSD, 1ISUBRO,IBUGG3,IERROR) RIGHT=XSINFR GOTO79000 C 11720 CONTINUE CALL SINFIT(TEMP,XTEMP2,NS2,IWRITE,XSINFR,XSINAM,XRESSD, 1ISUBRO,IBUGG3,IERROR) RIGHT=XSINAM GOTO79000 C 11730 CONTINUE CALL LINFIT(TEMP,TEMPZ,NS2, 1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE, 1ISUBRO,IBUGG3,IERROR) RIGHT=ALPHA GOTO79000 C 11740 CONTINUE CALL LINFIT(TEMP,TEMPZ,NS2, 1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE, 1ISUBRO,IBUGG3,IERROR) RIGHT=BETA GOTO79000 C 11750 CONTINUE CALL LINFIT(TEMP,TEMPZ,NS2, 1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE, 1ISUBRO,IBUGG3,IERROR) RIGHT=XRESSD GOTO79000 C 11760 CONTINUE CALL LINFIT(TEMP,TEMPZ,NS2, 1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE, 1ISUBRO,IBUGG3,IERROR) RIGHT=CCXY GOTO79000 C 11770 CONTINUE CALL REPEAT(TEMP,TEMPZ,XTEMP1,XTEMP2,NS2,IWRITE,XREP, 1ISUBRO,IBUGG3,IERROR) RIGHT=XREP GOTO79000 C 11780 CONTINUE CALL REPROD(TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,NS2,IWRITE,XREP, 1ISUBRO,IBUGG3,IERROR) RIGHT=XREP GOTO79000 C 11810 CONTINUE CALL TAGUCH(TEMP,NS2,ICASPL,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 C 11900 CONTINUE IHP='LSL ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ENGLSL=VALUE(ILOCP) C IHP='USL ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ENGUSL=VALUE(ILOCP) C IF(ICASPL.EQ.'CP')THEN CALL CP(TEMP,NS2,ENGLSL,ENGUSL,IWRITE, 1 RIGHT,XLCL,XUCL,IBUGG3,IERROR) GOTO79000 ENDIF C IF(ICASPL.EQ.'CPK')THEN CALL CPK(TEMP,NS2,ENGLSL,ENGUSL,IWRITE, 1 RIGHT,XLCL,XUCL,IBUGG3,IERROR) GOTO79000 ENDIF C IF(ICASPL.EQ.'CNPK')THEN CALL CNPK(TEMP,NS2,TEMP,NS2,ENGLSL,ENGUSL,IWRITE, 1 RIGHT,IBUGG3,IERROR) GOTO79000 ENDIF C IF(ICASPL.EQ.'CPL')THEN CALL CPL(TEMP,NS2,ENGLSL,ENGUSL,IWRITE, 1 RIGHT,XLCL,XUCL,IBUGG3,IERROR) GOTO79000 ENDIF C IF(ICASPL.EQ.'CPU')THEN CALL CPU(TEMP,NS2,ENGLSL,ENGUSL,IWRITE, 1 RIGHT,XLCL,XUCL,IBUGG3,IERROR) GOTO79000 ENDIF C IF(ICASPL.EQ.'CPM')THEN IHP='TARG' IHP2='ET ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 TARGET=VALUE(ILOCP) CALL CPM(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE, 1 RIGHT,XLCL,XUCL,IBUGG3,IERROR) GOTO79000 ENDIF C IF(ICASPL.EQ.'CC')THEN IHP='TARG' IHP2='ET ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 TARGET=VALUE(ILOCP) CALL CC(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE, 1 RIGHT,IBUGG3,IERROR) GOTO79000 ENDIF C IF(ICASPL.EQ.'PEDE')THEN IFLAG='ACTU' CALL PERDEF(TEMP,NS2,ENGLSL,ENGUSL,IWRITE, 1 RIGHT,RIJUNK, 1 YACTL,YTHEL,YACTU,YTHEU, 1 IFLAG,IBUGG3,IERROR) GOTO79000 ENDIF C IF(ICASPL.EQ.'EXLO')THEN IHP='USLC' IHP2='OST ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 COSUSL=VALUE(ILOCP) C CALL EXPLOS(TEMP,NS2,ENGLSL,ENGUSL,COSUSL,IWRITE, 1 RIGHT,IBUGG3,IERROR) GOTO79000 ENDIF C 11910 CONTINUE CALL NORPPC(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 C 11920 CONTINUE CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL MAXIM(TEMP,NS2,IWRITE,RIGH2,IBUGG3,IERROR) RIGH1=ABS(RIGH1) RIGH2=ABS(RIGH2) RIGHT=RIGH1 IF(RIGH2.GT.RIGH1)RIGHT=RIGH2 GOTO79000 11930 CONTINUE CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR) GOTO79000 11940 CONTINUE CALL MAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR) GOTO79000 C 11950 CONTINUE CALL GEOMEA(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11960 CONTINUE CALL GEOSD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11970 CONTINUE CALL HARMEA(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 11980 CONTINUE CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR) CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR) RIGHT=RIGH2-RIGH1 GOTO79000 C 11990 CONTINUE CALL BIWLOC(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 C 12000 CONTINUE CALL BIWSCA(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 C 12010 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12029 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12029 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12021) 12021 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12022) 12022 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12023) 12023 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12024)PROP1 12024 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12025)PROP2 12025 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12026) 12026 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12027) 12027 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12028) 12028 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 12029 CONTINUE CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) CALL VAR(XTEMP2,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 C 12030 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12049 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12049 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12041) 12041 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12042) 12042 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12043) 12043 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12044)PROP1 12044 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12045)PROP2 12045 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12046) 12046 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12047) 12047 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12048) 12048 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 12049 CONTINUE CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) CALL SD(XTEMP2,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 C 12050 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12069 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12069 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12061) 12061 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12062) 12062 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12063) 12063 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12064)PROP1 12064 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12065)PROP2 12065 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12066) 12066 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12067) 12067 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12068) 12068 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 12069 CONTINUE CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) DO12052I=1,NS2 TEMP(I)=XTEMP2(I) 12052 CONTINUE CALL WINSOR(TEMPZ,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) DO12054I=1,NS2 TEMPZ(I)=XTEMP2(I) 12054 CONTINUE CALL COV(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 C 12070 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12089 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12089 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12081) 12081 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12082) 12082 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12083) 12083 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12084)PROP1 12084 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12085)PROP2 12085 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12086) 12086 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12087) 12087 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12088) 12088 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 12089 CONTINUE CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) DO12072I=1,NS2 TEMP(I)=XTEMP2(I) 12072 CONTINUE CALL WINSOR(TEMPZ,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) DO12074I=1,NS2 TEMPZ(I)=XTEMP2(I) 12074 CONTINUE CALL CORR(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR) GOTO79000 C 12090 CONTINUE CALL BIWMDV(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 C 12100 CONTINUE CALL BIWMCV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1IBUGG3,IERROR) GOTO79000 C 12110 CONTINUE C IHP='BETA' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN BETA=0.1 ELSE BETA=VALUE(ILOCP) ENDIF C CALL PBNMDV(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,BETA, 1IBUGG3,IERROR) GOTO79000 C 12115 CONTINUE C IHP='BETA' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN BETA=0.1 ELSE BETA=VALUE(ILOCP) ENDIF C CALL PBNCOR(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT, 1RIGHT,BETA, 1IBUGG3,IERROR) GOTO79000 C 12120 CONTINUE DO12122I=1,NS2 ITEMP1(I)=0 ITEMP2(I)=0 ITEMP3(I)=0 12122 CONTINUE CALL HLQEST(TEMP,NS2,XTEMP1,ITEMP1,ITEMP2,ITEMP3,ISEED,RIGHT) GOTO79000 C 12130 CONTINUE IHP='XQ ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 XQ=VALUE(ILOCP) C CALL QUANT(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT, 1IQUAME, 1RIGHT,IBUGG3,IERROR) GOTO79000 C 12140 CONTINUE IHP='XQ ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 XQ=VALUE(ILOCP) C CALL QUANSE(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT, 1IQUASE, 1RIGHT,IBUGG3,IERROR) GOTO79000 C 12150 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12159 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12159 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12151) 12151 FORMAT('***** ERROR IN CMPSTA (TRIMMED MEAN STANDARD ERROR)--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12152) 12152 FORMAT('THE PROPORTION TO BE TRIMMED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12153) 12153 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12154)PROP1 12154 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12155)PROP2 12155 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12156) 12156 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12157) 12157 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12158) 12158 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 12159 CONTINUE CALL TRIMSE(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,XTEMP2,MAXNXT, 1RIGHT,IBUGG3,IERROR) GOTO79000 C 12160 CONTINUE CALL BIWMDV(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1, 1IBUGG3,IERROR) CALL BIWMDV(TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2, 1IBUGG3,IERROR) CALL BIWMCV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH3, 1IBUGG3,IERROR) RIGH4=RIGH1*RIGH2 IF(RIGH4.GT.0.0)THEN RIGHT=RIGH3/SQRT(RIGH4) ELSE RIGHT=0.0 ENDIF GOTO79000 C 12170 CONTINUE C IHP='BETA' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN BETA=0.1 ELSE BETA=VALUE(ILOCP) ENDIF C CALL PBNCOR(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT, 1BETA, 1IBUGG3,IERROR) GOTO79000 C 12172 CONTINUE CALL COMDIG(TEMP,NS2,IWRITE,RIGHT,NRIGH,IBUGG3,IERROR) GOTO79000 C 12174 CONTINUE CALL COMDIG(TEMP,NS2,IWRITE,RIGHT,NRIGH,IBUGG3,IERROR) RIGHT=REAL(NRIGH) GOTO79000 C 12176 CONTINUE RIGHT=SN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3) GOTO79000 C 12178 CONTINUE RIGHT=QN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3, 1 ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6) GOTO79000 C 12180 CONTINUE CALL MEAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL MEAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12190 CONTINUE CALL MIDMEA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR) CALL MIDMEA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12200 CONTINUE CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR) CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12210 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12199 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12199 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12191) 12191 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12192) 12192 FORMAT('THE PROPORTION TO BE TRIMMED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12193) 12193 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12194)PROP1 12194 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12195)PROP2 12195 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12196) 12196 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12197) 12197 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12198) 12198 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 12199 CONTINUE CALL TRIMME(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGH1, 1IBUGG3,IERROR) CALL TRIMME(TEMPZ,NSZ,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGH2, 1IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12220 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12299 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12299 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12291) 12291 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12292) 12292 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12293) 12293 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12294)PROP1 12294 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12295)PROP2 12295 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12296) 12296 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12297) 12297 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12298) 12298 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 12299 CONTINUE CALL WINDME(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGH1, 1IBUGG3,IERROR) CALL WINDME(TEMPZ,NSZ,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGH2, 1IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12230 CONTINUE CALL GEOMEA(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL GEOMEA(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12240 CONTINUE CALL HARMEA(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL HARMEA(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12250 CONTINUE DO12252I=1,NS2 ITEMP1(I)=0 ITEMP2(I)=0 ITEMP3(I)=0 12252 CONTINUE CALL HLQEST(TEMP,NS2,XTEMP1,ITEMP1,ITEMP2,ITEMP3,ISEED,RIGH1) DO12254I=1,NSZ ITEMP1(I)=0 ITEMP2(I)=0 ITEMP3(I)=0 12254 CONTINUE CALL HLQEST(TEMPZ,NSZ,XTEMP1,ITEMP1,ITEMP2,ITEMP3,ISEED,RIGH2) RIGHT=RIGH1-RIGH2 GOTO79000 C 12260 CONTINUE CALL BIWLOC(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1, 1IBUGG3,IERROR) CALL BIWLOC(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2, 1IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12270 CONTINUE CALL SD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL SD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12280 CONTINUE CALL VAR(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL VAR(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12290 CONTINUE CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR) CALL AAD(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12300 CONTINUE CALL MAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR) CALL MAD(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12310 CONTINUE CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH3,IBUGG3,IERROR) CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH4,IBUGG3,IERROR) RIGH1=RIGH4-RIGH3 CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH5,IBUGG3,IERROR) CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH6,IBUGG3,IERROR) RIGH2=RIGH6-RIGH5 RIGHT=RIGH1-RIGH2 GOTO79000 C 12320 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12229 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12229 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12221) 12221 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12222) 12222 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12223) 12223 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12224)PROP1 12224 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12225)PROP2 12225 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12226) 12226 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12227) 12227 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12228) 12228 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 12229 CONTINUE CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) CALL SD(XTEMP2,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL WINSOR(TEMPZ,NSZ,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) CALL SD(XTEMP2,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12330 CONTINUE IHP='P1 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP1=VALUE(ILOCP) C IHP='P2 ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 PROP2=VALUE(ILOCP) C IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12329 IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12329 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12321) 12321 FORMAT('***** ERROR IN CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12322) 12322 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12323) 12323 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12324)PROP1 12324 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12325)PROP2 12325 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12326) 12326 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12327) 12327 FORMAT(' LET P1 = 25') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,12328) 12328 FORMAT(' LET P2 = 10') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 12329 CONTINUE CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) CALL VAR(XTEMP2,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL WINSOR(TEMPZ,NSZ,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2, 1IBUGG3,IERROR) CALL VAR(XTEMP2,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12340 CONTINUE CALL BIWMDV(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1, 1IBUGG3,IERROR) CALL BIWMDV(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2, 1IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12350 CONTINUE CALL BIWSCA(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1, 1IBUGG3,IERROR) CALL BIWSCA(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2, 1IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12360 CONTINUE IHP='BETA' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN BETA=0.1 ELSE BETA=VALUE(ILOCP) ENDIF C CALL PBNMDV(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,BETA, 1IBUGG3,IERROR) CALL PBNMDV(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,BETA, 1IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12370 CONTINUE CALL GEOSD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL GEOSD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12380 CONTINUE CALL RANGE(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL RANGE(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12390 CONTINUE CALL MIDRAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL MIDRAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12400 CONTINUE IHP='XQ ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 XQ=VALUE(ILOCP) C CALL QUANSE(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT, 1IQUASE, 1RIGH1,IBUGG3,IERROR) CALL QUANSE(XQ,TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT, 1IQUASE, 1RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12410 CONTINUE CALL STMOM3(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL STMOM3(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12420 CONTINUE CALL STMOM4(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL STMOM4(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12430 CONTINUE CALL RELSD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL RELSD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12440 CONTINUE CALL SDMEAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL SDMEAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12450 CONTINUE CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR) CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR) RIGH1=0.0 IF(RIGHTM.NE.0.0)RIGH1=100.0*RIGHTV/ABS(RIGHTM) CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR) CALL VAR(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR) RIGH2=0.0 IF(RIGHTM.NE.0.0)RIGH2=100.0*RIGHTV/ABS(RIGHTM) RIGHT=RIGH1-RIGH2 GOTO79000 C 12460 CONTINUE CALL SDMEAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) RIGH1=RIGH1**2 CALL SDMEAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGH2=RIGH2**2 RIGHT=RIGH1-RIGH2 GOTO79000 C 12470 CONTINUE CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL MINIM(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12480 CONTINUE CALL MAXIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL MAXIM(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12490 CONTINUE CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL MAXIM(TEMP,NS2,IWRITE,RIGH2,IBUGG3,IERROR) RIGH1=ABS(RIGH1) RIGH2=ABS(RIGH2) RIGH3=RIGH1 IF(RIGH2.GT.RIGH1)RIGH3=RIGH2 C CALL MINIM(TEMPZ,NSZ,IWRITE,RIGH4,IBUGG3,IERROR) CALL MAXIM(TEMPZ,NSZ,IWRITE,RIGH5,IBUGG3,IERROR) RIGH4=ABS(RIGH4) RIGH5=ABS(RIGH5) RIGH6=RIGH4 IF(RIGH5.GT.RIGH4)RIGH6=RIGH5 RIGHT=RIGH3-RIGH6 GOTO79000 C 12495 CONTINUE CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR) CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR) RIGH1=0.0 IF(RIGHTM.NE.0.0)RIGH1=RIGHTV/RIGHTM CALL SD(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR) CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR) RIGH2=0.0 IF(RIGHTM.NE.0.0)RIGH2=RIGHTV/RIGHTM RIGHT=RIGH1-RIGH2 GOTO79000 12500 CONTINUE CALL SIZE(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL SIZE(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12510 CONTINUE CALL SUM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR) CALL SUM(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR) RIGHT=RIGH1-RIGH2 GOTO79000 C 12520 CONTINUE RIGH1=SN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3) RIGH2=SN(TEMPZ,NSZ,XTEMP1,XTEMP2,XTEMP3) RIGHT=RIGH1-RIGH2 GOTO79000 C 12530 CONTINUE RIGH1=QN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3, 1 ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6) RIGH2=QN(TEMPZ,NSZ,XTEMP1,XTEMP2,XTEMP3, 1 ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6) RIGHT=RIGH1-RIGH2 GOTO79000 C C --------------------------- C 79000 CONTINUE GOTO9000 C C ****************** C ** STEP 90-- ** C ** EXIT ** C ****************** C 9000 CONTINUE IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PSTA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF CMPSTA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGG3,ISUBRO 9012 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)ICASPL,NS2,IERROR 9013 FORMAT('ICASPL,NS2,IERROR = ',A4,I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NUMV2,RIGHT 9014 FORMAT('NUMV2,RIGHT = ',I8,E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END