C ALGORITHM 681, COLLECTED ALGORITHMS FROM ACM. C THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE, C VOL. 16, NO. 2, PP. 152-157. Installation Distributed with the package are four source code files, two sample input files and the sample output file, and this documentation file. While the input and output files are explained below, the source files consist of 1) INTARI.FOR -- the interval arithmetic subpackage; 2) STKMAN.FOR -- the stack management subpackage; 3) INTBIS.FOR -- the core routines for the package; and 4) LPKD1M.FOR -- the machine constant routine D1MACH and the LINPACK routines used in the package. Installation involves (i) making sure input and output units are correct, and possibly supplying appropriate attachments; (ii) possibly adjusting the size of workspace parameters; (iii) setting a machine-dependent constant in SIMINI and selecting the machine constants routine D1MACH; and (iv) making sure the package has access to the appropriate LINPACK routines. Input occurs from two files, which we term the configuration file and the equation file. Parameter NUNITC in program GENBIS defines the configuration file unit; it is set to unit 20 by default. Parameter NUNITI in GENBIS defines the equation file unit; it is set to 5 by default. All input occurs in GENBIS and INPUT. Output occurs to a single output file, whose unit is defined with parameter NUNITO in GENBIS; the default unit number is 6. All output occurs in GENBIS, OUTPUT, and ERROUT. Workspace parameters all occur in GENBIS. They include the maximum allowable number of variables and equations, the maximum number of possible root-containing boxes, and the maximum height of a stack. The package does error checking for these values, so they need not be altered on the initial installation. The default maximum dimension is 10; the maximum stack height is 200 and the maximum number in the list is 50. With these values, the executable code for an IBM-PC takes about 310K, depending on the compiler. There are five common blocks. Parameters for two of these may need to be changed in several routines if the package is to be used for more than ten equations and unknowns; this should not be too difficult. See details in GENBIS and INPUT. The installer must modify two machine-dependent package routines. The most important of these routines is SIMINI, where data statement for MAXERR may need to be altered. See the in- line documentation. The second routine is ERRHND, in which the system defaults for handling underflows, etc. may need to be changed. The routine D1MACH also must be properly installed and linked with the package. See the documentation within that routine. THE IMPORTANCE OF CORRECT INSTALLATION OF D1MACH AND SIMINI CANNOT BE OVEREMPHASIZED. This is because, if the machine constants are not properly set, then the code could indicate that there are no roots in a region which actually contains roots. One of the authors should be consulted if there are any doubts. INTBIS includes the test input file TOMS86SH.DT1, the test configuration file CONFIG.BIS, and the corresponding output file TOMS86SH.OU1. Results should vary little from machine to machine. This test takes about 4 seconds of CPU time on an IBM-3090. When compiling and linking INTBIS, one may wish to separate the two subroutines FTESTH and HNSNG. Also, the package calls the LINPACK routines DGEFA and DGESL and the LINPACK or BLA routines DAXPY, DCOPY, DDOT, DNRM2, DSCAL, and IDAMAX. Finally, note that the entry point to the main routine is labeled GENBIS; this may be changed since other programs by that name may exist. However, the documentation throughout the package refers to the main routine as GENBIS. A machine-executable code for the IBM-PC/AT compatible family of machines is available on an MS-DOS 360KB diskette from one of the authors. PROGRAM GENBIS C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package. C C*********************************************************************** C C Function -- C C This is the main driver program, which allocates and indexes C the workspace vectors. It calls the routine ROOTS, which is C structured on the general algorithm in the paper R. B. Kearfott, C 'Abstract generalized bisection and a cost bound', Math. Comput. 49, C 179 (July, 1987), pp. 187-202. C C*********************************************************************** C C Parameter statements -- C PARAMETER (MN = 10) PARAMETER (MMAXDP = 200) PARAMETER (MMAXLS = 50) PARAMETER (MLINFO = 15) C PARAMETER (NUNITI = 5) PARAMETER (NUNITO = 6) PARAMETER (NUNITC = 20) C PARAMETER (MDWORK = 8*MN+9*MN**2) PARAMETER (MIWORK = MN) PARAMETER (MLWORK = 1) C C*********************************************************************** C C Parameter descriptions -- C C MN is the maximum number of variables and equations in any C system processed. C C MMAXDP is the maximum allowable depth of the stack of boxes yet to be C considered by the algorithm. It is also the maximum allowable C depth of the binary search tree. C C MMAXLS MMAXLS - 2 is the maximum number of root-containing boxes which C can be stored. Depending on DLSFLG (see below), this could C include boxes which have been removed due to possible C redundancies. C C MLINFO is the length of the vector INFO, which is set in ROOTS C and which is used in OUTPUT. C C NUNITI is the unit number of the file (device)from which the system, C the initial box, and other initial information will be read. C C NUNITO is the unit number of the file (device) to which all output C will be directed. C C NUNITC is the unit number of the file (device) from which certain C configuration parameters will be read. C C MDWORK is the length of the double precision work vector. C C MIWORK is the length of the integer work vector. C C MLWORK is the length of the logical work vector. C C*********************************************************************** C C Major variable declarations -- C INTEGER NCASE DOUBLE PRECISION CURBOX(2,MN), CURPT(MN) DOUBLE PRECISION STACK(2,MN,MMAXDP) INTEGER STKLVL(MMAXDP) LOGICAL DPIVOT(MMAXDP) INTEGER IPIVOT(MMAXDP) INTEGER TSTITR(MMAXDP) C DOUBLE PRECISION BOXES(2,MN,MMAXLS), POINTS(MN,MMAXLS) INTEGER PTR(2,MMAXLS) LOGICAL UNUSED(MMAXLS) INTEGER BXINFO(5,MMAXLS) LOGICAL PINFO1(MMAXDP,MMAXLS) INTEGER PINFO2(2,MMAXDP,MMAXLS) C INTEGER NINLST, INDBOX(MMAXLS) C DOUBLE PRECISION DWORK(MDWORK) INTEGER IWORK(MIWORK) LOGICAL LWORK(MLWORK) C INTEGER INFO(MLINFO) INTEGER N INTEGER ADJFLG, MAXFT DOUBLE PRECISION EPS, EPSF INTEGER DLSFLG, PRTCON C C*********************************************************************** C C Major variable descriptions (See ROOTS and other routines for more C detailed information.) -- C C NCASE is the number of different problems to be run. (See the C routine INPUT.) C C CURBOX is an array for an interval N-vector (box). C (It is used to pass the initial region to ROOTS.) C C CURPT is space for a point N-vector. C C STACK is an array for the stack of boxes the algorithm must C still process. C C STKLVL, DPIVOT, IPIVOT, and TSTITR are associated with STACK. C The algorithm puts auxiliary information in these arrays. C STKLVL is indexed on the stack depth, while DPIVOT, C IPIVOT, and TSTITR are indexed on the depth of the binary C tree. C C BOXES is an array to contain the lists of root-containing boxes and C possibly other lists of boxes. C C POINTS, PTR, UNUSED, BXINFO, PINFO1, and PINFO2 are associated C with BOXES. The algorithm stores auxiliary information C in these arrays. C C NINLST Upon return from OUTPUT, NINLST is the number of C root-containing boxes in the list. C C INDBOX Upon return from OUTPUT, INDBOX(I) contains the index such C that BOXES(1,J,INDBOX(I)) and BOXES(2,J,INDBOX(I)) are the left C and right endpoints, respectively, of the J-th coordinate C interval of the I-th root-containing box, for I between C 1 and NINLST. C C DWORK is the double precision work array. C C IWORK is the integer work array. C C LWORK is the logical work array. C C INFO contains information about the lists of boxes, etc. C See the documentation in ROOTS, INPUT, OUTPUT, or ERROUT C for more information. C C N is the number of variables and equations in the system C presently under consideration. C C ADJFLG signals whether or not to implement the expansion/deletion C steps (steps 4 of the 1987 Math. Comput. paper (ibid.)): C C If ADJFLG = 1 then expansion/deletion steps are done. C C If ADJFLG is not equal to 1, then expansion/deletion steps C are omitted. C C MAXFT is the maximum allowable number of calls to the root-inclusion C test (FTEST). C C EPS is the minimum allowable width (in the norm defined by DIAMCP) C of an unresolved box. C C EPSF is the range tolerance; if it is certain that each component C of the vector function has absolute value less than EPSF C within a box, then that box is signalled as containing a C root. C C DLSFLG signals whether or not boxes deleted from the list during C the expansion/deletion process are stored in another C list. C C If DLSFLG = 1 then such boxes are stored. C C If DLSFLG is not equal to 1, then such boxes are NOT stored. C C (This flag is only significant if ADJFLG = 1. C C PRTCON controls the amount of information the routine OUTPUT C prints. (See OUTPUT for information.) C C IPTFMT controls the format for printing of floating point C numbers in the OUTPUT routine. See the OUTPUT routine C for details. C (OUTPUT) C C*********************************************************************** C C Common block declarations -- none C C However, users should be aware of the common blocks EQUAT, COEFFS, C CONFG1, and CONFG2 in INPUT. EQUAT and COEFFS also occur in C POLFUN, POLJAC, POLFSC, AND SCLFSC, while CONFG1 and CONFG2 also occur C in HNSNG. The block CONFG2 also occurs in CHKLST and DELLST, while C the block CONFG1 also occurs in PVSLCT. C Additionally the routines SIMINI and RNDOUT share machine constants C in common block MACH1. C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C ERRHND, ERROUT, INPUT, OUTPUT, ROOTS, SIMINI C EXTERNAL FTESTH, POLFSC, POLFUN, POLJAC, POLJSC C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- C C This routine gets the number of problems to be solved from UNITI C in I5 format. C C This routine outputs a message concerning which interval arithmetic C routines it employs to unit UNITO. C C*********************************************************************** C C Internal constant declarations -- C INTEGER MAXDP, MAXLST, UNITI, UNITO, UNITC INTEGER LINFO, LNDWRK, LNIWRK, LNLWRK C C*********************************************************************** C C Internal constant descriptions -- C C MAXDP has the same value as parameter MMAXDP. C C MAXLST has the same value as parameter MMAXLS. C C UNITI has the same value as parameter NUNITI. C C UNITO has the same value as parameter NUNITO. C C UNITC has the same value as parameter NUNITC. C C LINFO has the same value as parameter MLINFO. C C LNDWRK has the same value as parameter MDWORK. C C LNIWRK has the same value as parameter MIWORK. C C LNLWRK has the same value as parameter MLWORK. C C*********************************************************************** C C Beginning of executable statements -- C MAXDP = MMAXDP MAXLST = MMAXLS C LNDWRK = MDWORK LNIWRK = MIWORK LNLWRK = MLWORK C LINFO = MLINFO C UNITI = NUNITI UNITO = NUNITO UNITC = NUNITC C C Call the system-dependent error handling setup routine. C CALL ERRHND C C*********************************************************************** C C If the user has supplied the interval arithmetic routines, then C the following lines of code should not be commented. They should C otherwise be commented. C C WRITE(UNITO,1030) C WRITE(UNITO,1030) 'The user has supplied the interval arithmetic' C WRITE(UNITO,1030) 'routines.' C WRITE(UNITO,1030) C C When using the interval arithmetic routines supplied with the C package, the following lines of code should not be commented. C They should otherwise be commented. C CALL SIMINI WRITE(UNITO,1030) WRITE(UNITO,1030) 'The interval arithmetic routines supplied' WRITE(UNITO,1030) 'with this package will be used.' WRITE(UNITO,1030) C C*********************************************************************** C C The following dummy assignment is required for systems which C require adjustable array dimensions to be assigned before C entry into subroutines -- C N = 1 C C Input the number of problems to be solved. C READ(UNITI,*) NCASE C C Input the system, the initial region, etc. C DO 10 I = 1,NCASE C CALL INPUT(N,MN,UNITI,UNITO,UNITC,CURBOX,EPS,EPSF,ADJFLG,MAXFT, 1 DLSFLG,PRTCON,IPTFMT,INFO(1),INFO(2)) IF (INFO(1).NE.0) GOTO 800 C C Call the main generalized bisection algorithm. C CALL ROOTS(N,MAXLST,MAXDP,MAXFT,EPS,EPSF, 1 ADJFLG,DLSFLG,FTESTH,POLFUN,POLJAC, 2 CURBOX,CURPT,LINFO,INFO, 3 STACK,STKLVL,DPIVOT,IPIVOT,TSTITR, 4 BOXES,POINTS,PTR,UNUSED,BXINFO,PINFO1,PINFO2, 5 LNDWRK,DWORK,LNIWRK,IWORK,LNLWRK,LWORK) C C Take appropriate action if an error occurred during the root-finding C process. C 800 CALL ERROUT(N,MAXDP,MAXLST,MAXFT,UNITO,CURBOX,CURPT,LINFO, 1 INFO,STACK,STKLVL,DPIVOT,IPIVOT,TSTITR) C C Output the results (roots and diagnostics). C CALL OUTPUT(POLFUN,POLFSC,POLJSC,N,MAXDP,MAXLST,MAXFT, 1 EPS,EPSF,PRTCON,IPTFMT,UNITO,ADJFLG,DLSFLG,LINFO, 2 INFO,BOXES,POINTS,PTR,UNUSED,BXINFO,PINFO1,PINFO2, 3 NINLST,INDBOX,LNDWRK,DWORK,LNIWRK,IWORK) C 10 CONTINUE C STOP C 1030 FORMAT(1X,A,I5) C END C*********************************************************************** C*********************************************************************** SUBROUTINE ERRHND C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- GENBIS C C*********************************************************************** C C Function -- C C This machine-dependent routine is meant to access operating system C parameters which determine handling of arithmetic errors. C In particular -- C C (1) Underflows should be allowed. C C*********************************************************************** C C FORTRAN-SUPPLIED FUNCTIONS AND SUBROUTINES -- C C FOR THE IBM VM/CMS ENVIRONMENT -- C C EXTERNAL ERRSET C C*********************************************************************** C C Beginning of executable statements -- C C Set error handling for exponent underflow to no messages printed and C an unlimited number of occurrences. C C statement below is for IBM VM/CMS -- C C CALL ERRSET(208,300,-1,1,0,0) C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE INPUT(N,MN,UNITI,UNITO,UNITC,BOX,EPS,EPSF,ADJFLG,MAXFT, 1 DLSFLG,PRTCON,IPTFMT,ERRFLG,ERRVAL) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C PARAMETER (MN2 = 10) PARAMETER (MT = 30) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C Formats are taken partially from Alexander Morgan. (See below). C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- GENBIS C C*********************************************************************** C C Function -- C C This routine reads in the dimension and the coefficients of C the polynomial system from the main input file. It also reads C in tolerances, parameters which define the algorithm, and flags C which control printing from a separate configuration file. C C Depending on a configuration parameter, this routine may echo C the input. The routine always outputs a title associated with C the problem. C C This routine performs some error checking, and sets error flags C as appropriate. C C*********************************************************************** C C Argument declarations -- C INTEGER N, MN INTEGER UNITI, UNITO, UNITC DOUBLE PRECISION BOX(2,N), EPS, EPSF INTEGER ADJFLG, MAXFT, DLSFLG, PRTCON, IPTFMT, ERRFLG, ERRVAL C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the actual number of equations and variables. C (OUTPUT) C C MN is the maximum number of equations as defined in the C parameter statement in GENBIS. C (INPUT) C C UNITI is the unit number of the file (device) from which the C coefficients and exponents of the equations and the C endpoint intervals of the initial box will be read. C (INPUT) C C UNITO is the unit number of the file (device) to which all output C is directed. C (INPUT) C C UNITC is the unit number of the file (device) from which C tolerances and certain other configuration parameters will c be read. C (INPUT) C C BOX will contain the initial region to be examined. C (an N-dimensional interval vector) C (OUTPUT) C C EPS is the domain tolerance, and is related to the smallest C box to be produced by bisection. C (OUTPUT) C C EPSF is the range tolerance. C (OUTPUT) C C ADJFLG is set to 1 if expansion steps are to be implemented, and C is set to some other value otherwise. (See Algorithm 2.5 C in the paper R. B. Kearfott, 'Abstract generalized C bisection and a cost bound', Math. Comput. 49, 179 C (July, 1987), pp. 187-202. C (OUTPUT) C C MAXFT is the maximum number of calls to the routine which C tests boxes for roots. C (OUTPUT) C C DLSFLG is only used if expansion steps are implemented. If it C is set to 1, the algorithm produces a list of possible C root-containing boxes which have been removed from the C primary list because they are adjacent to or intersect C other such boxes. C (OUTPUT) C C PRTCON is a print control flag for the OUTPUT routine. Check C See the OUTPUT routine documentation for details. C (OUTPUT) C C IPTFMT controls the format for printing of floating point C numbers in the OUTPUT routine. See the OUTPUT routine C for details. C (OUTPUT) C C ERRFLG signals errors for the error-printing routine ERROUT. C If ERRFLG = 0 on return, then no monitored error has C occurred. C (OUTPUT) C C ERRVAL will contain additional information about the error, C if one has occurred. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C CHARACTER*1 TITLE(60) C INTEGER IECHO INTEGER J, K, L, NT C C*********************************************************************** C C Internal variable descriptions -- C C TITLE identifies the input file which has been accessed. C C IECHO controls echoing of input data within this routine. (See C the description of the configuration file below.) C C J, K, and L are loop indices. C C NT temporarily stores the number of terms in equations. C C*********************************************************************** C C Common block declarations -- C C In the common blocks below, MN2 denotes the number of equations, C and MT denotes the maximum number of terms in any single C equation. C INTEGER NUMT, KDEG COMMON/EQUAT/NUMT(MN2),KDEG(MN2,MN2,MT) C DOUBLE PRECISION A COMMON/COEFS/A(MN2,MT) C C /EQUAT/ passes exponents of variables from INPUT to C POLFUN, POLJAC, POLFSC, AND POLJSC. C C /COEFS/ passes coefficient values from INPUT to POLFUN, C POLJAC, POLFSC, AND POLJSC. C INTEGER ITRFLG, PIVFLG, JACFLG COMMON /CONFG1/ ITRFLG, PIVFLG, JACFLG C DOUBLE PRECISION TOL1, TOL2, TOL3 COMMON /CONFG2/ TOL1, TOL2, TOL3 C C /CONFG1/ passes control flags to the interval Newton C method routine HNSNG and to the routine PVSLCT. C These flags are described below with the C configuration file. C C /CONFG2/ passes tolerances to the interval Newton method C routine HNSNG and to the routines CHKLST and C DELLST. These tolerances are described below C with the configuration file. C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- C C INPUT: Is read from the configuration file UNITC and the C main input file UNITI. C C INPUT from UNITC: C C Input of the following variables occurs in the following order. C C DLSFLG -- See argument descriptions above. C C PRTCON -- See argument descriptions above. C C ITRFLG -- This is presently unused, but may control iteration C of the interval Newton method, if that routine is C modified in the future. C C PIVFLG -- This controls the way the index of the coordinate C interval to be bisected is chosen. C C If PIVFLG = 0, then the coordinate interval of C maximum width is chosen. C C If PIVFLG = 1, then the coordinate interval of C maximum width according to a certain scaling scheme C is chosen. C C If PIVFLG = 2, then the coordinate interval C corresponding to maximum 'smear' in the interval C Jacobian matrix is chosen. (See the explanation in the C paper accompanying this program.) C C JACFLG -- This controls the way the preconditioner matrix Y for C the interval Newton method is computed. If A is an C approximation to the value of the Jacobian matrix at C the midpoint of the box, then we mathematically C set Y to be the inverse of A. If F' is the interval C Jacobian matrix, then Y F' is the preconditioned C interval Jacobian matrix. If we numerically compute C Y as ( A-transpose)**(-1) )-transpose, then the C residual Y A - I may be smaller than if we compute Y C directly as A**(-1). C C If JACFLG = 0 then we compute Y in the ordinary way. C C If JACFLG = 1 then we compute Y from the transpose. C C ADJFLG -- See argument descriptions above. C C TOL1 -- This controls iteration of the interval Newton method. C If the ratio of volumes of the new box to the old C box is less than TOL1 but greater than TOL2, then C routine HNSNG does another iteration of the interval C Newton method after re-evaluating the Jacobian matrix. C C TOL2 -- If the ration of volumes of the new box to the old C box in the interval Newton method is less than TOL2, C then routine HNSNG does another iteration of the C interval Newton method with the same interval C Jacobian matrix as before. C C TOL3 -- TOL3 is presently unused, but is available to C HNSNG, CHKLST, and DELLST. C C EPS -- is the domain tolerance. C C EPSF -- is the range tolerance. C C MAXFT -- is the maximum allowable number of calls to the C root-inclusion test routine HNSNG. C C IECHO -- If IECHO = 0, then this routine does not echo any C of the input. C C If IECHO = 1, then this routine echos the configuration C parameters to the output unit UNITO. C C If IECHO = 2, then this routine echos both the C configuration parameters and the polynomial coefficients C and exponents to the output unit UNITO. C C IPTFMT -- See argument descriptions above. C C A sample UNITI input file follows. (Delete the first column to use C as a template.) C C 1 DLSFLG (0 no del. list, 1 del. list) C 2 PRTCON (1 ordinary, 2 ext., 3 1+path) C 1 ITRFLG (presently unused) C 2 PIVFLG (0 wid., 1 scl. wid., 2 max. sm.) C 1 JACFLG (0 ordinary, 1 transpose) C 1 ADJFLG (0 no exp./del., 1 exp./del.) C .6d0 TOL1 (good vol. ratio. in iteration) C -.4d0 TOL2 (extremely good vol. rat. in it.) C 0d0 TOL3 (presently unused) C 1.0D-05 EPSMIN (domain tolerance times 16) C 1.0D-10 EPSF (range tolerance) C 10000 MAXFT (max. no. calls to incl.test) C 2 IECHO (0 no echo, 1 config., 2 all) C 1 IPTFMT (0 lg, 1 med, 2 sht, 3 132) C C INPUT from UNITI: C C TITLE -- a 60 character alphanumeric problem description. C C N -- the number of equations and variables. C C The following three sets of input variables are grouped by equation C and term, as in the sample below: C C NUMTRM(I) -- number of terms in the I-th equation, C I=1 to N. C C DEG(I,K,J) -- degree of the K-th variable in the J-th term C of the I-th equation, I=1 to N, K=1 to N, J=1 to C NUMTRM(I). C C A(I,J) -- coefficient of the J-th term of the I-th equation, C I=1 to N, J=1 to NUMTRM(I). C C A sample UNITI input file follows. (Delete the first column to use C as a template.) Note that the first record contains the number of C datasets, and is read in the calling program. The remaining records C of this data file contain a sample data set. If NSETS > 1, then C additional data sets would be placed directly after the first one C (without spaces), and would follow the same format. C C 1 NSETS CTITLE: CUBIC - PARABOLA (TOMS 1986 -- PROBLEM 1)......... C 2 N C 3 NUMTRM(1) C 3 DEG(1,1,1) C 0 DEG(1,2,1) C 4.0D 00 A(1,1) C 1 DEG(1,1,2) C 0 DEG(1,2,2) C -3.0D 00 A(1,2) C 0 DEG(1,1,3) C 1 DEG(1,2,3) C -1.0D 00 A(1,3) C 2 NUMTRM(2) C 2 DEG(2,1,1) C 0 DEG(2,2,1) C 1.0D 00 A(2,1) C 0 DEG(2,1,2) C 1 DEG(2,2,2) C -1.0D 00 A(2,2) C -2.0D0 D0(1,1) C 2.0D0 D0(2,1) C -2.0D0 D0(1,2) C 2.0D0 D0(2,2) C C The last 2*N lines of this input file represent the endpoints C of the intervals which define the initial box. The other lines C of the input file are identical in format and content to the C lines of the input file for the program INPTAT on p. 366 of C Alexander Morgan, Solving Polynomial Systems using Continuation C for Engineering and Scientific Problems, Prentice-Hall, Englewood C Cliffs, NJ, 1987. Morgan refers to this as 'tableau' input of C the polynomial system. C C OUTPUT: If PRTCON > 0, then TITLE is output to UNITO. The input C and configuration parameters are also possibly echoed C to UNITO, depending on the value of IECHO from the C configuration file. C C*********************************************************************** C C INTERNAL CONSTANT DECLARATIONS -- NONE C C*********************************************************************** C C Beginning of executable statements -- C C Initialize error flag to 'no error'. C ERRFLG = 0 C C Check for compatibility between MN and common block dimensions. C C Input configuration parameters. C READ(UNITC,1040) DLSFLG READ(UNITC,1040) PRTCON READ(UNITC,1040) ITRFLG READ(UNITC,1040) PIVFLG READ(UNITC,1040) JACFLG READ(UNITC,1040) ADJFLG READ(UNITC,1030) TOL1 READ(UNITC,1030) TOL2 READ(UNITC,1030) TOL3 READ(UNITC,1030) EPS READ(UNITC,1030) EPSF READ(UNITC,1040) MAXFT READ(UNITC,1040) IECHO READ(UNITC,1040) IPTFMT C REWIND UNITC C C INPUT STATEMENTS FOR THE SYSTEM FOLLOW. C READ(UNITI,1010) TITLE READ(UNITI,1020) N C IF (N .GT.MN2) THEN ERRFLG = 14 ERRVAL = N RETURN END IF C IF (N.GT.MN) THEN ERRFLG = 3 ERRVAL = N RETURN END IF C DO 30 J= 1, N READ(UNITI,1020) NUMT(J) NT = NUMT(J) IF (NT .GT. MT) THEN ERRFLG = 15 ERRVAL = J RETURN END IF DO 20 K = 1, NT DO 10 L = 1, N READ(UNITI,1020) KDEG(J,L,K) 10 CONTINUE READ(UNITI,1030) A(J,K) 20 CONTINUE 30 CONTINUE C C*********************************************************************** C C Input the initial box. C C DO 40 J = 1, N READ(UNITI,1030) BOX(1,J) READ(UNITI,1030) BOX(2,J) 40 CONTINUE C C Output section. C IF (PRTCON.GT.0 .OR. IECHO.GE.1) THEN WRITE(UNITO,2030) 1 '************************************************************' WRITE(UNITO,2050) WRITE(UNITO,2050) WRITE(UNITO,2050) WRITE(UNITO,2030) 'Generalized bisection package' WRITE(UNITO,2040) TITLE END IF C IF (IECHO.GE.2) THEN WRITE(UNITO,2030) 'Number of equations = ', N WRITE(UNITO,2050) C WRITE(UNITO,2020) 'Initial region:',((BOX(I,J),I=1,2),J=1,N) WRITE(UNITO,2050) DO 70 J = 1, N WRITE(UNITO,2050) WRITE(UNITO,2050) WRITE(UNITO,2060) J,NUMT(J) NT = NUMT(J) DO 60 K = 1, NT DO 50 L = 1, N WRITE(UNITO,2070) J, L, K, KDEG(J,L,K) 50 CONTINUE WRITE(UNITO,2080) J, K, A(J,K) 60 CONTINUE 70 CONTINUE WRITE(UNITO,2050) WRITE(UNITO,2050) END IF C IF (IECHO.GE.1) THEN WRITE(UNITO,2050) WRITE(UNITO,2010) 'CONFIGURATION PARAMETERS:' WRITE(UNITO,2050) IF (ADJFLG.EQ.1) THEN WRITE(UNITO,2010) 'Expansion steps are implemented.' ELSE WRITE(UNITO,2010) 'Expansion steps are not implemented.' END IF WRITE(UNITO,2050) WRITE(UNITO,2030) 'ITRFLG: ',ITRFLG WRITE(UNITO,2030) 'PIVFLG: ',PIVFLG WRITE(UNITO,2030) 'JACFLG: ',JACFLG WRITE(UNITO,2010) 'TOL1 : ',TOL1 WRITE(UNITO,2010) 'TOL2 : ',TOL2 WRITE(UNITO,2010) 'TOL3 : ',TOL3 WRITE(UNITO,2010) 'EPS : ',EPS WRITE(UNITO,2010) 'EPSF : ',EPSF WRITE(UNITO,2030) 'MAXFT : ',MAXFT WRITE(UNITO,2030) 'IECHO : ',IECHO WRITE(UNITO,2030) 'IPTFMT: ',IPTFMT WRITE(UNITO,2030) 'ADJFLG: ',ADJFLG WRITE(UNITO,2050) WRITE(UNITO,2050) END IF C C*********************************************************************** C C Input formats -- C 1010 FORMAT(60A1) 1020 FORMAT(I5) 1030 FORMAT(D22.15) 1040 FORMAT(I8) C C Output formats -- C 2010 FORMAT(1X,A,1X,D30.22) 2020 FORMAT(1X,A,50(/2(2X,D30.22))) 2030 FORMAT(1X,A,I8) 2040 FORMAT(1X,60A1) 2050 FORMAT(1X) 2060 FORMAT(' NUMT(',I2,')=',I5) 2070 FORMAT(' KDEG(',I2,',',I2,',',I2,')=',I5) 2080 FORMAT(' A(',I2,',',I2,')=',D22.15) C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE OUTPUT(FUNC,FUNCSC,JACSC,N,MAXDP,MAXLST,MAXFT, 1 EPS,EPSF,PRTCON,IPTFMT,UNITO,ADJFLG,DLSFLG,LINFO,INFO,BOXES, 2 POINTS,PTR,UNUSED,BXINFO,PINFO1,PINFO2,NINLST,INDBOX, 3 LNDWRK,DWORK,LNIWRK,IWORK) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- GENBIS C C*********************************************************************** C C Function -- C C This is the primary output routine for the generalized bisection C package. Most output except for error messages occurs from this C routine. C C*********************************************************************** C C Argument declarations -- C EXTERNAL FUNC, FUNCSC, JACSC INTEGER N, MAXDP, MAXLST, MAXFT INTEGER PRTCON, IPTFMT, UNITO INTEGER ADJFLG, DLSFLG, LINFO, INFO(LINFO) DOUBLE PRECISION BOXES(2,N,MAXLST), POINTS(N,MAXLST) INTEGER PTR(2,MAXLST) LOGICAL UNUSED(MAXLST) INTEGER BXINFO(5,MAXLST) LOGICAL PINFO1(MAXDP,MAXLST) INTEGER PINFO2(2,MAXDP,MAXLST) INTEGER NINLST, INDBOX(MAXLST) INTEGER LNDWRK DOUBLE PRECISION DWORK(LNDWRK) INTEGER LNIWRK INTEGER IWORK(LNIWRK) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C FUNC is the name of the external routine which performs interval C function evaluations. GENBIS uses POLFUN. C C FUNCSC is the name of an external routine which does point function C evaluations. GENBIS uses POLFSC. C C JACSC is the name of an external routine which dies point Jacobian C matrix evaluations. GENBIS uses POLJSC. C C N is the number of equations and variables. C (INPUT) C C MAXDP is the maximum allowable depth of the stack of boxes yet to be C considered. It is also the maximum allowable depth of the C binary search tree. C (INPUT) C C MAXLST MAXLST - 2 is the maximum number of root-containing boxes which C can be stored. C (INPUT) C C MAXFT is the maximum allowable number of calls to the root-inclusion C test (FTESTH). C (INPUT) C C EPS is the minimum allowable width (in the norm defined by DIAMCP) C of an unresolved box. It is also the domain tolerance in C the scalar Newton method. C (INPUT) C C EPSF is the range tolerance; if it is certain that each component C of the vector function has absolute value less than EPSF C within a box, then that box is signalled as containing a C root. It is also the range tolerance in the scalar Newton C method. C (INPUT) C C PRTCON controls the amount of information printed in this routine. C C If PRTCON = 0, then this routine does not print; it merely C computes the number of boxes in the linked C list and returns their indices. C C If PRTCON = 1, then this routine prints the C root-containing boxes, approximate roots, C residuals, and a list of boxes which were C removed from the list due to possible C redundancies. C C If PRTCON = 2, then this routine also prints the boxes' C pointers in the linked list, the reasons C the boxes were added to the list, etc. C C If PRTCON = 3, then this routine also prints a table of C which boxes intersected boxes in the list, C as well as information about which coordinates C were bisected and the number of iterations of C the interval Newton method. C C (INPUT) C C IPTFMT controls the format for printing of floating point C numbers in this routine. C C If IPTFMT = 0, then floating point results are printed C with 22 digits in 80 column format. C C If IPTFMT = 1, then floating point results are printed C with 9 digits in 80 column format. C C If IPTFMT = 2, then floating point results are printed C with 2 digits in 80 column format. C C If IPTFMT = 3, then floating point results are printed C with 3 digits in 132 column format. This C setting is most appropriate for larger C systems. C C (INPUT) C C UNITO is the unit number of the file (device) to which all output C is directed. C (INPUT) C C ADJFLG signals whether or not to implement the expansion/deletion C steps (steps 4 of the 1987 Math. Comput. paper (ibid.)): C C If ADJFLG = 1 then expansion/deletion steps are done. C C If ADJFLG is not equal to 1, then expansion/deletion steps C are omitted. C C (INPUT) C C DLSFLG signals whether or not boxes deleted from the list during C the expansion/deletion process are stored in another C list. C (INPUT) C C LINFO is the length of the information vector INFO. C (INPUT) C C INFO is a vector containing information about the lists, as well as C other statistics: C C INFO(1) = error type. (ERRFLG : See subroutine ERROUT.) C C INFO(2) = additional error information (ERRVAL). C C INFO(3) = current depth of the stack. C C INFO(4) = the number of boxes which have been examined. C C INFO(5) = the number of boxes in list 1 (which contains C root-containing boxes). C C INFO(6) = the number of boxes in list 2, if it exists. C (See the explanation of DLSFLG above). C Otherwise, it is the number of boxes deleted in C expansion/deletion steps. C C INFO(7) = the header note for list 1. C C INFO(8) = the header node for list 2. C C INFO(9) = the maximum depth reached in the stack. C C INFO(10) = the maximum level reached in the binary tree. C C INFO(11) = the number of calls to the root inclusion test. C C INFO(12) = the number of interval function calls made to C possibly determine that the zero vector is not C in the range. C C INFO(13) = the number of function calls made for the C interval Newton method. C C INFO(14) = the number of interval and scalar Jacobian calls. C C INFO(15) = the number of expanded boxes. C C (INPUT) C C BOXES contains the lists of root-containing boxes, boxes which C have been deleted due to redundancies, and possibly other C lists of boxes. C (INPUT) C C POINTS contains points corresponding to the boxes in BOXES. These C points may simply be midpoints of the boxes, or approximations C to roots. C (I/O) C C PTR contains information about the 'links' between nodes in the C linked lists in BOXES and POINTS. C (I/O) C C UNUSED UNUSED(I) contains the state of the storage areas BOXES(*,*,i) C and POINTS(*,*,I); UNUSED(I) = 'TRUE' means that these C areas are not in use. C (I/O) C C BXINFO, PINFO1, and PINFO2 are storage areas whose entries C correspond to entries in BOXES, POINTS, and UNUSED. C Additional information about the root-containing boxes is C placed in these arrays. C (I/O) C C NINLST Upon return from OUTPUT, NINLST is the number of C root-containing boxes in the list. C (OUTPUT) C C INDBOX Upon return from OUTPUT, INDBOX(I) contains the index such C that BOXES(1,J,INDBOX(I)) and BOXES(2,J,INDBOX(I)) are the left C and right endpoints, respectively, of the J-th coordinate C interval of the I-th root-containing box, for I between C 1 and NINLST. C (OUTPUT) C C LNDWRK is the dimension of the double precision work vector. C (INPUT) C C DWORK is the double precision work vector. C (INPUT) C C LNIWRK is the length of the integer work vector. C (INPUT) C C IWORK is the integer work vector. C C*********************************************************************** C C Internal variable declarations -- C INTEGER ERRFLG, ERRVAL, DEPTH INTEGER NLEAVE, NLIST1, NLIST2, LIST(2), DMAX, LMAX INTEGER NFTCAL, NFCAL1, NFCAL2, NJCALL, NADJ DOUBLE PRECISION RESID INTEGER I, J, K, COUNT INTEGER CURPTR, BOXPTR LOGICAL PTFLG INTEGER IERR INTEGER IFINT, ISCLF, IDEND, IJAC, ISCX, IV INTEGER IIPVT, IIEND C INTEGER I1000, I1010, I1020, I1030, I1040, I1050, I1060 C C*********************************************************************** C C Internal variable descriptions -- C C ERRFLG Error type: 0 if no error, another value otherwise C (See subroutine ERROUT for more detailed information.) C C ERRVAL Additional error information C (See subroutine ERROUT for more detailed information.) C C DEPTH The current depth of the stack of boxes yet to be examined. C C NLEAVE The number of boxes for which the algorithm has reached a C conclusion about whether they contain roots. C C NLIST1 The number of boxes in list 1 C (List 1 is the list of root-containg boxes.) C C NLIST2 The number of boxes in list 2, if it exists; otherwise the C number of boxes deleted in expansion/deletion steps C (See the description of argument DLSFLG.) C C LIST The pointers to the header nodes of the linked lists C C DMAX The maximum depth reached in the stack of boxes yet to be C considered C C LMAX The maximum level reached in the binary search tree C corresponding to the bisection process C C NFTCAL The number of calls made to FTEST C C NFCAL1 the number of interval function calls made to possibly C determine that the zero vector is not in the range C C NFCAL2 the number of function calls made for the interval Newton C method C C NJCALL the number of interval and scalar Jacobian calls C C NADJ the number of expanded boxes C C RESID a temporary variable C C I, J, and K are loop indices. C C COUNT is an index for the boxes in a list as they are printed. C C CURPTR and BOXPTR are temporary pointers. C C PTFLG is set to .TRUE. if the intersection of two boxes has zero C volume, and is set to .FALSE. otherwise. C C IERR indicates if the classical Newton method has converged, C when precisely finding a root in a root-containing box. C C IFINT, ISCLF, IDEND, IJAC, ISCX, and IV are pointers into the C double precision work array. C C IIPVT and IIEND are pointers into the integer work array. C C I1000, I1010, I1020, I1030, I1040, I1050, and I1060 are variable C format statement numbers. I1010 corresponds to floating C point interval output, while I1020 corresponds to C non-interval floating point output. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C FUNC (POLFUN), FUNCSC (POLFSC), C JACSC (POLJSC), NEWTON C C DCOPY, DNRM2 (from LINPACK) C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- C C Output is to unit UNITO. See the explanations of PRTCON and IPTFMT C above. C C*********************************************************************** C C Internal constant declarations -- C INTEGER EOLIST, PREV, NEXT LOGICAL LEFT, RIGHT C C*********************************************************************** C C Internal constant descriptions -- C C EOLIST THE END-OF-LIST VALUE (0) FOR THE LINKED LIST STRUCTURE C C PREV In a linked list, PTR(PREV,*) is the pointer to the box C preceeding the box with pointer '*'. C C NEXT In a linked list, PTR(NEXT,*) is the pointer to the box C following the box with pointer '*'. C C LEFT is the logical value associated in this program with the C left box formed from bisection. The left box is that box C formed by replacing the right endpoint of the bisected C interval by its midpoint.) C C RIGHT is the logical value associated in this program with the C right box formed from bisection. The right box is that box C formed by replacing the left endpoint of the bisected C interval by its midpoint.) C C*********************************************************************** C DATA EOLIST/0/, PREV/1/, NEXT/2/ DATA LEFT/.TRUE./, RIGHT/.FALSE./ C C Beginning of executable statements -- C C Initialize pointers, etc. C IFINT = 1 ISCLF = IFINT + 2*N IJAC = ISCLF + N IDEND = IJAC + N*N -1 C ISCX = IFINT IV = ISCX + N C IIPVT = 1 IIEND = IIPVT + N-1 C ASSIGN 1000 TO I1000 ASSIGN 1030 TO I1030 ASSIGN 1040 TO I1040 ASSIGN 1050 TO I1050 ASSIGN 1060 TO I1060 IF (IPTFMT .EQ. 0) THEN ASSIGN 1020 TO I1010 ASSIGN 1020 TO I1020 ELSE IF (IPTFMT .EQ. 1) THEN ASSIGN 1011 TO I1010 ASSIGN 1021 TO I1020 ELSE IF (IPTFMT .EQ. 2) THEN ASSIGN 1012 TO I1010 ASSIGN 1022 TO I1020 ELSE IF (IPTFMT .EQ. 3) THEN ASSIGN 1013 TO I1010 ASSIGN 1023 TO I1020 END IF C ERRFLG = INFO(1) ERRVAL = INFO(2) DEPTH = INFO(3) NLEAVE = INFO(4) NLIST1 = INFO(5) NLIST2 = INFO(6) LIST(1) = INFO(7) LIST(2) = INFO(8) DMAX = INFO(9) LMAX = INFO(10) NFTCAL = INFO(11) NFCAL1 = INFO(12) NFCAL2 = INFO(13) NJCALL = INFO(14) NADJ = INFO(15) C C*********************************************************************** C C Output statistics. C IF (PRTCON.GT.0) THEN WRITE(UNITO,I1030) 'After ROOTS:' WRITE(UNITO,I1030) ' Number of roots found:',NLIST1 WRITE(UNITO,I1030) ' Number of leaves:',NLEAVE IF (ADJFLG.EQ.1) THEN WRITE(UNITO,I1030) ' Number of adjusted boxes:',NADJ WRITE(UNITO,I1030) 1 ' Number of boxes deleted due to redundancy:',NLIST2 ELSE WRITE(UNITO,I1030) 1 'Algorithm was configured to not adjust or delete boxes.' WRITE(UNITO,I1030) 'Number of undetermined boxes:', NLIST2 END IF WRITE(UNITO,I1030) ' Maximum binary tree level reached:',LMAX WRITE(UNITO,I1030) ' Maximum stack depth reached:',DMAX WRITE(UNITO,I1030) ' Number of ftest calls:',NFTCAL WRITE(UNITO,I1030) 1 ' Number of interval function calls to determine the range:', 2 NFCAL1 WRITE(UNITO,I1030) ' Number of Jacobian calls:', NJCALL WRITE(UNITO,I1030) 1 ' Number of function calls to do the interval Newton method:' 2 , NFCAL2 WRITE(UNITO,I1000) WRITE(UNITO,I1000) END IF C C Output boxes. C DO 200 I = 1, 2 C IF ((I.EQ.1).AND.(NLIST1.EQ.0)) THEN IF (ADJFLG.EQ.1) THEN IF (PRTCON.GT.0) WRITE(UNITO,I1030) 1 'No roots were found.' GOTO 200 ELSE IF (PRTCON.GT.0) THEN WRITE(UNITO,I1030) 1 'The test signalled no boxes as root-containing.' END IF GOTO 200 END IF ELSE IF (I.EQ.1) THEN IF (PRTCON.GT.0) WRITE(UNITO,I1030) 1 'LIST OF ROOT-CONTAINING BOXES FOLLOWS:' ELSE IF ((I.EQ.2).AND.(NLIST2.EQ.0).AND.(ADJFLG.EQ.1)) THEN IF (PRTCON.GT.0) THEN WRITE(UNITO,I1000) WRITE(UNITO,I1000) WRITE(UNITO,I1030) 'No boxes were deleted from the list.' END IF GOTO 200 ELSE IF ((I.EQ.2).AND.(DLSFLG.EQ.1).AND.(ADJFLG.EQ.1)) THEN IF (PRTCON.GT.0) THEN WRITE(UNITO,I1000) WRITE(UNITO,I1000) WRITE(UNITO,I1030) 'LIST OF DELETED BOXES FOLLOWS:' END IF ELSE IF ((I.EQ.2).AND.(ADJFLG.NE.1)) THEN IF (PRTCON.GT.0) THEN WRITE(UNITO,I1000) WRITE(UNITO,I1000) WRITE(UNITO,I1030) 1 'The test did not reject the following boxes, but their' WRITE(UNITO,I1030) 1 'diameters were smaller than EPS. NOTE: Diameters are' WRITE(UNITO,I1030) 1 'computed with the scaled norm defined in DIAMCP.' END IF ELSE GOTO 200 END IF C COUNT = 0 CURPTR = LIST(I) 100 CURPTR = PTR(NEXT,CURPTR) IF (CURPTR.EQ.EOLIST) THEN IF (I.EQ.1) NINLST = COUNT GOTO 200 END IF COUNT = COUNT + 1 INDBOX(COUNT) = CURPTR IF (PRTCON.GT.0) THEN WRITE(UNITO,I1000) WRITE(UNITO,I1000) WRITE(UNITO,I1030) 'BOX NUMBER ',COUNT END IF IF (PRTCON.GT.1) THEN WRITE(UNITO,I1030) ' Pointer in the linked list',CURPTR END IF C IF (IDEND.LE.LNDWRK .AND. IIEND.LE.LNIWRK) THEN CALL DCOPY (N,POINTS(1,CURPTR),1,DWORK(ISCX),1) CALL NEWTON (N,DWORK(ISCX),DWORK(IJAC),DWORK(IV),EPSF, 1 EPS,20,NITR,FUNCSC,JACSC,IWORK(IIPVT),IERR) IF (IERR.EQ.0) THEN IF (PRTCON.GT.0) WRITE (UNITO,I1030) 1 'Point Newton method succeeded with NITR =', NITR CALL DCOPY(N,DWORK(ISCX),1,POINTS(1,CURPTR),1) ELSE IF (PRTCON.GT.0) WRITE (UNITO,I1030) 1 'POINT NEWTON METHOD FAILED WITH IERR =', IERR END IF END IF C IF (PRTCON.GT.0) THEN C WRITE(UNITO,I1000) WRITE(UNITO,I1010) 1 'Containing intervals for the coordinates:', 2 ((BOXES(J,K,CURPTR),J=1,2),K=1,N) C WRITE(UNITO,I1020) 'Approximate root:', 1 (POINTS(K,CURPTR),K=1,N) C IF (IJAC-1.LE.LNDWRK) THEN CALL FUNC(N,BOXES(1,1,CURPTR),POINTS(1,CURPTR), 1 DWORK(IFINT), DWORK(ISCLF)) RESID = DNRM2(N,DWORK(ISCLF),1) WRITE(UNITO,I1020) 1 'Euclidean norm of residual at approximate root:',RESID WRITE(UNITO,I1010) 'Interval residual vector:', 1 ((DWORK(IFINT+J+2*K-3),J=1,2),K=1,N) WRITE(UNITO,I1020) 'Residual vector at approx. root:', 1 (DWORK(ISCLF+K-1), K=1,N) END IF END IF C IF (PRTCON.GT.1) THEN WRITE(UNITO,I1030) 'Resolved box number:',BXINFO(5,CURPTR) WRITE(UNITO,I1030) 'Box added at level:',BXINFO(2,CURPTR) IF (BXINFO(1,CURPTR).EQ.10) THEN WRITE(UNITO,I1030) ' Reason: | image | < EPSF' ELSE IF (BXINFO(1,CURPTR).EQ.11) THEN WRITE(UNITO,I1030) ' Reason: test signalled unique root' ELSE IF (BXINFO(1,CURPTR).EQ.18) THEN WRITE(UNITO,I1030) ' Reason: underwent expansion step' ELSE WRITE(UNITO,I1030) ' Reason: ',BXINFO(1,CURPTR) END IF IF ((I.EQ.2).AND.(DLSFLG.EQ.1).AND.(ADJFLG.EQ.1)) THEN WRITE(UNITO,I1030) 'Reason box deleted:',BXINFO(3,CURPTR) WRITE(UNITO,I1030) 'Pointer of intersecting box:', 1 BXINFO(4,CURPTR) END IF END IF IF (PRTCON.GT.2) THEN WRITE(UNITO,I1050) LEFT, RIGHT WRITE(UNITO,I1060) (PINFO2(1,J,CURPTR),PINFO1(J,CURPTR), 1 PINFO2(2,J,CURPTR),J=1,BXINFO(2,CURPTR)) END IF GOTO 100 C 200 CONTINUE C C*********************************************************************** C C Print intersection table for boxes in list 2. C IF (PRTCON.LE.3) RETURN WRITE(UNITO,I1000) WRITE(UNITO,I1000) WRITE(UNITO,I1030) 'Intersection table of boxes in second list' WRITE(UNITO,I1000) BOXPTR = LIST(2) 300 BOXPTR = PTR(NEXT,BOXPTR) IF (BOXPTR.EQ.EOLIST) RETURN WRITE(UNITO,I1030) 'Boxptr = ',BOXPTR CURPTR = LIST(2) 310 CURPTR = PTR(NEXT,CURPTR) IF (CURPTR.EQ.BOXPTR) GOTO 310 IF (CURPTR.EQ.EOLIST) GOTO 300 PTFLG = .TRUE. DO 320 I = 1, N IF (BOXES(2,I,CURPTR).LT.BOXES(1,I,BOXPTR)) GOTO 310 IF (BOXES(1,I,CURPTR).GT.BOXES(2,I,BOXPTR)) GOTO 310 IF (BOXES(2,I,CURPTR).GT.BOXES(1,I,BOXPTR)) PTFLG = .FALSE. IF (BOXES(1,I,CURPTR).LT.BOXES(2,I,BOXPTR)) PTFLG = .FALSE. 320 CONTINUE IF (PTFLG) THEN WRITE(UNITO,I1040) 1 ' intersects BOXPTR ',CURPTR,' with zero volume.' ELSE WRITE(UNITO,I1040) ' Intersects BOXPTR ',CURPTR END IF GOTO 310 C C*********************************************************************** C C Format statements -- C 1000 FORMAT(1X) C 1011 FORMAT(1X,A,25(/2(2X,2(2X,D17.9)))) 1012 FORMAT(1X,A,50(/3(2X,2(2X,D10.2)))) 1013 FORMAT(1X,A,100(/5(2X,2(2X,D30.22)))) C 1020 FORMAT(1X,A,50(/2(2X,D30.22))) 1021 FORMAT(1X,A,25(/4(2X,D17.9))) 1022 FORMAT(1X,A,50(/6(2X,D10.2))) 1023 FORMAT(1X,A,100(/10(2X,D30.22))) C 1030 FORMAT(1X,A,I8) C 1040 FORMAT(1X,A,I8,A) 1050 FORMAT(2X,'Left is ',L1,' and right is ',L1) 1060 FORMAT(20(/' / ',6(I3,L1,I3,' / '))) C END C*********************************************************************** C*********************************************************************** SUBROUTINE ROOTS(N,MAXLST,MAXDP,MAXFT,EPS,EPSF,ADJFLG,DLSFLG, 1 FTEST,FUNC,JAC,CURBOX,CURPT,LINFO,INFO,STACK,STKLVL, 2 DPIVOT,IPIVOT,TSTITR,BOXES,POINTS,PTR,UNUSED,BXINFO, 3 PINFO1,PINFO2,LNDWRK,DWORK,LNIWRK,IWORK,LNLWRK,LWORK) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package. C C*********************************************************************** C C Called by -- GENBIS C C*********************************************************************** C C Function -- C C This routine controls the overall generalized bisection C scheme. In the comments, steps are labelled as in the paper C paper, R. B. Kearfott, 'Abstract generalized bisection and a cost C bound', Math. Comput. 49, 179 (July, 1987), pp. 187-202. C C*********************************************************************** C C Argument declarations -- C INTEGER N, MAXLST, MAXDP, MAXFT DOUBLE PRECISION EPS, EPSF INTEGER ADJFLG, DLSFLG EXTERNAL FTEST, FUNC, JAC DOUBLE PRECISION CURBOX(2,N), CURPT(N) INTEGER LINFO, INFO(LINFO) DOUBLE PRECISION STACK(2,N,MAXDP) INTEGER STKLVL(MAXDP) LOGICAL DPIVOT(MAXDP) INTEGER IPIVOT(MAXDP), TSTITR(MAXDP) DOUBLE PRECISION BOXES(2,N,MAXLST), POINTS(N,MAXLST) INTEGER PTR(2,MAXLST) LOGICAL UNUSED(MAXLST) INTEGER BXINFO(5,MAXLST) LOGICAL PINFO1(MAXDP,MAXLST) INTEGER PINFO2(2,MAXDP,MAXLST) INTEGER LNDWRK DOUBLE PRECISION DWORK(LNDWRK) INTEGER LNIWRK, IWORK(LNIWRK), LNLWRK LOGICAL LWORK(LNLWRK) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of equations and variables. C (INPUT) C C MAXLST MAXLST - 2 is the maximum number of root-containing boxes which C can be stored. C (INPUT) C C MAXDP is the maximum allowable depth of the stack of boxes yet to be C considered. It is also the maximum allowable depth of the C binary search tree. C (INPUT) C C MAXFT is the maximum allowable number of calls to the root-inclusion C test (FTESTH). C (INPUT) C C EPS is the minimum allowable width (in the norm defined by DIAMCP) C of an unresolved box. C (INPUT) C C EPSF is the range tolerance; if it is certain that each component C of the vector function has absolute value less than EPSF C within a box, then that box is signalled as containing a C root. C (INPUT) C C ADJFLG signals whether or not to implement the expansion/deletion C steps (steps 4 of the 1987 Math. Comput. paper (ibid.)): C C If ADJFLG = 1 then expansion/deletion steps are done. C C If ADJFLG is not equal to 1, then expansion/deletion steps C are omitted. C C (INPUT) C C DLSFLG signals whether or not boxes deleted from the list during C the expansion/deletion process are stored in another C list. C C If DLSFLG = 1 then such boxes are stored. C C If DLSFLG is not equal to 1, then such boxes are NOT stored. C C (This flag is only significant if ADJFLG = 1. C C (INPUT) C C CURBOX is the initial region, on entry. It holds the current box C to be considered during the computation. C (I/O) C C CURPT is storage space for an N-vector (of numbers). C (I/O) C C LINFO is the length of the information vector 'INFO'. C (INPUT) C C INFO is a vector containing information about the lists, as well as C other statistics: C C INFO(1) = error type. (ERRFLG : See subroutine ERROUT.) C C INFO(2) = additional error information (ERRVAL). C C INFO(3) = current depth of the stack. C C INFO(4) = the number of boxes which have been examined. C C INFO(5) = the number of boxes in list 1 (which contains C root-containing boxes). C C INFO(6) = the number of boxes in list 2, if it exists. C (See the explanation of DLSFLG above). C Otherwise, it is the number of boxes deleted in C expansion/deletion steps. C C INFO(7) = the header note for list 1. C C INFO(8) = the header node for list 2. C C INFO(9) = the maximum depth reached in the stack. C C INFO(10) = the maximum level reached in the binary tree. C C INFO(11) = the number of calls to the root inclusion test. C C INFO(12) = the number of interval function calls made to C possibly determine that the zero vector is not C in the range. C C INFO(13) = the number of function calls made for the C interval Newton method. C C INFO(14) = the number of interval and scalar Jacobian calls. C C INFO(15) = the number of expanded boxes. C C (OUTPUT) C C STACK is temporary storage space for the stack of boxes yet to be C examined. C (I/O) C C STKLVL is an integer stack whose entries correspond to the entries in C STACK. In it is stored the level (in the binary tree C from bisection) at which the corresponding box in STACK C occurred. C (I/O) C C DPIVOT, IPIVOT, and TSTITR are for additional stack information C associated with boxes stored in STACK. Their entries C correspond to entries in STACK. C (I/O) C C BOXES contains the lists of root-containing boxes. (There are C possibly two such linked lists; see DLSFLG above.) C C (I/O) C C POINTS contains points corresponding to the boxes in BOXES. These C points may simply be midpoints of the boxes, or approximations C to roots. C (I/O) C C PTR contains information about the 'links' between nodes in the C linked lists in BOXES and POINTS. C (I/O) C C UNUSED UNUSED(I) contains the state of the storage areas BOXES(*,*,i) C and POINTS(*,*,I); UNUSED(I) = 'TRUE' means that these C areas are not in use. C (I/O) C C BXINFO, PINFO1, and PINFO2 are storage areas whose entries C correspond to entries in BOXES, POINTS, and UNUSED. C Additional information about the root-containing boxes is C placed in these arrays. C (I/O) C C LNDWRK is the length of the double precision work vector DWORK. C (INPUT) C C DWORK is double precision work space (used in roots, FTEST, etc.) C (I/O) C C LNIWRK is the length of the integer work vector IWORK. C (INPUT) C C IWORK is integer work space (used in ROOTS, FTEST, etc.) C (I/O) C C LNLWRK is the length of the logical work vector LWORK. C (INPUT) C C LWORK is logical work space (used in ROOTS, FTEST, etc.) C (I/O) C C*********************************************************************** C C Internal variable declarations -- C INTEGER ERRFLG, ERRVAL, DEPTH, LEVEL INTEGER NLEAVE, NLIST1, NLIST2, LIST(2), DMAX, LMAX INTEGER NFTCAL, NFCAL1, NFCAL2, NJCALL, NADJ DOUBLE PRECISION DIAM LOGICAL UNKNWN, SIGRT, DP INTEGER IP, RETCON INTEGER TPTR1, TPTR2 INTEGER I, NT C C*********************************************************************** C C Internal variable descriptions -- C C ERRFLG Error type: 0 if no error, another value otherwise C (See subroutine ERROUT for more detailed information.) C C ERRVAL Additional error information C (See subroutine ERROUT for more detailed information.) C C DEPTH The current depth of the stack of boxes yet to be examined. C C LEVEL The current level in the binary search tree C C NLEAVE The number of boxes for which the algorithm has reached a C conclusion about whether they contain roots. C C NLIST1 The number of boxes in list 1 C (List 1 is the list of root-containg boxes.) C C NLIST2 The number of boxes in list 2, if it exists; otherwise the C number of boxes deleted in expansion/deletion steps C (See the description of argument DLSFLG.) C C LIST The pointers to the header nodes of the linked lists C C DMAX The maximum depth reached in the stack of boxes yet to be C considered C C LMAX The maximum level reached in the binary search tree C corresponding to the bisection process C C NFTCAL The number of calls made to FTEST C C NFCAL1 the number of interval function calls made to possibly C determine that the zero vector is not in the range C C NFCAL2 the number of function calls made for the interval Newton C method C C NJCALL the number of interval and scalar Jacobian calls C C NADJ The number of expanded boxes C C DIAM The diameter of the current box C C UNKNWN Set to .TRUE. in FTEST to signal 'unknown' for the C root-inclusion test; set to .FALSE. in FTEST if the C root-inclusion test is true or false. C C SIGRT Set to .TRUE. in FTEST if the root-inclusion test signals a C unique root; set to .FALSE. in FTEST if the root-inclusion C test signals no root C (This flag is meaningful only if UNKNWN = .FALSE.) C C DP is set to .TRUE. if the left box formed from bisection is to C be considered next, and is set to .FALSE. if the right box is C to be considered next. (The left box is that box formed by C replacing the right endpoint of the bisected interval by its C midpoint.) (This choice is made in PVSLCT.) C C IP Set to the index of the coordinate PVSLCT has chosen to be C bisected C C RETCON is the return condition from FTEST. Its values are as C follows. C C 0: The preconditioner matrix could not be computed. C C 1: The root-inclusion test was inconclusive. C C 2: The diameter of the box is less than the domain C tolerance EPS/16. C C 10: Each component of the function has absolute value less C than the range tolerance EPSF over the entire box. C C 11: The box contains a unique root. C C 20: Zero is not in the interval value of the function. C C 21: The image of the box under the interval Newton method C has null intersection with the box. C C TPTR1 and TPTR2 are temporary pointers. C C I A loop index C C NT Temporary storage C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C MAX C C*********************************************************************** C C Package-supplied functions and subroutines -- C C BISECT, CHKLST, DELLST, DIAMCP, EXPAND, XINFO C C From the linked list and stack management subpackage -- C C ADDBOX, ALLOC, POP, and PUSH C C From LINPACK (BLAS) -- C C DCOPY C C The root inclusion test -- C C (FTEST) (The package-supplied routine is FTESTH; the user C may substitute his or her own routine.) C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER NTTWO, EOLIST DOUBLE PRECISION R, EPSBOX C C*********************************************************************** C C Internal constant descriptions -- C C NTTWO 2*N C C EOLIST The end-of-list value (0) for the linked list structure C C R A parameter used in the expansion/deletion process C C EPSBOX The minimum allowable width (in the norm defined DIAMCP) of C an unresolved box C C*********************************************************************** C DATA EOLIST/0/ C C Beginning of executable statements -- C C Step 0 (housekeeping) C NTTWO = N * 2 R = 0.5D0 IF (ADJFLG.EQ.1) THEN EPSBOX = EPS * (R/2D0)**2 ELSE EPSBOX = EPS END IF C ERRFLG = 0 ERRVAL = 0 LEVEL = 1 DEPTH = 0 C NLEAVE = 0 NLIST1 = 0 NLIST2 = 0 DMAX = 0 LMAX = 0 NFTCAL = 0 NFCAL1 = 0 NFCAL2 = 0 NJCALL = 0 NADJ = 0 C C Check lengths of workspace vectors. C IF (LNDWRK.LT.N) THEN ERRFLG = 2 ERRVAL = N GOTO 900 END IF C C Set all nodes in the linked list pool to 'free'. C DO 10 I = 1, MAXLST UNUSED(I) = .TRUE. 10 CONTINUE C C Create linked lists. (Allocate header nodes.) C DO 40 I = 1, 2 IF ((I.EQ.2).AND.(ADJFLG.EQ.1).AND.(DLSFLG.NE.1)) GOTO 40 CALL ALLOC(TPTR1,MAXLST,UNUSED) IF (TPTR1.EQ.EOLIST) THEN ERRFLG = 20 ERRVAL = MAXLST GOTO 900 END IF LIST(I) = TPTR1 PTR(1,TPTR1) = EOLIST PTR(2,TPTR1) = EOLIST 40 CONTINUE C C*********************************************************************** C C Step 1 (Initialization phase) C DO 110 I = 1, N CURPT(I) = (CURBOX(1,I) + CURBOX(2,I)) / 2D0 110 CONTINUE CALL DIAMCP(N,CURBOX,DIAM) C GOTO 330 C C*********************************************************************** C C Step 2 (Subdivision phase) C 200 CONTINUE C CALL BISECT(N,CURBOX,CURPT,IP,DP,DWORK(1),ERRFLG,ERRVAL) IF (ERRFLG.NE.0) GOTO 900 C IF (LEVEL.LE.MAXDP) THEN IPIVOT(LEVEL) = IP DPIVOT(LEVEL) = DP END IF C LEVEL = LEVEL + 1 CALL PUSH(N,DWORK(1),MAXDP,DEPTH,LEVEL,STACK,STKLVL,ERRFLG,ERRVAL) IF (ERRFLG.NE.0) GOTO 900 C C*********************************************************************** C C Step 3 (Test phase and storage of roots) C 300 CONTINUE C C Step 3(a) C CALL DIAMCP(N,CURBOX,DIAM) C C Step 3(b) C IF ((ADJFLG.EQ.1).AND.(DIAM.LT.(R/2D0)*EPS)) THEN CALL CHKLST(N,MAXLST,LIST,CURBOX,BOXES,PTR,R,EPS, 1 BXINFO,TPTR1) IF (TPTR1.NE.EOLIST) THEN NLIST2 = NLIST2 + 1 IF (DLSFLG.EQ.1) THEN CALL ALLOC(TPTR2,MAXLST,UNUSED) IF (TPTR2.EQ.EOLIST) THEN ERRFLG = 20 ERRVAL = MAXLST GOTO 900 END IF CALL DCOPY(NTTWO,CURBOX,1,BOXES(1,1,TPTR2),1) CALL DCOPY(N,CURPT,1,POINTS(1,TPTR2),1) CALL ADDBOX(LIST(2),TPTR2,PTR) CALL XINFO(TPTR2,19,LEVEL,1,TPTR1,NLEAVE,MAXDP,MAXLST, 1 BXINFO,PINFO1,PINFO2,DPIVOT,IPIVOT,TSTITR) END IF GOTO 500 END IF END IF C C Step 3(c) C 330 CONTINUE CALL FTEST(N,CURBOX,CURPT,DIAM,ERRFLG,ERRVAL,UNKNWN,SIGRT, 1 FUNC,JAC,EPSBOX,EPSF,RETCON,NFCAL1,NFCAL2,NJCALL, 2 MAXDP,DEPTH,LEVEL,STACK,STKLVL, 3 IP,DP,DPIVOT,IPIVOT,TSTITR, 4 LNDWRK,DWORK,LNIWRK,IWORK,LNLWRK,LWORK) NFTCAL = NFTCAL + 1 IF (ERRFLG.NE.0) GOTO 900 IF (NFTCAL.GT.MAXFT) THEN ERRFLG = 1 ERRVAL = MAXFT GOTO 900 END IF C C Step 3(d) C IF (UNKNWN.AND.(DIAM.GE.EPSBOX)) GOTO 200 C C Step 3(e) C IF ((.NOT.UNKNWN).AND.(.NOT.SIGRT)) GOTO 500 C C Step 3(f) C IF ((.NOT.UNKNWN).AND.SIGRT) THEN NLIST1 = NLIST1 + 1 CALL ALLOC(TPTR2,MAXLST,UNUSED) IF (TPTR2.EQ.EOLIST) THEN ERRFLG = 20 ERRVAL = MAXLST GOTO 900 END IF CALL DCOPY(NTTWO,CURBOX,1,BOXES(1,1,TPTR2),1) CALL DCOPY(N,CURPT,1,POINTS(1,TPTR2),1) CALL ADDBOX(LIST(1),TPTR2,PTR) CALL XINFO(TPTR2,RETCON,LEVEL,2,TPTR1,NLEAVE,MAXDP,MAXLST, 1 BXINFO,PINFO1,PINFO2,DPIVOT,IPIVOT,TSTITR) * IF ((ADJFLG.EQ.1).AND.(DIAM.LT.(R/2D0)*EPS)) THEN NT = NLIST1 CALL DELLST(N,MAXLST,NLIST1,TPTR2,LIST,BOXES,PTR,R,EPS, 1 DLSFLG,BXINFO,UNUSED) NLIST2 = NLIST2 + (NT - NLIST1) END IF GOTO 500 END IF C C*********************************************************************** C C Steps 4(a) AND 4(c) C CALL ALLOC(TPTR2,MAXLST,UNUSED) IF (TPTR2.EQ.EOLIST) THEN ERRFLG = 20 ERRVAL = MAXLST GOTO 900 END IF IF (ADJFLG.EQ.1) THEN NADJ = NADJ + 1 NLIST1 = NLIST1 + 1 CALL EXPAND(N,R,CURBOX,BOXES(1,1,TPTR2)) CALL DCOPY(N,CURPT,1,POINTS(1,TPTR2),1) CALL ADDBOX(LIST(1),TPTR2,PTR) ELSE NLIST2 = NLIST2 + 1 CALL DCOPY(NTTWO,CURBOX,1,BOXES(1,1,TPTR2),1) CALL DCOPY(N,CURPT,1,POINTS(1,TPTR2),1) CALL ADDBOX(LIST(2),TPTR2,PTR) END IF CALL XINFO(TPTR2,18,LEVEL,0,0,NLEAVE,MAXDP,MAXLST,BXINFO, 1 PINFO1,PINFO2,DPIVOT,IPIVOT,TSTITR) C C Step 4(b) C IF ((ADJFLG.EQ.1).AND.(NLIST1.GT.1)) THEN NT = NLIST1 CALL DELLST(N,MAXLST,NLIST1,TPTR2,LIST,BOXES,PTR,R,EPS, 1 DLSFLG,BXINFO,UNUSED) NLIST2 = NLIST2 + (NT - NLIST1) END IF C C*********************************************************************** C C Step 5 (Backtrack) C 500 CONTINUE LMAX = MAX(LMAX,LEVEL) DMAX = MAX(DMAX,DEPTH) C C Steps 5(a) - 5(d) C NLEAVE = NLEAVE + 1 IF (DEPTH.NE.0) THEN CALL POP(N,CURBOX,MAXDP,DEPTH,LEVEL,STACK,STKLVL,ERRFLG,ERRVAL) IF (ERRFLG.NE.0) GOTO 900 DO 520 I = 1, N CURPT(I) = (CURBOX(1,I) + CURBOX(2,I)) / 2D0 520 CONTINUE IF ((LEVEL-1.GE.1).AND.(LEVEL-1.LE.MAXDP)) THEN DPIVOT(LEVEL-1) = .NOT.DPIVOT(LEVEL-1) END IF GOTO 300 END IF C C*********************************************************************** C C Set information vector for return 900 CONTINUE C INFO(1) = ERRFLG INFO(2) = ERRVAL INFO(3) = DEPTH INFO(4) = NLEAVE INFO(5) = NLIST1 INFO(6) = NLIST2 INFO(7) = LIST(1) INFO(8) = LIST(2) INFO(9) = DMAX INFO(10) = LMAX INFO(11) = NFTCAL INFO(12) = NFCAL1 INFO(13) = NFCAL2 INFO(14) = NJCALL INFO(15) = NADJ C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE BISECT(N,BOX1,CURPT,IP,DP,BOX2,ERRFLG,ERRVAL) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- ROOTS C C*********************************************************************** C C Function -- C C This routine bisects the box in BOX1 by bisecting the IP-th C coordinate interval. It then stores the half dictated by DP C back in BOX1 and the other half in BOX2. It also stores the midpoint C of the new BOX1 in CURPT. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION BOX1(2,N), CURPT(N) INTEGER IP LOGICAL DP DOUBLE PRECISION BOX2(2,N) INTEGER ERRFLG, ERRVAL C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of variables and equations. C (INPUT) C C BOX1 On entry, BOX1 contains the box to be bisected. C On return, BOX1 contains the half of the bisected box C which DP defines to be the next current box. C (I/O) C C CURPT On return, CURPT is set to the midpoint of the box in BOX1. C (OUTPUT) C C IP is the index of the coordinate interval to be bisected. C (INPUT) C C DP indicates the half of the bisected box (left or right) to be C the next current box. (The left box is that box formed by C replacing the right endpoint of the bisected interval by its C midpoint.) (This choice is made in PVSLCT.) C (INPUT) C C BOX2 On return, BOX2 contains the half of the bisected box to be C placed on the stack for future examination. C (OUTPUT) C C ERRFLG On return, ERRFLG is set to 0 if no error has occured, and is C otherwise set to some other value. (See subroutine ERROUT C for more detailed information.) C (OUTPUT) C C ERRVAL contains additional error information. (See subroutine ERROUT C for more detailed information.) C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C DOUBLE PRECISION TMIDPT INTEGER I C C*********************************************************************** C C Internal variable descriptions -- C C TMIDPT is a temporary midpoint value. C C I is a loop index. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C DCOPY (from LINPACK) C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER NTTWO LOGICAL LEFT, RIGHT C C*********************************************************************** C C Internal constant descriptions -- C C NTTWO 2*N C C LEFT the logical value associated in this program with the C left box formed from bisection. (See DP above.) C C RIGHT the logical value associated in this program with the C right box formed from bisection. (See DP above.) C C*********************************************************************** C DATA LEFT/.TRUE./, RIGHT/.FALSE./ C C Beginning of executable statements -- C NTTWO = 2 * N C C Check to see if coordinate index selected for bisection is within C bounds. C IF ((IP.LE.0).OR.(IP.GT.N)) THEN ERRFLG = 32 ERRVAL = IP RETURN END IF C C Compute the midpoint of the interval to be bisected. C TMIDPT = (BOX1(1,IP) + BOX1(2,IP)) / 2D0 C C Make sure the interval to be bisected does not have endpoints C which are adjacent machine numbers. C IF ((TMIDPT.LE.BOX1(1,IP)).OR.(TMIDPT.GE.BOX1(2,IP))) THEN ERRFLG = 33 ERRVAL = IP RETURN END IF C C Perform the bisection. C CALL DCOPY(NTTWO,BOX1,1,BOX2,1) IF (DP.EQV.LEFT) THEN C WANT LEFT BOX TO BE NEW CURRENT BOX BOX1(2,IP) = TMIDPT BOX2(1,IP) = TMIDPT ELSE C WANT RIGHT BOX TO BE NEW CURRENT BOX BOX1(1,IP) = TMIDPT BOX2(2,IP) = TMIDPT END IF C C Compute the midpoint of the new current box. C DO 10 I = 1, N CURPT(I) = (BOX1(1,I) + BOX1(2,I)) / 2D0 10 CONTINUE C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE CHKLST(N,MAXLST,LIST,CURBOX,BOXES,PTR,R,EPS,BXINFO, 1 CURPTR) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- ROOTS C C*********************************************************************** C C Function -- C C The general purpose of this subroutine is to determine when to C remove a redundantly listed box from the list of root containing C boxes. Such redundancy could occur when a root happens C to occur near a boundary of two or more boxes, when the C Jacobian matrix is nearly singular at the root, or when the C interval approximation to the Jacobian matrix is poor. The C removal process will work well in the first case, but functions C heuristically in the other two cases. C C Specifically this subroutine returns a pointer to the first C box which intersects the box in CURBOX and which has a sufficiently C small diameter, if such a box exists. If there is no such C intersecting box, this routine returns the end-of-list pointer. C C*********************************************************************** C C Argument declarations -- C INTEGER N, MAXLST, LIST(2) DOUBLE PRECISION CURBOX(2,N), BOXES(2,N,MAXLST) INTEGER PTR(2,MAXLST) DOUBLE PRECISION R, EPS INTEGER BXINFO(5,MAXLST), CURPTR C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of equations and variables. C (INPUT) C C MAXLST MAXLST - 2 is the maximum number of root-containing boxes which C can be stored. C (INPUT) C C LIST contains the pointers to the header nodes of the linked lists. C (INPUT) C C CURBOX contains the current box, to be compared with boxes in the C list. C (INPUT) C C BOXES is an array which holds the coordinates of the boxes in C the lists. C (INPUT) C C PTR contains information about the locations of boxes in the C array BOXES. C (INPUT) C C R is a parameter used in the expansion/deletion process C and here to determine when diameters are sufficiently C small. C (INPUT) C C EPS is the minimum allowable width (in the norm defined by C DIAMCP) of an unresolved box. C (INPUT) C C BXINFO is a storage areas whose entries correspond to entries C in BOXES. Additional information about the root-containing C boxes is placed here. C (INPUT) C C CURPTR On exit, CURPTR is set to 0 (the end-of-list pointer) if no C box in the list intersected the box in CURBOX; otherwise, C CURPTR is set to the pointer of the first box in the list C which intersected CURBOX. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C DOUBLE PRECISION DIAM1, DIAM2 INTEGER I C C*********************************************************************** C C Internal variable descriptions -- C C DIAM1 is the diameter of the current box. C C DIAM2 is a temporary variable for the diameters of boxes in the C list. C C I is a loop index. C C*********************************************************************** C C Common block declarations -- C DOUBLE PRECISION TOL1, TOL2, TOL3 COMMON /CONFG2/ TOL1, TOL2, TOL3 C C /CONFG2/ passes tolerances from INPUT to this routine and to C the routines HNSNGT and DELLST. These tolerances C are described in INPUT with the configuration file. C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C DIAMCP C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C DOUBLE PRECISION TOL, REPSD2 INTEGER EOLIST, PREV, NEXT C C*********************************************************************** C C Internal constant descriptions -- C C TOL the intersection tolerance C C REPSD2 R*EPS/2 C C EOLIST the end-of-list value (0) for the linked list structure C C PREV PTR(PREV,*) is the pointer to the box preceeding the C box with pointer '*' in the linked list. C C NEXT PTR(NEXT,*) is the pointer to the box following the C box with pointer '*' in the linked list. C C*********************************************************************** C DATA EOLIST/0/, PREV/1/, NEXT/2/ C C Beginning of executable statements -- C REPSD2 = R * EPS / 2D0 C TOL = 10D0 * EPS TOL = TOL3 CALL DIAMCP(N,CURBOX,DIAM1) CURPTR = LIST(1) 10 CURPTR = PTR(NEXT,CURPTR) IF (CURPTR.EQ.EOLIST) GOTO 20 C C Remove comment in next line if only checking expanded boxes. C C IF (BXINFO(1,CURPTR).NE.18) GOTO 10 CALL DIAMCP(N,BOXES(1,1,CURPTR),DIAM2) IF (DIAM1+DIAM2.GT.REPSD2) GOTO 10 DO 15 I = 1, N IF (CURBOX(2,I).LT.BOXES(1,I,CURPTR)-TOL) GOTO 10 IF (CURBOX(1,I).GT.BOXES(2,I,CURPTR)+TOL) GOTO 10 15 CONTINUE 20 RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE DELLST(N,MAXLST,NINLST,BOXPTR,LIST,BOXES,PTR,R,EPS, 1 DLSFLG,BXINFO,UNUSED) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- ROOTS C C*********************************************************************** C C Function -- C C This subroutine removes those boxes from the list of root-containing C boxes which intersect a specified box and which have sufficiently C small diameters. C C The general purpose is to reduce redundancy in the list of C boxes. Such redundancy could occur when a root happens C to occur near a boundary of two or more boxes, when the C Jacobian matrix is nearly singular at the root, or when the C interval approximation to the Jacobian matrix is poor. The C removal process will work well in the first case, but functions C heuristically in the other two cases. C C*********************************************************************** C C Argument declarations -- C INTEGER N, MAXLST, NINLST, BOXPTR, LIST(2) DOUBLE PRECISION BOXES(2,N,MAXLST) INTEGER PTR(2,MAXLST) DOUBLE PRECISION R, EPS INTEGER DLSFLG, BXINFO(5,MAXLST) LOGICAL UNUSED(MAXLST) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of equations and variables. C (INPUT) C C MAXLST MAXLST - 2 is the maximum number of root-containing boxes which C can be stored. C (INPUT) C C NINLST is the number of root-containing boxes presently in the list. C (INPUT) C C BOXPTR is the pointer to the box whose intersection with other C boxes in the list is to be checked. C (INPUT) C C LIST contains the pointers to the header nodes of the linked lists. C (INPUT) C C BOXES is an array which holds the coordinates of the boxes in C the lists. C (INPUT) C C PTR contains information about the locations of boxes in the C array BOXES. C (INPUT) C C R is a parameter used in the expansion/deletion process C and here to determine when diameters are sufficiently C small. C (INPUT) C C EPS is the minimum allowable width (in the norm defined by C DIAMCP) of an unresolved box. C (INPUT) C C DLSFLG is equal to 1 if boxes removed from the list are to be C stored in another list. If DLSFLG is not equal to 1, then C such boxes are simply discarded. C (INPUT) C C BXINFO is a storage areas whose entries correspond to entries C in BOXES. Additional information about the root-containing C boxes is placed here. C (INPUT) C C UNUSED UNUSED(I) contains the state of the storage areas BOXES(*,*,i) C and BXINFO(*,I); UNUSED(I) = 'TRUE' means that these C areas are not in use. C (I/O) C C*********************************************************************** C C Internal variable declarations -- C DOUBLE PRECISION DIAM1, DIAM2 INTEGER CURPTR, I, TPTR C C*********************************************************************** C C Internal variable descriptions -- C C DIAM1 is the diameter of the box whose intersection with other C boxes is to be checked. C C DIAM2 is a temporary variable for diameters of boxes in the list. C C CURPTR is a temporary pointer. C C I is a loop index. C C TPTR is a temporary pointer. C C*********************************************************************** C C Common block declarations -- C DOUBLE PRECISION TOL1, TOL2, TOL3 COMMON /CONFG2/ TOL1, TOL2, TOL3 C C /CONFG2/ passes tolerances from INPUT to this routine and to C the routines CHKLST and HNSNG. These tolerances C are described in INPUT with the configuration file. C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C ADDBOX, DELBOX, FREE, DIAMCP C C*********************************************************************** C C user-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C DOUBLE PRECISION TOL, REPSD2 INTEGER EOLIST, PREV, NEXT C C*********************************************************************** C C Internal constant descriptions -- C C TOL the intersection tolerance C C REPSD2 R*EPS/2 C C EOLIST the end-of-list value (0) for the linked list structure C C PREV PTR(PREV,*) is the pointer to the box preceeding the C box with pointer '*' in the linked list. C C NEXT PTR(NEXT,*) is the pointer to the box following the C box with pointer '*' in the linked list. C C*********************************************************************** C DATA EOLIST/0/, PREV/1/, NEXT/2/ C C Beginning of executable statements -- C REPSD2 = R * EPS / 2D0 C TOL = 10D0 * EPS TOL = TOL3 CALL DIAMCP(N,BOXES(1,1,BOXPTR),DIAM1) IF (DIAM1.GE.REPSD2) THEN CURPTR = EOLIST GOTO 20 END IF CURPTR = LIST(1) 10 CURPTR = PTR(NEXT,CURPTR) 12 IF (CURPTR.EQ.BOXPTR) GOTO 10 IF (CURPTR.EQ.EOLIST) GOTO 20 CALL DIAMCP(N,BOXES(1,1,CURPTR),DIAM2) IF (DIAM1+DIAM2.GT.REPSD2) GOTO 10 DO 15 I = 1, N IF (BOXES(2,I,BOXPTR).LT.BOXES(1,I,CURPTR)-TOL) GOTO 10 IF (BOXES(1,I,BOXPTR).GT.BOXES(2,I,CURPTR)+TOL) GOTO 10 15 CONTINUE NINLST = NINLST - 1 TPTR = PTR(NEXT,CURPTR) CALL DELBOX(CURPTR,PTR) IF (DLSFLG.EQ.1) THEN CALL ADDBOX(LIST(2),CURPTR,PTR) BXINFO(3,CURPTR) = 3 BXINFO(4,CURPTR) = BOXPTR ELSE CALL FREE(CURPTR,MAXLST,UNUSED) END IF CURPTR = TPTR GOTO 12 20 RETURN C END C*********************************************************************** C*********************************************************************** SUBROUTINE DIAMCP(N,X,DIAM) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C CALLED BY -- CHKLST, DELLST, FTESTH, and ROOTS. C C*********************************************************************** C C Function -- C C This routine computes the diameter of the N-box X (in a scaled C infinity norm) and returns the value in DIAM. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION X(2,N) DOUBLE PRECISION DIAM C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of variables and equations. C (INPUT) C C X X(1,I) is the left endpoint of the I-th coordinate interval C of the box, and X(2,I) is the right endpoint of the I-th C coordinate interval of the box, for I between 1 and N. C (INPUT) C C DIAM is set to the diameter of X in a scaled infinity norm. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C INTEGER I DOUBLE PRECISION WIDTH, BIG C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C MAX, ABS C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C DIAM = 0D0 DO 10 I = 1, N WIDTH = X(2,I) - X(1,I) BIG = MAX(1D0,ABS(X(1,I)),ABS(X(2,I))) DIAM = MAX (DIAM,WIDTH/BIG) 10 CONTINUE C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE DVSBIN(X,D,N,A,ICASE,R1,R2) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- HNSNG C C*********************************************************************** C C Function -- C C This routine performs the following portions of an interval C Gauss-Seidel step: C C (1) the extended-value interval division; C C (2) subtraction of the quotient (1) from a point value; C C and C C (3) intersection of the difference (2) with the appropriate C component of the original box. C C The number of resulting intervals is returned in ICASE. These C intervals are stored as follows: C C If ICASE = 0 then no intervals are stored; C C if ICASE = 1 then the interval is stored in R1; C C and C C if ICASE = 2 then one interval is stored in R1 and the other C interval is stored in R2. C C*********************************************************************** C C Argument declarations -- C DOUBLE PRECISION X, D(2), N(2), A(2) INTEGER ICASE DOUBLE PRECISION R1(2), R2(2) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C X is the point from which the interval is to be subtracted. C (INPUT) C C D is the denominator of the interval quotient. C (INPUT) C C N is the numerator of the interval quotient. C (INPUT) C C A is the appropriate component interval of the box to which C the interval Gauss-Seidel is to be applied. C (INPUT) C C ICASE indicates the number of intervals returned. C (OUTPUT) C C R1 will contain the first resultant interval. C (OUTPUT) C C R2 will contain the second resultant interval. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C INTEGER XCASE DOUBLE PRECISION B(2) C C*********************************************************************** C C Internal variable descriptions -- C C XCASE indicates the type of the current temporary C extended-value result of any of the extended-value C interval arithmetic functions (XDIV, XINT, XSCLSB). C See the documentation of these routines for more C information. C C B is a temporary interval. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C XDIV, XINT, XSCLSB C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C C Save the interval A in case it is overwritten before needed. C B(1) = A(1) B(2) = A(2) C C Do the extended-value interval division. C CALL XDIV(XCASE,N,D,R1,R2) C C If the result is a single interval, do the subtraction and C the intersection, then return. C IF (XCASE.NE.5) THEN CALL XSCLSB(XCASE,X,R1,R1) CALL XINT(XCASE,B,R1,R1) ICASE = XCASE RETURN END IF C C Since the result of the division is two intervals, do the C subtraction and intersection with the first one and place C the result in R1. C XCASE = 3 CALL XSCLSB(XCASE,X,R1,R1) CALL XINT(XCASE,B,R1,R1) ICASE = XCASE XCASE = 2 C C Now do the subtraction and intersection with the second interval. C If the corresponding result with the first interval was empty, C place the result using the second interval in R1. Otherwise, C place the result in R2 (unless that result is empty). C IF (ICASE.EQ.0) THEN CALL XSCLSB(XCASE,X,R2,R1) CALL XINT(XCASE,B,R1,R1) ICASE = XCASE RETURN ELSE CALL XSCLSB(XCASE,X,R2,R2) CALL XINT(XCASE,B,R2,R2) ICASE = ICASE + XCASE RETURN END IF C END C*********************************************************************** C*********************************************************************** SUBROUTINE ERROUT(N,MAXDP,MAXLST,MAXFT,UNITO,CURBOX,CURPT,LINFO, 1 INFO,STACK,STKLVL,DPIVOT,IPIVOT,TSTITR) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- GENBIS C C*********************************************************************** C C Function -- C C This routine prints all error messages. It will also, depending C on the error, output the boxes which had not yet been resolved at C the time the error occurred. This is done so that the user does not C need to run the program again for the entire region if it has C terminated for reasons such as stack overflow, no free space in the C linked list, maximu, number of FTEST calls exceeded, etc. C C*********************************************************************** C C Argument declarations -- C INTEGER N, MAXDP, MAXLST, MAXFT INTEGER UNITO DOUBLE PRECISION CURBOX(2,N), CURPT(N) INTEGER LINFO, INFO(LINFO) DOUBLE PRECISION STACK(2,N,MAXDP) INTEGER STKLVL(MAXDP) LOGICAL DPIVOT(MAXDP) INTEGER IPIVOT(MAXDP), TSTITR(MAXDP) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of equations and variables. C (INPUT) C C MAXDP is the maximum allowable depth of the stack of boxes yet to be C considered. It is also the maximum allowable depth of the C binary search tree. C (INPUT) C C MAXLST MAXLST - 2 is the maximum number of root-containing boxes which C can be stored. C (INPUT) C C MAXFT is the maximum allowable number of calls to the root-inclusion C test (FTESTH). C (INPUT) C C UNITO is the unit number of the file (device) to which all output C will be directed. C (INPUT) C C CURBOX Space for an N-dimensional interval vector (box) used C to store the box being examined at any given time. C (INPUT) C C CURPT Space for a point in N dimensions, which usually contains C either the midpoint of CURBOX or some approximation to a C root in CURBOX. C (INPUT) C C LINFO is the number of spaces in the information vector INFO. C (INPUT) C C INFO is a vector containing information about the lists, as well as C other statistics: C C INFO(1) = error type. (ERRFLG : See subroutine ERROUT.) C C INFO(2) = additional error information (ERRVAL). C C INFO(3) = current depth of the stack. C C INFO(4) = the number of boxes which have been examined. C C INFO(5) = the number of boxes in list 1 (which contains C root-containing boxes). C C INFO(6) = the number of boxes in list 2, if it exists. C (See the explanation of DLSFLG above). C Otherwise, it is the number of boxes deleted in C expansion/deletion steps. C C INFO(7) = the header note for list 1. C C INFO(8) = the header node for list 2. C C INFO(9) = the maximum depth reached in the stack. C C INFO(10) = the maximum level reached in the binary tree. C C INFO(11) = the number of calls to the root inclusion test. C C INFO(12) = the number of interval function calls made to C possibly determine that the zero vector is not C in the range. C C INFO(13) = the number of function calls made for the C interval Newton method. C C INFO(14) = the number of interval and scalar Jacobian calls. C C INFO(15) = the number of expanded boxes. C C (INPUT) C C STACK is temporary storage space for the stack of boxes yet to be C examined. C (INPUT) C C STKLVL is an integer stack whose entries correspond to the entries in C STACK. In it is stored the level (in the binary tree C from bisection) at which the corresponding box in STACK C occurred. C (INPUT) C C DPIVOT, IPIVOT, and TSTITR are for additional stack information C associated with boxes stored in STACK. Their entries C correspond to entries in STACK. C (INPUT) C C*********************************************************************** C C Internal variable declarations -- C INTEGER ERRFLG, ERRVAL, DEPTH INTEGER NLEAVE, NLIST1, NLIST2, LIST(2), DMAX, LMAX INTEGER NFTCAL, NFCAL1, NFCAL2, NJCALL, NADJ INTEGER J, K, LEVEL C C*********************************************************************** C C Internal variable descriptions -- C C ERRFLG Error type: 0 if no error, another value otherwise C (See error messages below for details.) C C ERRVAL Additional error information C (See error messages below for details.) C C DEPTH The current depth of the stack of boxes which still need to C be considered. C C NLEAVE The number of boxes for which the algorithm has reached a C conclusion about whether they contain roots. C C NLIST1 The number of boxes in list 1 C (List 1 is the list of root-containg boxes.) C C NLIST2 The number of boxes in list 2, if it exists; otherwise the C number of boxes deleted in expansion/deletion steps C (See the description of argument DLSFLG.) C C LIST The pointers to the header nodes of the linked lists C C DMAX The maximum depth reached in the stack of boxes yet to be C considered C C LMAX The maximum level reached in the binary search tree C corresponding to the bisection process C C NFTCAL The number of calls made to FTEST C C NFCAL1 the number of interval function calls made to possibly C determine that the zero vector is not in the range C C NFCAL2 the number of function calls made for the interval Newton C method C C NJCALL The number of interval and scalar Jacobian calls C C NADJ The number of expanded boxes C C J and K are loop indices. C C LEVEL a temporary value used to store the level of a box in the C binary search tree C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C POP C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- C C Output: This routine outputs a message corresponding to the value C if ERRFLG to UNITO. If an error occurs, it may also output C additional information about the program's state. Such C information may include the box being examined at the C time the error occurred, as well as the boxes remaining C on the stack. C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C ERRFLG = INFO(1) ERRVAL = INFO(2) DEPTH = INFO(3) NLEAVE = INFO(4) NLIST1 = INFO(5) NLIST2 = INFO(6) LIST(1) = INFO(7) LIST(2) = INFO(8) DMAX = INFO(9) LMAX = INFO(10) NFTCAL = INFO(11) NFCAL1 = INFO(12) NFCAL2 = INFO(13) NJCALL = INFO(14) NADJ = INFO(15) C C*********************************************************************** C C Error messages C IF (ERRFLG.EQ.0) THEN WRITE(UNITO,1030) 'SUCCESSFUL COMPLETION OF BINARY SEARCH.' GOTO 900 C ELSE IF (ERRFLG.EQ.1) THEN WRITE(UNITO,1030) 'THE MAXIMUM NUMBER OF CALLS TO FTEST',ERRVAL WRITE(UNITO,1030) 1 'HAS BEEN EXCEEDED. CHANGE THE VALUE OF MAXFT IN YOUR' WRITE(UNITO,1030) 1 'INPUT FILE AND RERUN, RUN THE PROGRAM FOR EACH OF THE' WRITE(UNITO,1030) 1 'BOXES NOT YET EXAMINED, INCREASE THE DOMAIN TOLERANCE EPS' WRITE(UNITO,1030) 1 'OR THE RANGE TOLERANCE EPSF, OR TRY TO DETERMINE PROPERTIES' WRITE(UNITO,1030) 1 'OF THE SYSTEM WHICH MAKE IT DIFFICULT TO SOLVE.' C ELSE IF (ERRFLG.EQ.2) THEN WRITE(UNITO,1030) 'ROOTS REQUIRES A MINIMUM OF ',ERRVAL WRITE(UNITO,1030) 'FOR THE DIMENSION OF DWORK. CHANGE' WRITE(UNITO,1030) 'THE PARAMETER MDWORK IN GENBIS TO THIS' WRITE(UNITO,1030) 'VALUE AND RECOMPILE.' GOTO 900 C ELSE IF (ERRFLG.EQ.3) THEN WRITE(UNITO,1030) 'THE DIMENSION OF THE SYSTEM ',ERRVAL WRITE(UNITO,1030) 'IS GREATER THAN THE MAXIMUM ALLOWED' WRITE(UNITO,1030) 'FOR IN THE PROGRAM. CHANGE PARAMETER MN' WRITE(UNITO,1030) 'IN GENBIS AND RECOMPILE.' GOTO 900 C ELSE IF (ERRFLG.EQ.4) THEN WRITE(UNITO,1030) 'THE TEST ROUTINE REQUIRES ',ERRVAL WRITE(UNITO,1030) 'AS THE DIMENSION OF THE DOUBLE PRECISION' WRITE(UNITO,1030) 'WORK ARRAY. CHANGE PARAMETER MDWORK IN' WRITE(UNITO,1030) 'GENBIS TO THIS VALUE AND RECOMPILE.' GOTO 900 C ELSE IF (ERRFLG.EQ.5) THEN WRITE(UNITO,1030) 'THE TEST ROUTINE REQUIRES ',ERRVAL WRITE(UNITO,1030) 'AS THE DIMENSION OF THE INTEGER' WRITE(UNITO,1030) 'WORK ARRAY. CHANGE PARAMETER MIWORK IN' WRITE(UNITO,1030) 'GENBIS TO THIS VALUE AND RECOMPILE.' GOTO 900 C ELSE IF (ERRFLG.EQ.6) THEN WRITE(UNITO,1030) 'THE TEST ROUTINE REQUIRES ',ERRVAL WRITE(UNITO,1030) 'AS THE DIMENSION OF THE LOGICAL' WRITE(UNITO,1030) 'WORK ARRAY. CHANGE PARAMETER MLWORK IN' WRITE(UNITO,1030) 'GENBIS TO THIS VALUE AND RECOMPILE.' GOTO 900 C ELSE IF (ERRFLG.EQ.10) THEN WRITE(UNITO,1030) 'THE MAXIMUM DEPTH OF THE STACK,',ERRVAL WRITE(UNITO,1030) 1 'HAS BEEN REACHED. CHANGE PARAMETER MMAXDP IN GENBIS' WRITE(UNITO,1030) 1 'AND RECOMPILE, RUN THE PROGRAM FOR EACH OF THE BOXES' WRITE(UNITO,1030) 1 'NOT YET EXAMINED, OR TRY TO DETERMINE PROPERTIES' WRITE(UNITO,1030) 1 'SYSTEM WHICH MAKE IT DIFFICULT TO SOLVE.' C ELSE IF (ERRFLG.EQ.11) THEN WRITE(UNITO,1030) 'AN ATTEMPT HAS BEEN MADE TO POP SOMETHING' WRITE(UNITO,1030) 'FROM THE STACK WHEN IT WAS EMPTY.' GOTO 900 C ELSE IF (ERRFLG.EQ.12) THEN WRITE(UNITO,1030) 'AN ILLEGAL VALUE ',ERRVAL WRITE(UNITO,1030) 'FOR THE STACK DEPTH HAS OCCURRED IN PUSH.' WRITE(UNITO,1030) 'THIS IS A FATAL ERROR.' GOTO 900 C ELSE IF (ERRFLG.EQ.13) THEN WRITE(UNITO,1030) 'AN ILLEGAL VALUE ',ERRVAL WRITE(UNITO,1030) 'FOR THE STACK DEPTH HAS OCCURRED IN POP.' WRITE(UNITO,1030) 'THIS IS A FATAL ERROR.' GOTO 900 C ELSE IF (ERRFLG.EQ.14) THEN WRITE(UNITO,1030) 'THE DIMENSION N =', N WRITE(UNITO,1030) 1 'IS GREATER THAN PARAMETER MN2 IN INPUT, POLFUN, POLJAC,' WRITE(UNITO,1030) 1 'POLFPT, AND SCLFPT.' WRITE(UNITO,1030) 1 'THIS CAUSES A DIMENSION PROBLEM IN COMMON BLOCKS EQUAT' WRITE(UNITO,1030) 1 'AND COEFS IN THESE ROUTINES. MAKE MN2 EQUAL IN ALL OF' WRITE(UNITO,1030) 1 'THESE ROUTINES AND GREATER THAN OR EQUAL TO N.' GOTO 900 C ELSE IF (ERRFLG.EQ.15) THEN WRITE(UNITO,1030) 1 'THE NUMBER OF TERMS IN EQUATION ', ERRVAL WRITE(UNITO,1030) 1 'IS GREATER THAN PARAMETER MT IN INPUT, POLFUN, POLJAC,' WRITE(UNITO,1030) 1 'POLFPT, AND SCLFPT.' WRITE(UNITO,1030) 1 'THIS CAUSES A DIMENSION PROBLEM IN COMMON BLOCKS EQUAT' WRITE(UNITO,1030) 1 'AND COEFS IN THESE ROUTINES. MAKE MT EQUAL IN ALL OF' WRITE(UNITO,1030) 1 'THESE ROUTINES AND GREATER THAN OR EQUAL TO THE MAXIMUM' WRITE(UNITO,1030) 1 'NUMBER OF TERMS IN ANY EQUATION.' GOTO 900 C ELSE IF (ERRFLG.EQ.20) THEN WRITE(UNITO,1030) 'TOTAL REQUESTS FOR LINKED LIST NODES HAS' WRITE(UNITO,1030) 'EXCEEDED THE AVAILABLE NUMBER ',ERRVAL WRITE(UNITO,1030) 'TRY ONE OF THE FOLLOWING:' WRITE(UNITO,1030) ' (1) INCREASE VALUE OF MMAXLS IN THE' WRITE(UNITO,1030) ' DRIVER AND RECOMPILE.' WRITE(UNITO,1030) ' (2) IF EXPANSION STEPS ARE IMPLEMENTED' WRITE(UNITO,1030) ' SET DLSFLG TO 0 IN THE CONFIGURATION' WRITE(UNITO,1030) ' FILE.' WRITE(UNITO,1030) ' (3) RUN THE PROGRAM FOR EACH OF THE' WRITE(UNITO,1030) ' BOXES NOT EXAMINED.' WRITE(UNITO,1030) ' (4) DECREASE THE DOMAIN TOLERANCE EPS' WRITE(UNITO,1030) ' OR THE RANGE TOLERANCE EPSF.' WRITE(UNITO,1030) ' (5) DETERMINE PROPERTIES OF' WRITE(UNITO,1030) ' THE SYSTEM WHICH MAKE IT' WRITE(UNITO,1030) ' DIFFICULT TO SOLVE.' C ELSE IF (ERRFLG.EQ.30) THEN WRITE(UNITO,1030) 'AN ILLEGAL VALUE FOR PIVFLG ',ERRVAL WRITE(UNITO,1030) 'WAS GIVEN IN THE CONFIGURATION FILE.' WRITE(UNITO,1030) 'CHANGE IT AND RERUN THE PROGRAM (OR CHANGE' WRITE(UNITO,1030) 'THE ROUTINE PVSLCT, RECOMPILE, AND RERUN).' C ELSE IF (ERRFLG.EQ.31) THEN WRITE(UNITO,1030) 1 'PVSLCT SELECTED THE ILLEGAL COORDINATE ',ERRVAL WRITE(UNITO,1030) 'TO BE BISECTED.' C ELSE IF (ERRFLG.EQ.32) THEN WRITE(UNITO,1030) 'AN ILLEGAL COORDINATE ',ERRVAL WRITE(UNITO,1030) 'WAS PASSED TO THE ROUTINE BISECT.' C ELSE IF (ERRFLG.EQ.33) THEN WRITE(UNITO,1030) 'THE COORDINATE SELECTED TO BISECT ',ERRVAL WRITE(UNITO,1030) 'IS AN INTERVAL WITH ADJACENT MACHINE' WRITE(UNITO,1030) 'NUMBERS FOR ENDPOINTS.' C ELSE IF (ERRFLG.EQ.40) THEN WRITE(UNITO,1030) 'AN ILLEGAL VALUE WAS RETURNED FROM FTEST' WRITE(UNITO,1030) 'FOR THE VARIABLE RETCON :',ERRVAL C ELSE WRITE(UNITO,1030) 'ERROR: RETURN FROM ROOTS WITH' WRITE(UNITO,1030) ' ERRFLG = ',ERRFLG WRITE(UNITO,1030) ' ERRVAL = ',ERRVAL END IF C C*********************************************************************** C C OUTPUT CURRENT BOX AND DUMP STACK C WRITE(UNITO,1000) WRITE(UNITO,1020) 'CURRENT BOX:',((CURBOX(J,K),J=1,2),K=1,N) WRITE(UNITO,1000) WRITE(UNITO,1030) 'BOXES FROM THE STACK:' WRITE(UNITO,1000) 100 IF (DEPTH.EQ.0) GOTO 890 CALL POP(N,CURBOX,MAXDP,DEPTH,LEVEL,STACK,STKLVL,ERRFLG,ERRVAL) WRITE(UNITO,1020) ' ',((CURBOX(J,K),J=1,2),K=1,N) WRITE(UNITO,1000) GOTO 100 C 890 WRITE(UNITO,1030) 'END OF LIST OF STACK BOXES' WRITE(UNITO,1000) C 900 CONTINUE RETURN C 1000 FORMAT(1X) 1010 FORMAT(1X,A,1X,D30.22) 1015 FORMAT(1X,A,/2X,D30.22) 1020 FORMAT(1X,A,50(/2(2X,D30.22))) 1025 FORMAT(1X,A,50(/2X,D30.22)) 1030 FORMAT(1X,A,I8) 1040 FORMAT(I8) 1050 FORMAT(D22.15) 1080 FORMAT('+',2X,I3,A,I3) 1082 FORMAT(2X,'LEFT IS ',L1,' AND RIGHT IS ',L1) 1085 FORMAT(20(/' | ',6(I3,L1,I3,' | '))) 1090 FORMAT(D30.22) C END C*********************************************************************** C*********************************************************************** SUBROUTINE EXPAND(N,R,DL,DLB) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- ROOTS C C*********************************************************************** C C Function -- C C This routine performs step 4 of Algorithm 2.5 in R. B. Kearfott, C 'Abstract generalized bisection and a cost bound', Math. Comput. 49, C 179 (July, 1987), pp. 187-202. C C The purpose of this algorithm is to reduce redundancies and make C the algorithm more efficient when roots happen to occur near C boundaries of boxes. This algorithm is moderately successful at C this. Future versions may be even more so, if they take account C of the convergence rate of the interval Newton method to expand C boxes before they become small. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION R DOUBLE PRECISION DL(2,N) DOUBLE PRECISION DLB(2,N) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of equations and variables. C (INPUT) C C R is the number R defined in Definition 2.2 (vi) of Kearfott C (ibid.). C (INPUT) C C DL DL(1,I) is the lower limit of the I-th coordinate interval C and DL(2,I) is the upper limit of the I-th coordinate C interval, for I between 1 and N. C (INPUT) C C DLB is an array with the same structure as DL, but which will C represent the expanded box in Algorithm 2.5 of Kearfott, C (ibid.). C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C DOUBLE PRECISION CI INTEGER I C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C DO 10 I = 1, N CI = (DL(1,I)+DL(2,I)) / 2D0 DLB(1,I) = CI + (2D0/R) * (DL(1,I) - CI) DLB(2,I) = CI + (2D0/R) * (DL(2,I) - CI) 10 CONTINUE C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE FTESTH(N,X,XPT,DIAM,ERRFLG,ERRVAL,UNKNWN,SIGRT, 1 FUNC,JAC,EPSBOX,EPSF,RETCON,NFCAL1,NFCAL2,NJCALL, 2 MAXDP,DEPTH,LEVEL,STACK,STKLVL, 3 IP,DP,DPIVOT,IPIVOT,TSTITR, 4 LNDWRK,DWORK,LNIWRK,IWORK,LNLWRK,LWORK) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package. C C*********************************************************************** C C Called by -- ROOTS C C*********************************************************************** C C Function -- C C This subroutine partitions the work storage for use in the C arrays in the root inclusion test routine HNSNG (to allow C changes in HNSNG without necessarily modifying the overall C algorithm ROOTS). It also calls the routine PVSLCT; that routine C selects the coordinate direction to be bisected next, and also C indicates which of the two resulting boxes is most likely to C contain roots. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION X(2,N), XPT(N), DIAM INTEGER ERRFLG, ERRVAL LOGICAL UNKNWN, SIGRT EXTERNAL FUNC, JAC DOUBLE PRECISION EPSBOX, EPSF INTEGER RETCON, NFCAL1, NFCAL2, NJCALL, MAXDP, DEPTH INTEGER LEVEL DOUBLE PRECISION STACK(2,N,MAXDP) INTEGER STKLVL(MAXDP) INTEGER IP LOGICAL DP LOGICAL DPIVOT(MAXDP) INTEGER IPIVOT(MAXDP), TSTITR(MAXDP) INTEGER LNDWRK DOUBLE PRECISION DWORK(LNDWRK) INTEGER LNIWRK, IWORK(LNIWRK), LNLWRK LOGICAL LWORK(LNLWRK) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of variables and equations. C (INPUT) C C X On entry, this array contains the box to be tested for C roots. On exit, this array either contains the box which C was to be tested or else a sub-box in which all roots must C lie. C (I/O) C C XPT This array is used to store a point approximation to C a root in X (Usually, this is the midpoint of X). C (I/O) C C DIAM is the diameter of the box stored in X. C (I/O) C C ERRFLG is the error type. FTESTH sets ERRFLG to 0 if there is no C error, but sets ERRFLG to another value if certain errors have C occurred. (See subroutine ERROUT for more detailed C information.) C (OUTPUT) C C ERRVAL contains the index of an error which has occurred. C (See subroutine ERROUT for more detailed information.) C (OUTPUT) C C UNKNWN Is set to .TRUE. to signal 'unknown' for the C root-inclusion test, and is set to .FALSE. if the C root-inclusion test is true or false. C (OUTPUT) C C SIGRT is set to .TRUE. if the root-inclusion test signals a C unique root, and is set to .FALSE. if the root-inclusion C test signals no root. (This flag is meaningful only if C UNKNWN = .FALSE.) C (OUTPUT) C C FUNC is the name of the routine to compute the interval values C of the function. (The system routine is POLFUN.) C (INPUT) C C JAC is the name of the routine to compute the interval values C of the Jacobian matrix. (The system routine is POLJAC.) C (INPUT) C C EPSBOX is the minimum allowable width (in the norm defined DIAMCP) of C an unresolved box. C (INPUT) C C EPSF is the range tolerance; if it is certain that each component C of the vector function has absolute value less than EPSF C within a box, then that box is signalled as containing a C root. C (INPUT) C C RETCON is the return condition from FTEST. Its values are as C follows. C C 0: The preconditioner matrix could not be computed. C C 1: The root-inclusion test was inconclusive. C C 2: The diameter of the box is less than the domain C tolerance EPS/16. C C 10: Each component of the function has absolute value less C than the range tolerance EPSF over the entire box. C C 11: The box contains a unique root. C C 20: Zero is not in the interval value of the function. C C 21: The image of the box under the interval Newton method C has null intersection with the box. C C (OUTPUT) C C NFCAL1 is the number of interval function calls made to possibly C determine that the zero vector is not in the range. C (I/O) C C NFCAL2 is the number of function calls made for the interval Newton C method. C (I/O) C C NJCALL is the number of interval and scalar Jacobian calls C (I/O) C C MAXDP is the maximum depth of the stack of boxes yet to be C considered. C (INPUT) C C DEPTH is the current depth of the stack of boxes yet to be examined. C (I/O) C C LEVEL is the current level in the binary search tree. C (I/O) C C STACK is temporary storage space for the stack of boxes yet to be C examined. C (I/O) C C STKLVL is an integer stack whose entries correspond to the entries in C STACK. In it is stored the level (in the binary tree C from bisection) at which the corresponding box in STACK C occurred. C (I/O) C C IP is set to the index of the coordinate PVSLCT has chosen to be C bisected. C (OUTPUT) C C DP is set to .TRUE. if the left box formed from bisection is to C be considered next, and is set to .FALSE. if the right box is C to be considered next. (The left box is that box formed by C replacing the right endpoint of the bisected interval by its C midpoint.) (This choice is made in PVSLCT.) C (OUTPUT) C C DPIVOT, IPIVOT, and TSTITR are for additional stack information C associated with boxes stored in STACK. Their entries C are indexed on the level in the binary tree instead of the C depth of the stack. C (I/O) C C LNDWRK is the length of the double precision work array. C (INPUT) C C DWORK is the double precision work array. C (I/O) C C LNIWRK is the length of the integer work array. C (INPUT) C C IWORK is the integer work array. C (I/O) C C LNLWRK is the length of the logical work array. C (INPUT) C C LWORK is the logical work array. C (I/O) C C*********************************************************************** C C Internal variable declarations -- C INTEGER NUMITR C C*********************************************************************** C C Internal variable descriptions -- C C NUMITR is the number of iterations of the interval Newton method. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- HNSNG, PVSLCT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER ISCLF, ISCLJC, IFINT, IJACIN, IYMAT INTEGER IWIV0, IWIV1, IWIV2, ITMPM1, ITMPM2 INTEGER IDEND, IIPVT, IIEND, ILWORK, ILEND INTEGER LUNKNW, UUNKNW, LTRUE, UTRUE, LFALSE, UFALSE C C*********************************************************************** C C INTERNAL CONSTANT DESCRIPTIONS -- C C ISCLF a pointer to the starting address of the scalar function C value in the double precision work array C C ISCLJC a pointer to the starting address of the scalar Jacobian C matrix value in the double precision work array C C IFINT a pointer to the starting address of the interval function C value in the double precision work array C C IJACIN a pointer to the starting address of the interval Jacobian C matrix value in the double precision work array. C C IYMAT a pointer to the starting address of the prescaling matrix C in the double precision work array C C IWIV0, IWIV1, and IWIV2 are pointers to starting addresses of work C arrays for interval N-vectors in the double precision work C array. C C ITMPM1 and ITMPM2 are pointers to starting addresses of work C arrays for intervan N by N matrices in the double precision C work arrays. C C IDEND a pointer to the last used location in the double C precision work array C C IIPVT a pointer to the starting address of an integer work C vector in the integer work array C C IIEND a pointer to the last used location in the integer work C array C C ILWORK a pointer to an address in the logical work array C (currently not used) C C ILEND a pointer to the last used location in the logical C work array C C LUNKNW the lower bound of RETCON for which the root inclusion test C returns 'unknown' (inconclusive about containing roots) C C UUNKNW the upper bound of RETCON for which the root inclusion test C returns 'unknown' (inconclusive about containing roots) C C LTRUE the lower bound of RETCON for which the root inclusion test C returns 'true' (box contains a unique root) C C UTRUE the upper bound of RETCON for which the root inclusion test C returns 'true' (box contains a unique root) C C LFALSE the lower bound of RETCON for which the root inclusion test C returns 'false' (box contains no roots) C C UFALSE the upper bound of RETCON for which the root inclusion test C returns 'false' (box contains no roots) C C*********************************************************************** C DATA LUNKNW,UUNKNW/0,2/,LTRUE,UTRUE/10,11/,LFALSE,UFALSE/20,21/ C C Beginning of executable statements -- C C Initialize pointers. C ISCLF = 1 ISCLJC = ISCLF + N IFINT = ISCLJC + N*N IJACIN = IFINT + 2*N IYMAT = IJACIN + 2*N*N IWIV0 = IYMAT + N*N IWIV1 = IWIV0 + 2*N IWIV2 = IWIV1 + 2*N ITMPM1 = IWIV2 + 2*N ITMPM2 = ITMPM1 + 2*N*N IDEND = ITMPM2 + 2*N*N - 1 C C Check sizes of workspace vectors. C IF (IDEND.GT.LNDWRK) THEN ERRFLG = 4 ERRVAL = IDEND GOTO 900 END IF C IIPVT = 1 IIEND = IIPVT + N - 1 IF (IIEND.GT.LNIWRK) THEN ERRFLG = 5 ERRVAL = IIEND GOTO 900 END IF C ILWORK = 1 ILEND = ILWORK - 1 IF (ILEND.GT.LNLWRK) THEN ERRFLG = 6 ERRVAL = ILEND GOTO 900 END IF C C Call the actual root inclusion test routine. C CALL HNSNG(N,X,XPT,DIAM,FUNC,JAC,ERRFLG,ERRVAL,EPSBOX,EPSF, 1 RETCON,NUMITR,NFCAL1,NFCAL2,NJCALL, 2 DWORK(ISCLF),DWORK(ISCLJC),DWORK(IFINT),DWORK(IJACIN), 3 DWORK(IYMAT),DWORK(IWIV0),DWORK(IWIV1), 4 DWORK(IWIV2),DWORK(ITMPM1),DWORK(ITMPM2),IWORK(IIPVT), 5 MAXDP,DEPTH,LEVEL,STACK,STKLVL,DPIVOT,IPIVOT,TSTITR) C IF (LEVEL.LE.MAXDP) TSTITR(LEVEL) = NUMITR IF (ERRFLG.NE.0) GOTO 900 C C Set the flags indicating the result of the root inclusion test C based on the value of RETCON. C IF ((RETCON.GE.LUNKNW).AND.(RETCON.LE.UUNKNW)) THEN UNKNWN = .TRUE. ELSE IF ((RETCON.GE.LFALSE).AND.(RETCON.LE.UFALSE)) THEN UNKNWN = .FALSE. SIGRT = .FALSE. ELSE IF ((RETCON.GE.LTRUE).AND.(RETCON.LE.UTRUE)) THEN UNKNWN = .FALSE. SIGRT = .TRUE. ELSE ERRFLG = 40 ERRVAL = RETCON RETURN END IF C C If the resultt was 'unknown' and the box was not smaller than C the domain tolerance, select a coordinate for bisection. C IF (UNKNWN.AND.(RETCON.NE.2)) THEN CALL PVSLCT(N,X,ERRFLG,ERRVAL,IP,DP,DWORK(IJACIN)) END IF C 900 CONTINUE RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE HNSNG(N,X,XPT,DIAM,FUNC,JAC,ERRFLG,ERRVAL, 1 EPSBOX,EPSF,RETCON,NUMITR,NFCAL1,NFCAL2, 2 NJCALL,SCLF,SCLJAC,FINT,JACINT,YMAT,WIV0, 3 WIV1,WIV2,TMPM1,TMPM2,IPVT, 4 MAXDP,DEPTH,LEVEL,STACK,STKLVL, 5 DPIVOT,IPIVOT,TSTITR) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package. C C*********************************************************************** C C Called by -- FTESTH C C*********************************************************************** C C Function -- C C This subroutine performs iterations of the interval Newton method. C In particular, this routine uses a version of the interval C Gauss-Seidel process, with extended interval arithmetic. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION X(2,N), XPT(N), DIAM INTEGER ERRFLG, ERRVAL DOUBLE PRECISION EPSBOX, EPSF INTEGER RETCON INTEGER NUMITR, NFCAL1, NFCAL2, NJCALL DOUBLE PRECISION SCLF(N), SCLJAC(N,N), FINT(2,N), JACINT(2,N,N) DOUBLE PRECISION YMAT(N,N), WIV0(2,N), WIV1(2,N), WIV2(2,N) DOUBLE PRECISION TMPM1(2,N,N), TMPM2(2,N,N) INTEGER IPVT(N) INTEGER MAXDP, DEPTH, LEVEL DOUBLE PRECISION STACK(2,N,MAXDP) INTEGER STKLVL(MAXDP) LOGICAL DPIVOT(MAXDP) INTEGER IPIVOT(MAXDP), TSTITR(MAXDP) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of variables and equations. C (INPUT) C C X On entry, this array contains the box to be tested for C roots. On exit, this array either contains the box which C was to be tested or else a sub-box in which all roots must C lie. C (I/O) C C XPT This array is used to store a point approximation to C a root in X (Usually, this is the midpoint of X). C (I/O) C C DIAM is the diameter of the box stored in X. C (I/O) C C FUNC is the name of the routine to compute the interval values C of the function. (The system routine is POLFUN.) C (INPUT) C C JAC is the name of the routine to compute the interval values C of the Jacobian matrix. (The system routine is POLJAC.) C (INPUT) C C ERRFLG is the error type. FTESTH sets ERRFLG to 0 if there is no C error, but sets ERRFLG to another value if certain errors have C occurred. (See subroutine ERROUT for more detailed C information.) C (OUTPUT) C C ERRVAL contains the index of an error which has occurred. C (See subroutine ERROUT for more detailed information.) C (OUTPUT) C C EPSBOX is the minimum allowable width (in the norm defined DIAMCP) of C an unresolved box. C (INPUT) C C EPSF is the range tolerance; if it is certain that each component C of the vector function has absolute value less than EPSF C within a box, then that box is signalled as containing a C root. C (INPUT) C C RETCON is the return condition from FTEST. Its values are as C follows. C C 0: The preconditioner matrix could not be computed. C C 1: The root-inclusion test was inconclusive. C C 2: The diameter of the box is less than the domain C tolerance EPS/16. C C 10: Each component of the function has absolute value less C than the range tolerance EPSF over the entire box. C C 11: The box contains a unique root. C C 20: Zero is not in the interval value of the function. C C 21: The image of the box under the interval Newton method C has null intersection with the box. C C (OUTPUT) C C NUMITR is the number of iterations of the interval Newton method. C (OUTPUT) C C NFCAL1 is the number of interval function calls made to possibly C determine that the zero vector is not in the range. C (I/O) C C NFCAL2 is the number of function calls made for the interval Newton C method. C (I/O) C C NJCALL is the number of interval and scalar Jacobian calls C (I/O) C (I/O) C C SCLF is the point function value at the point XPT. C (OUTPUT) C C SCLJAC is the point Jacobian matrix value at the point XPT. C (OUTPUT) C C FINT is the interval function value over the box X. C (OUTPUT) C C JACINT is the interval Jacobian matrix value over the box X. C (OUTPUT) C C YMAT is the N by N prescaling matrix. C (OUTPUT) C C WIV0, WIV1, and WIV2 are interval work vectors. C C TMPM1 and TMPM2 are N by N interval work matrices. C C IPVT is an integer work vector. C C MAXDP is the maximum depth of the stack of boxes yet to be C considered. C (INPUT) C C DEPTH is the current depth of the stack of boxes yet to be examined. C (I/O) C C LEVEL is the current level in the binary search tree. C (I/O) C C STACK is temporary storage space for the stack of boxes yet to be C examined. C (I/O) C C STKLVL is an integer stack whose entries correspond to the entries in C STACK. In it is stored the level (in the binary tree C from bisection) at which the corresponding box in STACK C occurred. C (I/O) C C DPIVOT, IPIVOT, and TSTITR are for additional stack information C associated with boxes stored in STACK. Their entries C correspond to entries in STACK. C (I/O) C C*********************************************************************** C C INTERNAL VARIABLE DECLARATIONS -- C C INTEGER I, J, K, INFO, LSTJAC DOUBLE PRECISION FMAX, TEMP1(2), TEMP2(2) DOUBLE PRECISION XM, VOLRAT, TT, T1, T2 LOGICAL CNTN, DIVFLG C C*********************************************************************** C C INTERNAL VARIABLE DESCRIPTIONS -- C C I, J, and K are loop indices. C C INFO is a return code from the LINPACK routine DGEFA. C C LSTJAC is the value of NUMITR at the time of the most recent C Jacobian matrix evaluation. C C FMAX is the maximum of the absolute values of the components of the C interval function value. C C TEMP1 and TEMP2 are temporary intervals. C C XM temporarily holds the midpoint of an interval. C C VOLRAT is the ratio of volume of the component intervals of X, after C application of the interval Newton method. C C TT, T1, and T2 are temporary storage. C C CNTN is set to .TRUE. if the image of X after application of the C interval Newton method is strictly contained in X, and is C set to .FALSE. otherwise. C C DIVFLG is set to .TRUE. if there was a division by an interval which C contained zero during the interval Gauss-Seidel step; it is C set to .FALSE. otherwise. C C*********************************************************************** C C Common block declarations -- C INTEGER ITRFLG, PIVFLG, JACFLG COMMON /CONFG1/ ITRFLG, PIVFLG, JACFLG C C /CONFG1/ passes control flags from the INPUT routine to C to PVSLCT and to this routine. These control flags C come from the configuration file, and are described C in INPUT. C DOUBLE PRECISION TOL1, TOL2, TOL3 COMMON /CONFG2/ TOL1, TOL2, TOL3 C C /CONFG2/ passes tolerances from INPUT to this routine and to C the routines CHKLST and DELLST. These tolerances C are described in INPUT with the configuration file. C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C ABS, MAX, and MIN C C*********************************************************************** C C Package-supplied functions and subroutines -- C C DIAMCP, DVSBIN C C From the interval arithmetic subpackage -- C C ADD, MULT, SCLADD, and SCLMLT C C From the stack management subpackage -- C C PUSH C C Function and jacobian evaluation -- C C FUNC (POLFUN), JAC (POLJAC) C C From LINPACK -- C C DGEFA, DGESL C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C LOGICAL LEFT, RIGHT INTEGER MAXITR C C*********************************************************************** C C Internal constant descriptions -- C C LEFT the logical value associated in this program with the C left box in a split (See DP above.) C C RIGHT the logical value associated in this program with the C right box in a split (See DP above.) C C MAXITR the maximum allowable number of iterations of the interval C Newton method C C*********************************************************************** C DATA LEFT/.TRUE./, RIGHT/.FALSE./ C C Only iterate the interval Newton method a maximum of 100 times. C DATA MAXITR/100/ C C Beginning of executable statements -- C NUMITR = 0 LSTJAC = 0 ERRFLG = 0 C C Compute the function value. C 5 CALL FUNC(N,X,XPT,FINT,SCLF) NFCAL1 = NFCAL1 + 1 C C Return .FALSE. for the root inclusion test if the interval value C of the function does not contain the zero vector. C DO 10 I = 1, N IF ((FINT(2,I).LT.0D0).OR.(FINT(1,I).GT.0D0)) THEN RETCON = 20 RETURN END IF 10 CONTINUE C C Return .TRUE. for the root inclusion test if each component of C the function is within the range tolerance of zero over the C entire box. C FMAX = 0D0 DO 20 I = 1, N FMAX = MAX(FMAX,ABS(FINT(1,I)),ABS(FINT(2,I))) 20 CONTINUE IF (FMAX.LT.EPSF) THEN RETCON = 10 RETURN END IF C C Compute the point and interval Jacobian matrix values. C CALL JAC(N,X,XPT,JACINT,SCLJAC) NJCALL = NJCALL + 1 LSTJAC = NUMITR C C Compute the prescaling matrix. C JACFLG not 1 : YMAT = inverse( SCLJAC ) C JACFLG = 1 : YMAT = transpose( inverse( transpose( SCLJAC ) ) ) C DO 110 I = 1, N DO 100 J = 1, N YMAT(J,I) = 0D0 100 CONTINUE YMAT(I,I) = 1D0 110 CONTINUE C IF (JACFLG.EQ.1 .AND. N.GT.1) THEN DO 115 I = 1,N-1 DO 115 J = I+1,N T1 = SCLJAC(I,J) SCLJAC(I,J) = SCLJAC(J,I) SCLJAC(J,I) = T1 115 CONTINUE END IF C CALL DGEFA(SCLJAC,N,N,IPVT,INFO) IF (INFO.NE.0) THEN RETCON = 0 RETURN END IF C DO 120 I = 1, N CALL DGESL(SCLJAC,N,N,IPVT,YMAT(1,I),0) 120 CONTINUE C IF (JACFLG.EQ.1 .AND. N.GT.1) THEN DO 130 I = 1, N-1 DO 130 J = I+1, N T1 = YMAT(I,J) YMAT(I,J) = YMAT(J,I) YMAT(J,I) = T1 130 CONTINUE END IF C C Form P (= Y F') and store in TMPM1. C DO 150 I = 1, N DO 150 J = 1, N TMPM1(1,I,J) = 0D0 TMPM1(2,I,J) = 0D0 DO 150 K = 1, N CALL SCLMLT(YMAT(I,K),JACINT(1,K,J),TEMP1) CALL ADD(TMPM1(1,I,J),TEMP1,TMPM1(1,I,J)) 150 CONTINUE C 160 CONTINUE C C Throughout, store X(*,I) - XPT(I) in WIV2(*,I). C DO 190 I = 1, N XM = -XPT(I) CALL SCLADD(XM,X(1,I),WIV2(1,I)) 190 CONTINUE C C Do a step of interval Gauss-Seidel (i.e. Hansen-Sengupta), and C store the result back in X. C -------------------------------------------------------------------- NUMITR = NUMITR + 1 CNTN = .TRUE. VOLRAT = 1D0 DIVFLG = .FALSE. C DO 200 I = 1, N IPVT(I) = I 200 CONTINUE C DO 230 I = 1, N WIV1(1,I) = XPT(I) WIV1(2,I) = XPT(I) 230 CONTINUE CALL FUNC(N,WIV1,XPT,FINT,SCLF) NFCAL2 = NFCAL2 + 1 C DO 280 K = 1, N C I = IPVT(K) C C Compute the numerator for the i-th phase of interval Gauss-Seidel. C WIV1(1,I) = 0D0 WIV1(2,I) = 0D0 DO 235 J = 1, N CALL SCLMLT(YMAT(I,J),FINT(1,J),TEMP1) CALL ADD(TEMP1,WIV1(1,I),WIV1(1,I)) 235 CONTINUE C DO 250 J = 1, N IF (J.EQ.I) GOTO 250 CALL MULT(TMPM1(1,I,J),WIV2(1,J),TEMP1) CALL ADD(WIV1(1,I),TEMP1,WIV1(1,I)) 250 CONTINUE C C Do the division, subtraction, and intersection in the interval C Gauss-Seidel. INFO will equal the number of resulting intervals C (0, 1, OR 2). The first (or only) interval will be returned in C WIV1(*,I). The second will be in TEMP1. C CALL DVSBIN(XPT(I),TMPM1(1,I,I),WIV1(1,I),X(1,I),INFO, 1 WIV1(1,I),TEMP1) C C Check for null intersection. C IF (INFO.EQ.0) THEN RETCON = 21 RETURN END IF C C Put a box on the stack if the interval Gauss-Seidel method gives C two boxes. C IF (INFO.EQ.2) THEN TEMP2(1) = X(1,I) TEMP2(2) = X(2,I) X(1,I) = TEMP1(1) X(2,I) = TEMP1(2) LEVEL = LEVEL + 1 CALL PUSH(N,X,MAXDP,DEPTH,LEVEL,STACK,STKLVL,ERRFLG,ERRVAL) X(1,I) = TEMP2(1) X(2,I) = TEMP2(2) IF (ERRFLG.NE.0) THEN LEVEL = LEVEL - 1 WIV1(1,I) = MIN(WIV1(1,I),TEMP1(1)) WIV1(2,I) = MAX(WIV1(2,I),TEMP1(2)) ERRFLG = 0 ELSE J = LEVEL - 1 DIVFLG = .TRUE. IF ((J.LE.MAXDP).AND.(J.GE.0)) THEN TSTITR(J) = NUMITR IPIVOT(J) = -I IF (TEMP1(2).LE.X(1,I)) THEN DPIVOT(J) = RIGHT ELSE DPIVOT(J) = LEFT END IF END IF END IF END IF C C Update flags for signalling .TRUE. in the root inclusion test. C IF ( (WIV1(1,I).LE.X(1,I)) .OR. 1 (WIV1(2,I).GE.X(2,I)) ) CNTN = .FALSE. C C Store the result in X(*,I). Also compute information about the C resulting change in volume. C TT = X(2,I) - X(1,I) T1 = WIV1(1,I) T2 = WIV1(2,I) X(1,I) = T1 X(2,I) = T2 C C Include coordinate in computing volume ratio if old width is C larger than the minimum box width. C IF (TT.GT.EPSBOX) THEN VOLRAT = VOLRAT * (T2 - T1) / TT END IF C C Store the new X(*,I) - XPT(I) in WIV2(I). C XM = - XPT(I) CALL SCLADD(XM,X(1,I),WIV2(1,I)) C 280 CONTINUE C ------------------------------------------------------------------- C End of code for the interval Gauss-Seidel method C C Compute the midpoint and the diameter of the resulting box. C DO 300 I = 1, N XPT(I) = (X(1,I) + X(2,I)) / 2D0 300 CONTINUE C CALL DIAMCP(N,X,DIAM) C C Return if the box contains a unique root. C IF (CNTN) THEN RETCON = 11 RETURN END IF C C If this point is reached, the root inclusion test signalled C 'unknown'; set the return-condition variable appropriately. C RETCON = 1 C C If the diameter of the box is less than the domain tolerance, C set the return condition and return to ROOTS. C IF (DIAM.LT.EPSBOX) THEN IF ((NUMITR-LSTJAC).GT.1) THEN GOTO 5 ELSE RETCON = 2 RETURN END IF END IF C C Return if the maximum number of iterations has been exceeded. C IF (NUMITR.GE.MAXITR) RETURN C C If the volume change was large, iterate the test with the same C interval Jacobian matrix. C IF ((VOLRAT.LE.TOL2).AND.(.NOT.DIVFLG)) THEN GOTO 160 END IF C C If the volume change was reasonable, recompute the interval C Jacobian matrix, then iterate the test. C IF ((VOLRAT.LE.TOL1).OR.((NUMITR-LSTJAC).GT.3)) THEN GOTO 5 END IF C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE NEWTON 1 (N,X,RJ,V,EPS,DELT,MAXIT,NITR,FUNC,JAC,IPVT,IERR) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- OUTPUT C C*********************************************************************** C C Function -- C C This routine performs the classical Newton's method in N variables C and equations. It is called to find accurate approximations to C root which the root-inclusion test indicated contained a unique C root. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION X(N), RJ(N,N), V(N) DOUBLE PRECISION EPS, DELT INTEGER MAXIT, NITR EXTERNAL FUNC, JAC INTEGER IPVT(N) INTEGER IERR C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of equations and variables. C (INPUT) C C X On entry, X contains the initial guess vector. On return, C X contains the more accurate approximation to the root. C (I/O) C C RJ is workspace for the N by N Jacobian matrix. C C V is a workspace vector. C C EPS is the range tolerance. Iteration ceases if the absolute C value of each residual is less than EPS. C (INPUT) C C DELT is the domain tolerance. Iteration ceases if, for each C coordinate, the absolute value of the difference between C successive iterations is less than DELT. C (INPUT) C C MAXIT is the maximum allowed number of iterations. C (INPUT) C C NITR is the actual number of iterations performed. C (OUTPUT) C C FUNC is the name of the external routine which evaluates the C function. ( SUBROUTINE FUNC(N,X,V) ) C (INPUT) C C C JAC is the name of the external routine which evaluates the C Jacobian matrix. ( SUBROUTINE JAC(N,X,RJ) ) C (INPUT) C C IPVT is an integer workspace vector. C C IERR IERR = 0 for normal termination. Nonzero IERR indicates C that the accuracy criteria defined by EPS and DELT may not C have been met. IERR = -1 means that the maximum number of C iterations has been exceeded. Other non-zero values of C IERR mean that the Gaussian elimination process failed. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C C C*********************************************************************** C C Internal variable descriptions -- C C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C FUNC (POLFSC) and JAC (POLJSC) C C DGEFA, DGESL, AND IDAMAX (from LINPACK) C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C IERR = 0 C CALL FUNC (N, X, V) C DO 20 NITR = 1, MAXIT C CALL JAC (N, N, X, RJ) CALL DGEFA (RJ, N, N, IPVT,IERR) IF (IERR.NE.0) RETURN CALL DGESL (RJ,N,N,IPVT,V,0) C TOL = ABS(V(IDAMAX(N,V,1))) IF (TOL.LT.DELT) RETURN C DO 10 J = 1,N X(J) = X(J) - V(J) 10 CONTINUE C CALL FUNC(N,X,V) TOL = ABS(V(IDAMAX(N,V,1))) IF (TOL.LT.EPS) RETURN C 20 CONTINUE C IERR = -1 RETURN C END C*********************************************************************** C*********************************************************************** SUBROUTINE POLFSC(N,X,VAL) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C PARAMETER (MN2 = 10) PARAMETER (MT = 30) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- NEWTON C C*********************************************************************** C C Function -- C C This routine computes a point value of the function, where the C function is a polynomial system of equations. The representation C of the system is identical to the 'tableau' form in Alexander Morgan, C Solving Polynomial Systems using Continuation for Engineering and C Scientific Problems, Prentice-Hall, Englewood Cliffs, NJ, 1987. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION X(N), VAL(N) * C C*********************************************************************** C C Argument descriptions -- C C N is the number of equations and variables. C (INPUT) C C X contains the vector at which the function is to be C evaluated. C (INPUT) C C VAL Upon return, VAL will contain vector function value at the C point X. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C INTEGER I, J, K C DOUBLE PRECISION SCLPRD C C*********************************************************************** C C Common block declarations -- C C MN2 denotes the maximum number of equations, and MT denotes C the maximum number of terms in any single equation. C INTEGER NUMT, KDEG COMMON/EQUAT/NUMT(MN2),KDEG(MN2,MN2,MT) C DOUBLE PRECISION A COMMON/COEFS/A(MN2,MT) C C /EQUAT/ passes exponents of variables from INPUT to C POLFUN, POLJAC, POLFSC, AND POLJSC. C C /COEFS/ passes coefficient values from INPUT to POLFUN, C POLFUN, POLJAC, POLFSC, AND POLJSC. C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C Internal constant declarations -- C DOUBLE PRECISION ZERO, ONE DATA ZERO /0.0D0/, ONE /1.0D0/ C C*********************************************************************** C C Beginning of executable statements -- C DO 30 I = 1,N VAL(I) = ZERO DO 20 J = 1,NUMT(I) SCLPRD = ONE DO 10 K = 1,N IF (KDEG(I,K,J) .NE. 0) THEN SCLPRD = SCLPRD * X(K)**KDEG(I,K,J) END IF 10 CONTINUE SCLPRD = A(I,J) * SCLPRD VAL(I) = VAL(I) + SCLPRD 20 CONTINUE 30 CONTINUE C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE POLFUN(N,X,SX,FVAL,SCALF) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C PARAMETER (MN2 = 10) PARAMETER (MT = 30) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- HNSNG and OUTPUT C C*********************************************************************** C C Function -- C C This routine computes the interval value of a function, where the C function is a polynomial system of equations. The representation C of the system is identical to the 'tableau' form in Alexander Morgan, C Solving Polynomial Systems using Continuation for Engineering and C Scientific Problems, Prentice-Hall, Englewood Cliffs, NJ, 1987. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION X(2,N), SX(N) DOUBLE PRECISION FVAL(2,N),SCALF(N) C C*********************************************************************** C C Argument descriptions -- C C N is the number of equations and variables. C (INPUT) C C X X(1,I) is the left endpoint of the I-th coordinate interval, C and X(2,I) is the right endpoint of the I-th coordinate C interval of the box, for I between 1 and N. C (INPUT) C C SX contains a point N-vector at which a point function value is C to be computed. C (INPUT) C C FVAL Upon return, ( FVAL(1,I), FVAL(2,I) ) will be an interval C which contains the range of the function over the box X. C (OUTPUT) C C SCALF Upon return, SCALF will contain an approximate vector function C value at the point SX. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C INTEGER I, J, K C DOUBLE PRECISION PROD(2), SCLPRD, T1(2) C C*********************************************************************** C C Common block declarations -- C C MN2 denotes the maximum number of equations, and MT denotes C the maximum number of terms in any single equation. C INTEGER NUMT, KDEG COMMON/EQUAT/NUMT(MN2),KDEG(MN2,MN2,MT) C DOUBLE PRECISION A COMMON/COEFS/A(MN2,MT) C C /EQUAT/ passes exponents of variables from INPUT to C POLFUN, POLJAC, POLFSC, AND POLJSC. C C /COEFS/ passes coefficient values from INPUT to POLFUN, C POLFUN, POLJAC, POLFSC, AND POLJSC. C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C From the interval arithmetic subpackage -- C C ADD, MULT, POWER, SCLMLT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C Internal constant declarations -- C DOUBLE PRECISION ZERO, ONE DATA ZERO /0.0D0/, ONE /1.0D0/ C C*********************************************************************** C C Beginning of executable statements -- C DO 30 I = 1,N FVAL(1,I) = ZERO FVAL(2,I) = ZERO SCALF(I) = ZERO DO 20 J = 1,NUMT(I) PROD(1) = ONE PROD(2) = ONE SCLPRD = ONE DO 10 K = 1,N IF (KDEG(I,K,J) .NE. 0) THEN CALL POWER (X(1,K),KDEG(I,K,J),T1) CALL MULT (T1,PROD,PROD) SCLPRD = SCLPRD * SX(K)**KDEG(I,K,J) END IF 10 CONTINUE CALL SCLMLT (A(I,J),PROD,PROD) SCLPRD = A(I,J) * SCLPRD CALL ADD (PROD,FVAL(1,I),FVAL(1,I)) SCALF(I) = SCALF(I) + SCLPRD 20 CONTINUE 30 CONTINUE C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE POLJAC(N,X,SX,VALJAC,SCLJAC) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C PARAMETER (MN2 = 10) PARAMETER (MT = 30) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- HNSNG C C C*********************************************************************** C C Function -- C C This routine computes the interval value of the Jacobian matrix of a C function, where the function is a polynomial system of equations. C The representation of the system is identical to the 'tableau' form C in Alexander Morgan, Solving Polynomial Systems using Continuation C for Engineering and Scientific Problems, Prentice-Hall, Englewood C Cliffs, NJ, 1987. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION X,SX,VALJAC,SCLJAC DIMENSION X(2,N),SX(N),VALJAC(2,N,N),SCLJAC(N,N) C C*********************************************************************** C C Argument descriptions -- C C N is the number of equations and variables. C (INPUT) C C X X(1,I) is the left endpoint of the I-th coordinate interval, C and X(2,I) is the right endpoint of the I-th coordinate C interval of the box, for I between 1 and N. C (INPUT) C C SX contains a point N-vector at which a point function value is C to be computed. C (INPUT) C C VALJAC Upon return, ( VALJAC(1,I,J), VALJAC(2,I,J) ) will be an C interval which contains the range of the entry in the I-th C row and J-th column of the Jacobian matrix over the box X. C (OUTPUT) C C SCLJAC Upon return, SCLJAC(I,J) will contain an approximation to C the entry in the I-th row and J-th column of the Jacobian C matrix evaluated at the point SX. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C INTEGER I, J, K, KDLM1, L C DOUBLE PRECISION PROD(2), T1(2) C C*********************************************************************** C C Common block declarations -- C C MN2 denotes the maximum number of equations, and MT denotes C the maximum number of terms in any single equation. C INTEGER NUMT, KDEG COMMON/EQUAT/NUMT(MN2),KDEG(MN2,MN2,MT) C DOUBLE PRECISION A COMMON/COEFS/A(MN2,MT) C C /EQUAT/ passes exponents of variables from INPUT to C POLFUN, POLJAC, POLFSC, AND POLJSC. C C /COEFS/ passes coefficient values from INPUT to POLFUN, C POLFUN, POLJAC, POLFSC, AND POLJSC. C C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C DBLE C C*********************************************************************** C C Package-supplied functions and subroutines -- C C From the interval arithmetic subpackage -- C C ADD, MULT, POWER, SCLMLT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C Internal constant declarations -- C DOUBLE PRECISION ZERO, ONE DATA ZERO /0.0D0/, ONE /1.0D0/ C C*********************************************************************** C C Beginning of executable statements -- C DO 40 I = 1,N DO 30 L = 1,N VALJAC(1,I,L) = ZERO VALJAC(2,I,L) = ZERO SCLJAC(I,L) = ZERO C DO 20 J=1,NUMT(I) IF (KDEG(I,L,J).NE.0) THEN PROD(1) = ONE PROD(2) = ONE SCLPRD = ONE DO 10 K = 1,N IF (K .NE. L) THEN IF (KDEG(I,K,J) .NE. 0) THEN CALL POWER (X(1,K),KDEG(I,K,J),T1) CALL MULT (T1,PROD,PROD) SCLPRD = SCLPRD * SX(K)**KDEG(I,K,J) END IF END IF 10 CONTINUE CALL SCLMLT (A(I,J),PROD,PROD) SCLPRD = A(I,J) * SCLPRD KDLM1 = KDEG(I,L,J) - 1 IF (KDLM1 .NE. 0) THEN CALL POWER (X(1,L),KDLM1,T1) CALL MULT(T1,PROD,PROD) SCLPRD = SX(L)**KDLM1 * SCLPRD T1(1) = DBLE ( KDEG(I,L,J) ) T1(2) = DBLE ( KDEG(I,L,J) ) CALL MULT(T1,PROD,PROD) SCLPRD = T1(1) * SCLPRD END IF CALL ADD(PROD,VALJAC(1,I,L),VALJAC(1,I,L)) SCLJAC(I,L) = SCLPRD + SCLJAC(I,L) END IF 20 CONTINUE C SCLJAC(I,L) = (VALJAC(1,I,L) + VALJAC(2,I,L))/2D0 30 CONTINUE 40 CONTINUE C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE POLJSC(N,LDJ,X,JACMAT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C PARAMETER (MN2 = 10) PARAMETER (MT = 30) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- HNSNG C C C*********************************************************************** C C Function -- C C This routine computes the entries of the Jacobian matrix of a C function, where the function is a polynomial system of equations. C The representation of the system is identical to the 'tableau' form C in Alexander Morgan, Solving Polynomial Systems using Continuation C for Engineering and Scientific Problems, Prentice-Hall, Englewood C Cliffs, NJ, 1987. C C*********************************************************************** C C Argument declarations -- C INTEGER N, LDJ DOUBLE PRECISION X,JACMAT DIMENSION X(N),JACMAT(LDJ,N) C C*********************************************************************** C C Argument descriptions -- C C N is the number of equations and variables. C (INPUT) C C LDJ is the leading dimension on JACMAT in the calling program. C C C X X is N-vector at which the Jacobian matrix is to ve evaluated. C (INPUT) C C JACMAT Upon return, JACMAT(I,J) will contain an approximation to C the entry in the I-th row and J-th column of the Jacobian C matrix evaluated at the point X. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C INTEGER I, J, K, KDLM1, L C DOUBLE PRECISION SCLPRD, T1 C C*********************************************************************** C C Common block declarations -- C C MN2 denotes the maximum number of equations, and MT denotes C the maximum number of terms in any single equation. C INTEGER NUMT, KDEG COMMON/EQUAT/NUMT(MN2),KDEG(MN2,MN2,MT) C DOUBLE PRECISION A COMMON/COEFS/A(MN2,MT) C C /EQUAT/ passes exponents of variables from INPUT to C POLFUN, POLJAC, POLFSC, AND POLJSC. C C /COEFS/ passes coefficient values from INPUT to POLFUN, C POLFUN, POLJAC, POLFSC, AND POLJSC. C C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C DBLE C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C Internal constant declarations -- C DOUBLE PRECISION ZERO, ONE DATA ZERO /0.0D0/, ONE /1.0D0/ C C*********************************************************************** C C Beginning of executable statements -- C DO 40 I = 1,N DO 30 L = 1,N JACMAT(I,L) = ZERO C DO 20 J=1,NUMT(I) IF (KDEG(I,L,J).NE.0) THEN SCLPRD = ONE DO 10 K = 1,N IF (K .NE. L) THEN IF (KDEG(I,K,J) .NE. 0) THEN SCLPRD = SCLPRD * X(K)**KDEG(I,K,J) END IF END IF 10 CONTINUE SCLPRD = A(I,J) * SCLPRD KDLM1 = KDEG(I,L,J) - 1 IF (KDLM1 .NE. 0) THEN SCLPRD = X(L)**KDLM1 * SCLPRD T1 = DBLE ( KDEG(I,L,J) ) SCLPRD = T1 * SCLPRD END IF JACMAT(I,L) = SCLPRD + JACMAT(I,L) END IF 20 CONTINUE 30 CONTINUE 40 CONTINUE C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE PVSLCT(N,X,ERRFLG,ERRVAL,IP,DP,JACINT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- FTESTH (The root inclusion test driver) C C*********************************************************************** C C Function -- C C This routine determines the index of the coordinate interval to C be bisected. It also picks which of the two resulting boxes (LEFT C or RIGHT) is to be considered nest. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION X(2,N) INTEGER ERRFLG, ERRVAL, IP LOGICAL DP DOUBLE PRECISION JACINT(2,N,N) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of variables and equations. C (INPUT) C C X ( X(1,I), X(2,I) ) is the I-th coordinate interval of C the current box. C (INPUT) C C ERRFLG is the error type. PVSLCT sets ERRFLG to 0 if there is no C error, but sets ERRFLG to another value if certain errors have C occurred. (See subroutine ERROUT for more detailed C information.) C (OUTPUT) C C ERRVAL contains the index of an error which has occurred. C (See subroutine ERROUT for more detailed information.) C (OUTPUT) C C IP is, on return, the index of the next coordinate interval to C be bisected. C (OUTPUT) C C DP indicates the half of the bisected box (LEFT or RIGHT) to be C the next current box. (The left box is that box formed by C replacing the right endpoint of the bisected interval by its C midpoint.) C (OUTPUT) C C JACINT contains the most recently computed interval Jacobian C matrix. Its entries contain the range over X of the C corresponding entries of the Jacobian matrix. C (INPUT) C C*********************************************************************** C C Internal variable declarations -- C INTEGER I, J DOUBLE PRECISION WIDTH, TWIDTH, TEMP, SMEAR, TSMEAR C C*********************************************************************** C C Internal variable descriptions -- C C I and J are loop variables. C C WIDTH, TWIDTH, TEMP, SMEAR, and TSMEAR are temporary storage. C C*********************************************************************** C C Common block declarations -- C INTEGER ITRFLG, PIVFLG, JACFLG COMMON /CONFG1/ ITRFLG, PIVFLG, JACFLG C C /CONFG1/ passes control flags from the INPUT routine to C to this routine and to the interval Newton method C routine HNSNG. These control flags come from C the configuration file, and are described therewith C in INPUT. C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C ABS, MAX C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C LOGICAL LEFT, RIGHT C C*********************************************************************** C C Internal constant descriptions -- C C LEFT the logical value associated in this program with the C left box formed from bisection. (See DP above.) C C RIGHT the logical value associated in this program with the C right box formed from bisection. (See DP above.) C C*********************************************************************** C DATA LEFT/.TRUE./, RIGHT/.FALSE./ C C Beginning of executable statements -- C C Initialize. C IP = 0 DP = LEFT C C PIVFLG = 0: Bisect in the widest coordinate interval. C IF (PIVFLG.EQ.0) THEN IP = 0 WIDTH = 0D0 DO 100 I = 1, N TWIDTH = X(2,I) - X(1,I) IF (TWIDTH.GT.WIDTH) THEN IP = I WIDTH = TWIDTH END IF 100 CONTINUE C C PIVFLG = 1: Bisect in the widest coordinate using the scaled C norm C ( B-A IF T <= 1 C width( (A,B) ) = ( C ( (B-A)/T IF T > 1 C C where T = MAX(ABS(A),ABS(B). C ELSE IF (PIVFLG.EQ.1) THEN IP = 0 WIDTH = 0D0 DO 200 I = 1, N TEMP = MAX(1D0,ABS(X(1,I)),ABS(X(2,I))) TWIDTH = (X(2,I) - X(1,I)) / TEMP IF (TWIDTH.GT.WIDTH) THEN IP = I WIDTH = TWIDTH END IF 200 CONTINUE C C PIVFLG = 2: use 'smear' scheme. C ELSE IF (PIVFLG.EQ.2) THEN IP = 0 SMEAR = 0D0 DO 310 I = 1, N TSMEAR = 0D0 DO 300 J = 1, N TSMEAR = MAX(TSMEAR,ABS(JACINT(1,J,I)), 1 ABS(JACINT(2,J,I))) 300 CONTINUE TSMEAR = TSMEAR * (X(2,I) - X(1,I)) IF (TSMEAR.GT.SMEAR) THEN IP = I SMEAR = TSMEAR END IF 310 CONTINUE C C If this point is reached an illegal value of PIVFLG was specified. C ELSE ERRFLG = 30 ERRVAL = PIVFLG RETURN END IF C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE XINFO(CURPTR,RADD,LEVEL,RDEL,TPTR,NLEAVE,MAXDP,MAXLST, 1 BXINFO,PINFO1,PINFO2,DPIVOT,IPIVOT,TSTITR) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C C*********************************************************************** C C Called by -- ROOTS C C*********************************************************************** C C Function -- C C This routine stores additional information about boxes in the linked C lists. C C*********************************************************************** C C Argument declarations -- C INTEGER CURPTR, RADD, LEVEL, RDEL, TPTR, NLEAVE, MAXDP, MAXLST INTEGER BXINFO(5,MAXLST) LOGICAL PINFO1(MAXDP,MAXLST) INTEGER PINFO2(2,MAXDP,MAXLST) LOGICAL DPIVOT(MAXDP) INTEGER IPIVOT(MAXDP), TSTITR(MAXDP) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C CURPTR is the index of the box in question in the list. (The C endpoints of its intervals are in BOXES(*,*,CURPTR). This C routine will store the additional information in the C CURPTR-th entry of the appropriate arrays. C (INPUT) C C RADD is the index for the reason the box was added to the list. C (It was determined to contain a unique root, the range C tolerance was met, etc.) C (INPUT) C C LEVEL is the level of the box in the binary search tree. C (INPUT) C C RDEL is the index for the reason the box was removed from the first C list and added to the second list, if this applies. C (INPUT) C C TPTR is the index of the box in the first list which has nonempty C intersection with the present box, provided there is such C a nonempty intersection. C (INPUT) C C NLEAVE is the number of boxes which have so far been resolved. C (INPUT) C C MAXDP is the maximum allowable depth of the stack of unresolved C boxes. C (INPUT) C C MAXLST MAXLST - 2 is the maximum number of root-containing boxes which C can be stored. C (INPUT) C C BXINFO holds the additional information about the boxes in the lists. C This routine stores the following. C C BXINFO(1,CURPTR) = reason box placed in the list C BXINFO(2,CURPTR) = level of box in binary tree C BXINFO(3,CURPTR) = reason box removed from first list C BXINFO(4,CURPTR) = index of intersecting box (if applicable) C BXINFO(5,CURPTR) = number of the resulved box. C (I/O) C C PINFO1 and PINFO2 hold information about which coordinate C intervals were bisected to obtain the boxes in the list. C (I/O) C C DPIVOT, IPIVOT, and TSTITR hold information about which coordinate C intervals were bisected to obtain the present box. This C routine stores these values in PINFO1 and PINFO2. C (INPUT) C C*********************************************************************** C C Internal variable declarations -- C INTEGER I C C*********************************************************************** C C Internal variable descriptions -- C C I is a loop index. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C MIN C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C BXINFO(1,CURPTR) = RADD BXINFO(2,CURPTR) = LEVEL BXINFO(3,CURPTR) = RDEL BXINFO(4,CURPTR) = TPTR BXINFO(5,CURPTR) = NLEAVE + 1 DO 10 I = 1, MIN(LEVEL - 1,MAXDP) PINFO1(I,CURPTR) = DPIVOT(I) PINFO2(1,I,CURPTR) = IPIVOT(I) PINFO2(2,I,CURPTR) = TSTITR(I) 10 CONTINUE IF (LEVEL.LE.MAXDP) THEN PINFO2(1,LEVEL,CURPTR) = 0 PINFO2(2,LEVEL,CURPTR) = TSTITR(LEVEL) END IF RETURN END SUBROUTINE ADD (A,B,RESULT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage). C C*********************************************************************** C C Called by -- C C any routine requiring interval addition. C C*********************************************************************** C C Function -- C C This routine adds the interval A and the interval A. It C simulates directed roundings with the routine RNDOUT; the interval C result should contain the interval which would have been obtained C with exact interval arithmetic. However, in general it will not C be the smallest possible machine-representable such containing C interval. See the documentation in subroutine RNDOUT for more C detailed information. C C*********************************************************************** C C Argument declarations -- C DOUBLE PRECISION A(2), B(2), RESULT(2) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C A is the first operand to the addition. C (INPUT) C C B is the second operand to the addition. C (INPUT) C C RESULT is the interval-arithmetic sum of A and B. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C LOGICAL RNDDWN, RNDUP C C*********************************************************************** C C Internal variable descriptions -- C C RNDDWN is set to .TRUE. if RNDOUT has to round down, and is set C to .FALSE. otherwise. C C RNDUP is set to .TRUE. if RNDOUT has to round up, and is set C to .FALSE. otherwise. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C RNDOUT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C RNDDWN = (A(1).NE.0D0).AND.(B(1).NE.0D0) RNDUP = (A(2).NE.0D0).AND.(B(2).NE.0D0) C RESULT(1) = A(1) + B(1) RESULT(2) = A(2) + B(2) C CALL RNDOUT(RESULT,RNDDWN,RNDUP) C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE MULT(A,B,RESULT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage). C C*********************************************************************** C C Called by -- C C Any routine requiring interval multiplication. C C*********************************************************************** C C Function -- C C This routine multiplies the interval A and the interval B. It C simulates directed roundings with the routine RNDOUT; the interval C result should contain the interval which would have been obtained C with exact interval arithmetic. However, in general it will not C be the smallest possible machine-representable such containing C interval. See the documentation in subroutine RNDOUT for more C detailed information. C C*********************************************************************** C C Argument declarations -- C DOUBLE PRECISION A(2), B(2), RESULT(2) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C A is the first operand to the multiplication. C (INPUT) C C B is the second operand to the multiplication. C (INPUT) C C RESULT is the interval-arithmetic sum of A and B. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C DOUBLE PRECISION R1, R2, T1(2), T2(2) C C*********************************************************************** C C Internal variable descriptions -- C C RNDDWN is set to .TRUE. if RNDOUT has to round down, and is set C to .FALSE. otherwise. C C RNDUP is set to .TRUE. if RNDOUT has to round up, and is set C to .FALSE. otherwise. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C MAX, MIN C C*********************************************************************** C C Package-supplied functions and subroutines -- C C SCLMLT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C R1 = A(1) R2 = A(2) T1(1) = B(1) T1(2) = B(2) C CALL SCLMLT(R1,T1,T2) CALL SCLMLT(R2,T1,T1) RESULT(1) = MIN(T1(1),T2(1)) RESULT(2) = MAX(T1(2),T2(2)) C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE POWER(A,N,RESULT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage). C C*********************************************************************** C C Called by -- C C Any routine requiring computation of a positive integer power of C an interval. C C*********************************************************************** C C Function -- C C This routine computes the N-th power, of the interval A, C where N is a nonnegative integer. It simulates directed C roundings with the routine RNDOUT; the interval result C should contain the interval which would have been obtained C with exact interval arithmetic. However, in general it will not C be the smallest possible machine-representable such containing C interval. See the documentation in subroutine RNDOUT for more C detailed information. C C*********************************************************************** C C Argument declarations -- C DOUBLE PRECISION A(2), RESULT(2) INTEGER N C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C A is the base (an interval). C (INPUT) C C N is the power (a nonnegative integer). C (INPUT) C C RESULT is the interval-arithmetic value of A ** N. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C DOUBLE PRECISION B(2) INTEGER M LOGICAL RNDDWN, RNDUP C C*********************************************************************** C C Internal variable descriptions -- C C B is a temporary interval value. C C RNDDWN is set to .TRUE. if RNDOUT has to round down, and is set C to .FALSE. otherwise. C C RNDUP is set to .TRUE. if RNDOUT has to round up, and is set C to .FALSE. otherwise. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C ABS, MAX, MOD C C*********************************************************************** C C Package-supplied functions and subroutines -- C C MULT, RNDOUT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C C C If N is less than or equal to 0 then return the point interval C [ 1 , 1 ]. C IF (N.LE.0) THEN RESULT(1) = 1D0 RESULT(2) = 1D0 RETURN END IF C C If N = 1 then return A. C IF (N.EQ.1) THEN RESULT(1) = A(1) RESULT(2) = A(2) RETURN END IF C C Let M be the largest even integer less than or equal to N, C and set B = A ** M. This is to take advantage of the fact that C an interval to an even power must have a left endpoint which C is greater than or equal to zero. C M = N IF (MOD(N,2).EQ.1) M = M - 1 C RNDDWN = .TRUE. RNDUP = .TRUE. IF (A(1).GT.0D0) THEN B(1) = A(1)**M B(2) = A(2)**M ELSE IF (A(2).LT.0) THEN B(1) = A(2)**M B(2) = A(1)**M ELSE B(1) = 0D0 RNDDWN = .FALSE. B(2) = MAX(ABS(A(1)),ABS(A(2)))**M END IF END IF CALL RNDOUT(B,RNDDWN,RNDUP) C C If N is even, then the result is B; otherwise, it is B * A. C IF (M.EQ.N) THEN RESULT(1) = B(1) RESULT(2) = B(2) ELSE CALL MULT(A,B,RESULT) END IF C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE RNDOUT(X,RNDDWN,RNDUP) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage) C C*********************************************************************** C C Called by -- ADD, SUB, POWER, SCLMLT, SCLADD, XDIV, XSCLSB C C*********************************************************************** C C Function -- C C This routine is intended to simulate directed roundings in a C reasonably transportable way. It is called for each elementary C operation involving intervals. The endpoints of the result interval C are first computed with the machine's usual floating point C arithmetic. C C If RNDDWN = .TRUE., then this routine decreases the left C endpoint of that approximate result by the absolute value of C that endpoint times a rigorous estimate for the maximum relative C error in an elementary operation. C C If RNDUP = .TRUE., then this routine increases the right C endpoint of that approximate result by the absolute value of C that endpoint times a rigorous estimate for the maximum relative C error in an elementary operation. C C For this routine to work properly, a machine-dependent parameter C must be installed in the routine SIMINI. See the documentation in C that routine for details. C C*********************************************************************** C C Argument declarations -- C DOUBLE PRECISION X(2) LOGICAL RNDDWN, RNDUP C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C X is the interval to be adjusted. C (I/O) C C RNDDWN is set to .TRUE. if the left endpoint is to be adjusted, and C is set to .FALSE. otherwise. C (INPUT) C C RNDUP is set to .TRUE. if the right endpoint is to be adjusted, C and is set to .FALSE. otherwise. C (INPUT) C C*********************************************************************** C C Internal variable declarations -- none C C*********************************************************************** C C Common block declarations -- C DOUBLE PRECISION MXULP, TTINY2, TOL0 COMMON /MACH1/ MXULP, TTINY2, TOL0 C C This common block holds machine parameters which are set in C SIMINI and used here. C C Variable descriptions C C MXULP (machine epsilon) C * (maximum error in ULP's of the floating pt. op's) C C TTINY2 2 * (smallest representable positive machine number) C * (maximum error in ULP's of the floating pt. op's) C C TOL0 TTINY2 / MXULP C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C IF (RNDDWN) THEN IF (X(1).GE.TOL0) THEN X(1) = X(1) - MXULP * X(1) ELSE IF (X(1).LE.-TOL0) THEN X(1) = X(1) + MXULP * X(1) ELSE IF ((X(1).GE.TTINY2).OR.(X(1).LE.0D0)) THEN X(1) = X(1) - TTINY2 ELSE X(1) = 0D0 END IF END IF C IF (RNDUP) THEN IF (X(2).GE.TOL0) THEN X(2) = X(2) + MXULP * X(2) ELSE IF (X(2).LE.-TOL0) THEN X(2) = X(2) - MXULP * X(2) ELSE IF ((X(2).LE.-TTINY2).OR.(X(2).GE.0D0)) THEN X(2) = X(2) + TTINY2 ELSE X(2) = 0D0 END IF END IF C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE SCLADD (R,A,RESULT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage). C C*********************************************************************** C C Called by -- C C Any routine requiring addition of a point value to an interval. C C*********************************************************************** C C FUNCTION -- C C This routine adds the interval A to the point R. It simulates C directed roundings with the routine RNDOUT; the interval C result should contain the interval which would have been obtained C with exact interval arithmetic. However, in general it will not C be the smallest possible machine-representable such containing C interval. See the documentation in subroutine RNDOUT for more C detailed information. C C*********************************************************************** C C Argument declarations -- C DOUBLE PRECISION R, A(2), RESULT(2) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C R is the point to be added to the interval. C (INPUT) C C A is the interval to be added to the point. C (INPUT) C C RESULT is the interval-arithmetic sum of R and B. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C LOGICAL RNDDWN, RNDUP C C*********************************************************************** C C Internal variable descriptions -- C C RNDDWN is set to .TRUE. if RNDOUT has to round down, and is set C to .FALSE. otherwise. C C RNDUP is set to .TRUE. if RNDOUT has to round up, and is set C to .FALSE. otherwise. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C RNDOUT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C RNDDWN = (R.NE.0D0).AND.(A(1).NE.0D0) RNDUP = (R.NE.0D0).AND.(A(2).NE.0D0) C RESULT(1) = R + A(1) RESULT(2) = R + A(2) C CALL RNDOUT(RESULT,RNDDWN,RNDUP) C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE SCLMLT (R,A,RESULT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage). C C*********************************************************************** C C Called by -- C C Any routine requiring multiplication of an interval and a point C value. C C*********************************************************************** C C Function -- C C This routine multiplies the interval A and the point R. It C simulates directed roundings with the routine RNDOUT; the interval C result should contain the interval which would have been obtained C with exact interval arithmetic. However, in general it will not C be the smallest possible machine-representable such containing C interval. See the documentation in subroutine RNDOUT for more C detailed information. C C*********************************************************************** C C Argument declarations -- C DOUBLE PRECISION R, A(2), RESULT(2) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C R is the point to be multiplied to the interval. C (INPUT) C C A is the interval to be multiplied to the point. C (INPUT) C C RESULT is the interval-arithmetic product R * B. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C LOGICAL RNDDWN, RNDUP DOUBLE PRECISION T1, T2 C C*********************************************************************** C C Internal variable descriptions -- C C RNDDWN is set to .TRUE. if RNDOUT is to round down, and is set C to .FALSE. otherwise. C C RNDUP is set to .TRUE. if RNDOUT is to round up, and is set C to .FALSE. otherwise. C C T1 and T2 are temporary variables. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C MAX, MIN C C*********************************************************************** C C Package-supplied functions and subroutines -- C C RNDOUT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C IF ((R.EQ.0D0).OR.((A(1).EQ.0D0).AND.(A(2).EQ.0D0))) THEN RESULT(1) = 0D0 RESULT(2) = 0D0 RETURN END IF C T1 = A(1) T2 = A(2) RNDDWN = .TRUE. RNDUP = .TRUE. C IF (T1.EQ.0D0) THEN IF (R.LT.0D0) THEN RESULT(1) = R * T2 RESULT(2) = 0D0 RNDUP = .FALSE. ELSE RESULT(1) = 0D0 RESULT(2) = R * T2 RNDDWN = .FALSE. END IF ELSE IF (T2.EQ.0D0) THEN IF (R.LT.0D0) THEN RESULT(1) = 0D0 RESULT(2) = R * T1 RNDDWN = .FALSE. ELSE RESULT(1) = R * T1 RESULT(2) = 0D0 RNDUP = .FALSE. END IF ELSE T1 = R * T1 T2 = R * T2 RESULT(1) = MIN(T1,T2) RESULT(2) = MAX(T1,T2) END IF END IF C CALL RNDOUT(RESULT,RNDDWN,RNDUP) C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE SIMINI C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage) C C*********************************************************************** C C Called by -- GENBIS C C*********************************************************************** C C Function -- C C This routine sets certain machine parameters used to simulate C directed roundings in a reasonably transportable way. In C particular, it sets the amount by which to decrease the left endpoint C and increase the right endpoint of an interval computed using usual C floating point arithmetic to guarantee that the resulting interval C will contain the result which would have been obtained with true C interval arithmetic. C C This routine assumes that the four elementary floating point C operations and taking an integer power will give results with a C maximum error of one ULP (unit in the last place). If this is not C so, change the value of MAXERR in the data statement below to the C maximum number of ULP's by which a floating point result can differ C from the true result (for '+', '-', '*', '/', and '** N'). C C When determining the maximum error of the result A op B, where C A and B are floating point numbers, we assume that A and B are C represented exactly. For example, if A and B are almost equal, C then it is not unreasonable to assume that A - B, where the C subtraction is a floating point subtraction, is within a few C units of the last place of the true result. C C If SIMINI is installed correctly, then the conclusions this C package prints out will have mathematical rigor. C C*********************************************************************** C C Common block declarations -- C DOUBLE PRECISION MXULP, TTINY2, TOL0 COMMON /MACH1/ MXULP, TTINY2, TOL0 C C This common block holds machine parameters which are set here C and used in RNDOUT. C C Variable descriptions C C MXULP (machine epsilon) C * (maximum error in ULP's of the floating pt. op's) C C TTINY2 2 * (smallest representable positive machine number) C * (maximum error in ULP's of the floating pt. op's) C C TOL0 TTINY2 / MXULP C C*********************************************************************** C C Fortran-supplied functions and subroutines -- DBLE C C*********************************************************************** C C Package-supplied functions and subroutines -- C C D1MACH (the SLATEC routine for machine constants) C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER MAXERR DATA MAXERR/1/ C C*********************************************************************** C C Internal constant descriptions -- C C MAXERR is the maximum number of ULP's (units in the last C place) by which a result of one of the floating point C operations (+, -, *, /, ** N) can differ from the C true result. (See explanation above.) C C********** WARNING: The value of MAXERR is machine dependent and C must be manually set. C C*********************************************************************** C C Beginning of executable statements -- C MXULP = DBLE(MAXERR) * D1MACH(4) TTINY2 = 2D0 * DBLE(MAXERR) * D1MACH(1) TOL0 = TTINY2 / MXULP C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE SUB (A,B,RESULT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage). C C*********************************************************************** C C Called by -- C C Any routine requiring interval subtraction. C C*********************************************************************** C C Function -- C C This routine subtracts the interval B from the interval A. It C simulates directed roundings with the routine RNDOUT; the interval C result should contain the interval which would have been obtained C with exact interval arithmetic. However, in general it will not C be the smallest possible machine-representable such containing C interval. See the documentation in subroutine RNDOUT for more C detailed information. C C*********************************************************************** C C Argument declarations -- C DOUBLE PRECISION A(2), B(2), RESULT(2) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C A is the first operand to the subtraction. C (INPUT) C C B is the second operand to the subtraction C (INPUT) C C RESULT is the interval-arithmetic value of A - B. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C DOUBLE PRECISION TA1, TA2, TB1, TB2 LOGICAL RNDDWN, RNDUP C C*********************************************************************** C C Internal variable descriptions -- C C TA1, TA2, TB1, and TB2 are temporaries. C C RNDDWN is set to .TRUE. if RNDOUT has to round down, and is set C to .FALSE. otherwise. C C RNDUP is set to .TRUE. if RNDOUT has to round up, and is set C to .FALSE. otherwise. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C RNDOUT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C TA1 = A(1) TA2 = A(2) TB1 = B(1) TB2 = B(2) C RNDDWN = (TB2.NE.0D0) RNDUP = (TB1.NE.0D0) C RESULT(1) = TA1 - TB2 RESULT(2) = TA2 - TB1 C CALL RNDOUT(RESULT,RNDDWN,RNDUP) C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE XDIV (XCASE,A,B,R1,R2) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage). C C*********************************************************************** C C Called by -- DVSBIN C C*********************************************************************** C C Function -- C C This routine performs the extended interval arithmetic division C A / B, and places the result(s) in R1 (and R2). The value of C XCASE is set according to whether the result is one finite C interval, one or two semi-infinite intervals, or the real line. C This routine does not use directed roundings, but the true interval C result should be contained in the returned interval(s) because the C routine RNDOUT widens the floating point intervals slightly. C This scheme does not in general produce the smallest machine C representable intervals containing the result, but is reasonably C portable. For more detailed information, see the documentation in C the routine RNDOUT. C C*********************************************************************** C C Argument declarations -- C INTEGER XCASE DOUBLE PRECISION A(2), B(2), R1(2), R2(2) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C XCASE is set to C C (1) if the result is a single finite interval C (stored in R1); C C (2) if the result is a single semi-infinite interval C (stored in R1) of the form C [ finite , + infinity ]; C C (3) if the result is a single semi-infinite interval C (stored in R1) of the form C [ - infinity , finite ]; C C (4) if the result is the real line; C C (5) if the result is a union of two semi-infinite C intervals R1 = [ - infinity, finite ] and C R2 = [ finite, + infinity ]. C C (OUTPUT) C C A is the numerator of the quotient. C (INPUT) C C B is the denominator of the quotient. C (INPUT) C C R1 is the interval quotient (or one element of it, when it C consists of more than one semi-infinite interval). C (OUTPUT) C C R2 is the second element of the interval quotient if it is C a union of two semi-infinite intervals. C (OUTPUT) C C When R1 or R2 contains semi-infinite intervals, C only the finite endpoints are stored. C C*********************************************************************** C C Internal variable declarations -- C DOUBLE PRECISION C(2) LOGICAL RNDDWN, RNDUP C C*********************************************************************** C C Internal variable descriptions -- C C C is a temporary interval. C C RNDDWN is set to .TRUE. if RNDOUT has to round down, and is set C to .FALSE. otherwise. C C RNDUP is set to .TRUE. if RNDOUT has to round up, and is set C to .FALSE. otherwise. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C MULT, RNDOUT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C RNDDWN = .TRUE. RNDUP = .TRUE. C C Do usual interval division if zero is not in the denominator. C IF ((B(1).GT.0D0).OR.(B(2).LT.0D0)) THEN XCASE = 1 C(1) = 1D0/B(2) C(2) = 1D0/B(1) C CALL RNDOUT(C,RNDDWN,RNDUP) C CALL MULT(A,C,R1) RETURN END IF C C If the denominator is equal to zero or if the numerator contains C zero, then set the result to the real line. C IF ((B(1).EQ.B(2)).OR.((A(1).LT.0D0).AND.(A(2).GT.0D0))) THEN XCASE = 4 RETURN END IF C C This is the case when the left endpoint of the denominator is zero. C IF (B(1).EQ.0D0) THEN IF (A(1).GE.0D0) THEN XCASE = 2 RNDDWN = (A(1).NE.0D0) RNDUP = .FALSE. R1(1) = A(1) / B(2) CALL RNDOUT(R1,RNDDWN,RNDUP) RETURN ELSE XCASE = 3 RNDUP = (A(2).NE.0D0) RNDDWN = .FALSE. R1(2) = A(2) / B(2) CALL RNDOUT(R1,RNDDWN,RNDUP) RETURN END IF END IF C C This is the case when the right endpoint of the denominator is zero. C IF (B(2).EQ.0D0) THEN IF (A(2).LE.0D0) THEN XCASE = 2 RNDDWN = (A(2).NE.0D0) RNDUP = .FALSE. R1(1) = A(2) / B(1) CALL RNDOUT(R1,RNDDWN,RNDUP) RETURN ELSE XCASE = 3 RNDUP = (A(1).NE.0D0) RNDDWN = .FALSE. R1(2) = A(1) / B(1) CALL RNDOUT(R1,RNDDWN,RNDUP) RETURN END IF END IF C C This is the case when the denominator contains zero but the C numerator does not. The result is a union of two semi-infinite C intervals. C IF (A(1).GE.0D0) THEN RNDUP = (A(1).NE.0D0) C(2) = A(1) / B(1) RNDDWN = RNDUP C(1) = A(1) / B(2) ELSE RNDUP = (A(2).NE.0D0) C(2) = A(2) / B(2) RNDDWN = RNDUP C(1) = A(2) / B(1) END IF IF (C(1).GT.C(2)) THEN XCASE = 5 R1(2) = C(2) R2(1) = C(1) ELSE XCASE = 4 END IF CALL RNDOUT(R2,RNDDWN,RNDUP) C CALL RNDOUT(R1,RNDDWN,RNDUP) RETURN C END C*********************************************************************** C*********************************************************************** SUBROUTINE XINT(CASE,A,B,RESULT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage). C C*********************************************************************** C C Called by -- DVSBIN C C*********************************************************************** C C Function -- C C This routine intersects a finite interval A with an extended-value C interval B whose type is given by CASE. It places the resulting C interval in RESULT, if it is not null; the routine resets the C variable CASE to indicate the type of RESULT. C C All intervals are represented by 2-vectors. C C*********************************************************************** C C Argument declarations -- C INTEGER CASE DOUBLE PRECISION A(2), B(2), RESULT(2) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C CASE indicates the type of A on entry, and the type of C RESULT on return. It is set to C C (0) if the quantity is the empty interval; C C (1) if the quantity is a single finite interval; C C (2) if the quantity is a single semi-infinite interval C of the form [finite, +infinity]; C C (3) if the quantity is a single semi-infinite interval C of the form [ - infinity , finite ]; C C (4) if the quantity is the real line. C C (I/O) C C A is a finite interval. C (INPUT) C C B is an extended-value interval (possibly infinite or C semi-infinite) whose type on entry is given by CASE. C (INPUT) C C RESULT is set to the intersection of A and B on return, if C that intersection is not null. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- none C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- C C MAX, MIN C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C C Finite case C IF (CASE.EQ.1) THEN IF ((A(2).LT.B(1)).OR.(A(1).GT.B(2))) THEN CASE = 0 RETURN ELSE RESULT(1) = MAX(A(1),B(1)) RESULT(2) = MIN(A(2),B(2)) RETURN END IF END IF C C Semi-infinite case C IF (CASE.EQ.2) THEN IF (A(2).LT.B(1)) THEN CASE = 0 RETURN ELSE CASE = 1 RESULT(1) = MAX(A(1),B(1)) RESULT(2) = A(2) RETURN END IF END IF C IF (CASE.EQ.3) THEN IF (A(1).GT.B(2)) THEN CASE = 0 RETURN ELSE CASE = 1 RESULT(1) = A(1) RESULT(2) = MIN(A(2),B(2)) RETURN END IF END IF C C Infinite case C IF (CASE.EQ.4) THEN CASE = 1 RESULT(1) = A(1) RESULT(2) = A(2) RETURN END IF C END C*********************************************************************** C*********************************************************************** SUBROUTINE XSCLSB(XCASE,R,A,RESULT) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (interval arithmetic subpackage). C C*********************************************************************** C C Called by -- DVSBIN C C*********************************************************************** C C Function -- C C This routine subtracts an extended-value interval A, whose type C is indicated by XCASE, from a point R. The result is an extended- C value interval RESULT, whose type is stored in XCASE. C This routine does not use directed roundings, but the true interval C result should be contained in the returned interval(s) because the C routine RNDOUT widens the floating point intervals slightly. C This scheme does not in general produce the smallest machine C representable intervals containing the result, but is reasonably C portable. For more detailed information, see the documentation in C the routine RNDOUT. C C*********************************************************************** C C Argument declarations -- C INTEGER XCASE DOUBLE PRECISION R, A(2), RESULT(2) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C XCASE indicates the type of A on entry, and the type of C RESULT on return. It is set to C C (1) if the quantity is a single finite interval; C C (2) if the quantity is a single semi-infinite interval C of the form [finite, +infinity]; C C (3) if the quantity is a single semi-infinite interval C of the form [ - infinity , finite ]; C C (4) if the quantity is the real line; C C (I/O) C C R is the point from which the interval is subtracted. C (INPUT) C C A is the extended-value interval to be subtracted. C On entry, its type is given by XCASE. C (INPUT) C C RESULT is the extended-value interval result R - A. C On return, its type is given by XCASE. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- C DOUBLE PRECISION T1, T2 LOGICAL RNDDWN, RNDUP C C*********************************************************************** C C Internal variable descriptions -- C C T1, and T2 are temporary storage. C C RNDDWN is set to .TRUE. if RNDOUT has to round down, and is set C to .FALSE. otherwise. C C RNDUP is set to .TRUE. if RNDOUT has to round up, and is set C to .FALSE. otherwise. C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C RNDOUT C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- none C C*********************************************************************** C C Beginning of executable statements -- C T1 = A(1) T2 = A(2) RNDDWN = (T2.NE.0D0) RNDUP = (T1.NE.0D0) C C FINITE CASE C IF (XCASE.EQ.1) THEN RESULT(1) = R - T2 RESULT(2) = R - T1 CALL RNDOUT(RESULT,RNDDWN,RNDUP) RETURN END IF C C The semi-infinite cases follow. C IF (XCASE.EQ.2) THEN XCASE = 3 RESULT(2) = R - T1 CALL RNDOUT(RESULT,.FALSE.,RNDUP) RETURN END IF IF (XCASE.EQ.3) THEN XCASE = 2 RESULT(1) = R - T2 CALL RNDOUT(RESULT,RNDDWN,.FALSE.) RETURN END IF C C If we get this far, then the interval is the real line, and C hence so is the result. We therefore return without changing XCASE. C RETURN END Caveat receptor. (Jack) dongarra@anl-mcs, (Eric Grosse) research!ehg Compliments of netlib Wed Mar 11 09:10:56 CST 1987 DOUBLE PRECISION FUNCTION D1MACH(I) C C DOUBLE-PRECISION MACHINE CONSTANTS C C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. C C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. C C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING. C C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. C C D1MACH( 5) = LOG10(B) C C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY C REMOVING THE C FROM COLUMN 1. C ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. C (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) C C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), ONE OF THE FIRST C TWO SETS OF CONSTANTS BELOW SHOULD BE APPROPRIATE. C C WHERE POSSIBLE, OCTAL OR HEXADECIMAL CONSTANTS HAVE BEEN USED C TO SPECIFY THE CONSTANTS EXACTLY, WHICH HAS IN SOME CASES C REQUIRED THE USE OF EQUIVALENT INTEGER ARRAYS. C INTEGER SMALL(4) INTEGER LARGE(4) INTEGER RIGHT(4) INTEGER DIVER(4) INTEGER LOG10(4) C DOUBLE PRECISION DMACH(5) C EQUIVALENCE (DMACH(1),SMALL(1)) EQUIVALENCE (DMACH(2),LARGE(1)) EQUIVALENCE (DMACH(3),RIGHT(1)) EQUIVALENCE (DMACH(4),DIVER(1)) EQUIVALENCE (DMACH(5),LOG10(1)) C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T C 3B SERIES AND MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T C PC 7300), IN WHICH THE MOST SIGNIFICANT BYTE IS STORED FIRST. C C DATA SMALL(1),SMALL(2) / 1048576, 0 / C DATA LARGE(1),LARGE(2) / 2146435071, -1 / C DATA RIGHT(1),RIGHT(2) / 1017118720, 0 / C DATA DIVER(1),DIVER(2) / 1018167296, 0 / C DATA LOG10(1),LOG10(2) / 1070810131, 1352628735 / C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES AND 8087-BASED C MICROS, SUCH AS THE IBM PC AND AT&T 6300, IN WHICH THE LEAST C SIGNIFICANT BYTE IS STORED FIRST. C C DATA SMALL(1),SMALL(2) / 0, 1048576 / C DATA LARGE(1),LARGE(2) / -1, 2146435071 / C DATA RIGHT(1),RIGHT(2) / 0, 1017118720 / C DATA DIVER(1),DIVER(2) / 0, 1018167296 / C DATA LOG10(1),LOG10(2) / 1352628735, 1070810131 / C C MACHINE CONSTANTS FOR AMDAHL MACHINES. C C DATA SMALL(1),SMALL(2) / 1048576, 0 / C DATA LARGE(1),LARGE(2) / 2147483647, -1 / C DATA RIGHT(1),RIGHT(2) / 856686592, 0 / C DATA DIVER(1),DIVER(2) / 873463808, 0 / C DATA LOG10(1),LOG10(2) / 1091781651, 1352628735 / C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA SMALL(1) / ZC00800000 / C DATA SMALL(2) / Z000000000 / C C DATA LARGE(1) / ZDFFFFFFFF / C DATA LARGE(2) / ZFFFFFFFFF / C C DATA RIGHT(1) / ZCC5800000 / C DATA RIGHT(2) / Z000000000 / C C DATA DIVER(1) / ZCC6800000 / C DATA DIVER(2) / Z000000000 / C C DATA LOG10(1) / ZD00E730E7 / C DATA LOG10(2) / ZC77800DC0 / C C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. C C DATA SMALL(1) / O1771000000000000 / C DATA SMALL(2) / O0000000000000000 / C C DATA LARGE(1) / O0777777777777777 / C DATA LARGE(2) / O0007777777777777 / C C DATA RIGHT(1) / O1461000000000000 / C DATA RIGHT(2) / O0000000000000000 / C C DATA DIVER(1) / O1451000000000000 / C DATA DIVER(2) / O0000000000000000 / C C DATA LOG10(1) / O1157163034761674 / C DATA LOG10(2) / O0006677466732724 / C C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. C C DATA SMALL(1) / O1771000000000000 / C DATA SMALL(2) / O7770000000000000 / C C DATA LARGE(1) / O0777777777777777 / C DATA LARGE(2) / O7777777777777777 / C C DATA RIGHT(1) / O1461000000000000 / C DATA RIGHT(2) / O0000000000000000 / C C DATA DIVER(1) / O1451000000000000 / C DATA DIVER(2) / O0000000000000000 / C C DATA LOG10(1) / O1157163034761674 / C DATA LOG10(2) / O0006677466732724 / C C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES. C C DATA SMALL(1) / 00604000000000000000B / C DATA SMALL(2) / 00000000000000000000B / C C DATA LARGE(1) / 37767777777777777777B / C DATA LARGE(2) / 37167777777777777777B / C C DATA RIGHT(1) / 15604000000000000000B / C DATA RIGHT(2) / 15000000000000000000B / C C DATA DIVER(1) / 15614000000000000000B / C DATA DIVER(2) / 15010000000000000000B / C C DATA LOG10(1) / 17164642023241175717B / C DATA LOG10(2) / 16367571421742254654B / C C MACHINE CONSTANTS FOR CONVEX C-1 C C DATA SMALL(1),SMALL(2) / '00100000'X, '00000000'X / C DATA LARGE(1),LARGE(2) / '7FFFFFFF'X, 'FFFFFFFF'X / C DATA RIGHT(1),RIGHT(2) / '3CC00000'X, '00000000'X / C DATA DIVER(1),DIVER(2) / '3CD00000'X, '00000000'X / C DATA LOG10(1),LOG10(2) / '3FF34413'X, '509F79FF'X / C C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. C C DATA SMALL(1) / 201354000000000000000B / C DATA SMALL(2) / 000000000000000000000B / C C DATA LARGE(1) / 577767777777777777777B / C DATA LARGE(2) / 000007777777777777776B / C C DATA RIGHT(1) / 376434000000000000000B / C DATA RIGHT(2) / 000000000000000000000B / C C DATA DIVER(1) / 376444000000000000000B / C DATA DIVER(2) / 000000000000000000000B / C C DATA LOG10(1) / 377774642023241175717B / C DATA LOG10(2) / 000007571421742254654B / C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 C C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING LINE - C STATIC DMACH(5) C C DATA SMALL/20K,3*0/,LARGE/77777K,3*177777K/ C DATA RIGHT/31420K,3*0/,DIVER/32020K,3*0/ C DATA LOG10/40423K,42023K,50237K,74776K/ C C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7 C C DATA SMALL(1),SMALL(2) / '20000000, '00000201 / C DATA LARGE(1),LARGE(2) / '37777777, '37777577 / C DATA RIGHT(1),RIGHT(2) / '20000000, '00000333 / C DATA DIVER(1),DIVER(2) / '20000000, '00000334 / C DATA LOG10(1),LOG10(2) / '23210115, '10237777 / C C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C C DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 / C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 / C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 / C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 / C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 / C C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. C C DATA SMALL(1),SMALL(2) / Z00100000, Z00000000 / C DATA LARGE(1),LARGE(2) / Z7FFFFFFF, ZFFFFFFFF / C DATA RIGHT(1),RIGHT(2) / Z33100000, Z00000000 / C DATA DIVER(1),DIVER(2) / Z34100000, Z00000000 / C DATA LOG10(1),LOG10(2) / Z41134413, Z509F79FF / C C MACHINE CONSTANTS FOR THE INTERDATA 8/32 C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. C C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. C C DATA SMALL(1),SMALL(2) / Z'00100000', Z'00000000' / C DATA LARGE(1),LARGE(2) / Z'7EFFFFFF', Z'FFFFFFFF' / C DATA RIGHT(1),RIGHT(2) / Z'33100000', Z'00000000' / C DATA DIVER(1),DIVER(2) / Z'34100000', Z'00000000' / C DATA LOG10(1),LOG10(2) / Z'41134413', Z'509F79FF' / C C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). C C DATA SMALL(1),SMALL(2) / "033400000000, "000000000000 / C DATA LARGE(1),LARGE(2) / "377777777777, "344777777777 / C DATA RIGHT(1),RIGHT(2) / "113400000000, "000000000000 / C DATA DIVER(1),DIVER(2) / "114400000000, "000000000000 / C DATA LOG10(1),LOG10(2) / "177464202324, "144117571776 / C C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). C C DATA SMALL(1),SMALL(2) / "000400000000, "000000000000 / C DATA LARGE(1),LARGE(2) / "377777777777, "377777777777 / C DATA RIGHT(1),RIGHT(2) / "103400000000, "000000000000 / C DATA DIVER(1),DIVER(2) / "104400000000, "000000000000 / C DATA LOG10(1),LOG10(2) / "177464202324, "047674776746 / C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C DATA SMALL(1),SMALL(2) / 8388608, 0 / C DATA LARGE(1),LARGE(2) / 2147483647, -1 / C DATA RIGHT(1),RIGHT(2) / 612368384, 0 / C DATA DIVER(1),DIVER(2) / 620756992, 0 / C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 / C C DATA SMALL(1),SMALL(2) / O00040000000, O00000000000 / C DATA LARGE(1),LARGE(2) / O17777777777, O37777777777 / C DATA RIGHT(1),RIGHT(2) / O04440000000, O00000000000 / C DATA DIVER(1),DIVER(2) / O04500000000, O00000000000 / C DATA LOG10(1),LOG10(2) / O07746420232, O20476747770 / C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C DATA SMALL(1),SMALL(2) / 128, 0 / C DATA SMALL(3),SMALL(4) / 0, 0 / C C DATA LARGE(1),LARGE(2) / 32767, -1 / C DATA LARGE(3),LARGE(4) / -1, -1 / C C DATA RIGHT(1),RIGHT(2) / 9344, 0 / C DATA RIGHT(3),RIGHT(4) / 0, 0 / C C DATA DIVER(1),DIVER(2) / 9472, 0 / C DATA DIVER(3),DIVER(4) / 0, 0 / C C DATA LOG10(1),LOG10(2) / 16282, 8346 / C DATA LOG10(3),LOG10(4) / -31493, -12296 / C C DATA SMALL(1),SMALL(2) / O000200, O000000 / C DATA SMALL(3),SMALL(4) / O000000, O000000 / C C DATA LARGE(1),LARGE(2) / O077777, O177777 / C DATA LARGE(3),LARGE(4) / O177777, O177777 / C C DATA RIGHT(1),RIGHT(2) / O022200, O000000 / C DATA RIGHT(3),RIGHT(4) / O000000, O000000 / C C DATA DIVER(1),DIVER(2) / O022400, O000000 / C DATA DIVER(3),DIVER(4) / O000000, O000000 / C C DATA LOG10(1),LOG10(2) / O037632, O020232 / C DATA LOG10(3),LOG10(4) / O102373, O147770 / C C MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS C WTIH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, C SUPPLIED BY IGOR BRAY. C C DATA SMALL(1),SMALL(2) / :10000000000, :00000100001 / C DATA LARGE(1),LARGE(2) / :17777777777, :37777677775 / C DATA RIGHT(1),RIGHT(2) / :10000000000, :00000000122 / C DATA DIVER(1),DIVER(2) / :10000000000, :00000000123 / C DATA LOG10(1),LOG10(2) / :11504046501, :07674600177 / C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000 C C DATA SMALL(1),SMALL(2) / $00000000, $00100000 / C DATA LARGE(1),LARGE(2) / $FFFFFFFF, $7FEFFFFF / C DATA RIGHT(1),RIGHT(2) / $00000000, $3CA00000 / C DATA DIVER(1),DIVER(2) / $00000000, $3CB00000 / C DATA LOG10(1),LOG10(2) / $509F79FF, $3FD34413 / C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 / C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 / C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 / C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 / C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 / C C MACHINE CONSTANTS FOR THE VAX UNIX F77 COMPILER C C DATA SMALL(1),SMALL(2) / 128, 0 / C DATA LARGE(1),LARGE(2) / -32769, -1 / C DATA RIGHT(1),RIGHT(2) / 9344, 0 / C DATA DIVER(1),DIVER(2) / 9472, 0 / C DATA LOG10(1),LOG10(2) / 546979738, -805796613 / C C MACHINE CONSTANTS FOR THE VAX-11 WITH C FORTRAN IV-PLUS COMPILER C C DATA SMALL(1),SMALL(2) / Z00000080, Z00000000 / C DATA LARGE(1),LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / C DATA RIGHT(1),RIGHT(2) / Z00002480, Z00000000 / C DATA DIVER(1),DIVER(2) / Z00002500, Z00000000 / C DATA LOG10(1),LOG10(2) / Z209A3F9A, ZCFF884FB / C C MACHINE CONSTANTS FOR VAX/VMS VERSION 2.2 C C DATA SMALL(1),SMALL(2) / '80'X, '0'X / C DATA LARGE(1),LARGE(2) / 'FFFF7FFF'X, 'FFFFFFFF'X / C DATA RIGHT(1),RIGHT(2) / '2480'X, '0'X / C DATA DIVER(1),DIVER(2) / '2500'X, '0'X / C DATA LOG10(1),LOG10(2) / '209A3F9A'X, 'CFF884FB'X / C IF (I .LT. 1 .OR. I .GT. 5) GOTO 999 D1MACH = DMACH(I) RETURN 999 WRITE(I1MACH(2),1999) I 1999 FORMAT(' D1MACH - I OUT OF BOUNDS',I10) STOP END INTEGER FUNCTION I1MACH(I) C C I/O UNIT NUMBERS. C C I1MACH( 1) = THE STANDARD INPUT UNIT. C C I1MACH( 2) = THE STANDARD OUTPUT UNIT. C C I1MACH( 3) = THE STANDARD PUNCH UNIT. C C I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT. C C WORDS. C C I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT. C C I1MACH( 6) = THE NUMBER OF CHARACTERS PER INTEGER STORAGE UNIT. C C INTEGERS. C C ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, BASE-A FORM C C SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) C C WHERE 0 .LE. X(I) .LT. A FOR I=0,...,S-1. C C I1MACH( 7) = A, THE BASE. C C I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS. C C I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE. C C FLOATING-POINT NUMBERS. C C ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT, C BASE-B FORM C C SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) C C WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T, C 0 .LT. X(1), AND EMIN .LE. E .LE. EMAX. C C I1MACH(10) = B, THE BASE. C C SINGLE-PRECISION C C I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS. C C I1MACH(12) = EMIN, THE SMALLEST EXPONENT E. C C I1MACH(13) = EMAX, THE LARGEST EXPONENT E. C C DOUBLE-PRECISION C C I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS. C C I1MACH(15) = EMIN, THE SMALLEST EXPONENT E. C C I1MACH(16) = EMAX, THE LARGEST EXPONENT E. C C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY C REMOVING THE C FROM COLUMN 1. ALSO, THE VALUES OF C I1MACH(1) - I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY C WITH THE LOCAL OPERATING SYSTEM. FOR FORTRAN 77, YOU MAY WISH C TO ADJUST THE DATA STATEMENT SO IMACH(6) IS SET TO 1, AND C THEN TO COMMENT OUT THE EXECUTABLE TEST ON I .EQ. 6 BELOW. C ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. C (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) C C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), THE FIRST C SET OF CONSTANTS BELOW SHOULD BE APPROPRIATE, EXCEPT PERHAPS C FOR IMACH(1) - IMACH(4). C INTEGER IMACH(16),OUTPUT C EQUIVALENCE (IMACH(4),OUTPUT) C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T C 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T C PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -125 / C DATA IMACH(13) / 128 / C DATA IMACH(14) / 53 / C DATA IMACH(15) / -1021 / C DATA IMACH(16) / 1024 / C C MACHINE CONSTANTS FOR AMDAHL MACHINES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 / C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA IMACH( 1) / 7 / C DATA IMACH( 2) / 2 / C DATA IMACH( 3) / 2 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 33 / C DATA IMACH( 9) / Z1FFFFFFFF / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -256 / C DATA IMACH(13) / 255 / C DATA IMACH(14) / 60 / C DATA IMACH(15) / -256 / C DATA IMACH(16) / 255 / C C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 39 / C DATA IMACH( 9) / O0007777777777777 / C DATA IMACH(10) / 8 / C DATA IMACH(11) / 13 / C DATA IMACH(12) / -50 / C DATA IMACH(13) / 76 / C DATA IMACH(14) / 26 / C DATA IMACH(15) / -50 / C DATA IMACH(16) / 76 / C C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 39 / C DATA IMACH( 9) / O0007777777777777 / C DATA IMACH(10) / 8 / C DATA IMACH(11) / 13 / C DATA IMACH(12) / -50 / C DATA IMACH(13) / 76 / C DATA IMACH(14) / 26 / C DATA IMACH(15) / -32754 / C DATA IMACH(16) / 32780 / C C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 60 / C DATA IMACH( 6) / 10 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 48 / C DATA IMACH( 9) / 00007777777777777777B / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 48 / C DATA IMACH(12) / -974 / C DATA IMACH(13) / 1070 / C DATA IMACH(14) / 96 / C DATA IMACH(15) / -927 / C DATA IMACH(16) / 1070 / C C MACHINE CONSTANTS FOR CONVEX C-1. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 53 / C DATA IMACH(15) /-1024 / C DATA IMACH(16) / 1023 / C C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 102 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 64 / C DATA IMACH( 6) / 8 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 63 / C DATA IMACH( 9) / 777777777777777777777B / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 47 / C DATA IMACH(12) / -8189 / C DATA IMACH(13) / 8190 / C DATA IMACH(14) / 94 / C DATA IMACH(15) / -8099 / C DATA IMACH(16) / 8190 / C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. C C DATA IMACH( 1) / 11 / C DATA IMACH( 2) / 12 / C DATA IMACH( 3) / 8 / C DATA IMACH( 4) / 10 / C DATA IMACH( 5) / 16 / C DATA IMACH( 6) / 2 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 15 / C DATA IMACH( 9) /32767 / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 / C C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 0 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / 3 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 23 / C DATA IMACH( 9) / 8388607 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 23 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 38 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 / C C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 43 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 63 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 / C C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / Z7FFFFFFF / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 / C C MACHINE CONSTANTS FOR THE INTERDATA 8/32 C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. C C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 6 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / Z'7FFFFFFF' / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 62 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 62 / C C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 5 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / "377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 54 / C DATA IMACH(15) / -101 / C DATA IMACH(16) / 127 / C C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 5 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / "377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 62 / C DATA IMACH(15) / -128 / C DATA IMACH(16) / 127 / C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 / C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 16-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 16 / C DATA IMACH( 6) / 2 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 15 / C DATA IMACH( 9) / 32767 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 / C C MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS C WTIH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, C SUPPLIED BY IGOR BRAY. C C DATA IMACH( 1) / 1 / C DATA IMACH( 2) / 1 / C DATA IMACH( 3) / 2 / C DATA IMACH( 4) / 1 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / :17777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 23 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / +127 / C DATA IMACH(14) / 47 / C DATA IMACH(15) / -32895 / C DATA IMACH(16) / +32637 / C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. C C DATA IMACH( 1) / 0 / C DATA IMACH( 2) / 0 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 0 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 1 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -125 / C DATA IMACH(13) / 128 / C DATA IMACH(14) / 53 / C DATA IMACH(15) / -1021 / C DATA IMACH(16) / 1024 / C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7 C WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM. C IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 60 / C DATA IMACH(15) /-1024 / C DATA IMACH(16) / 1023 / C C MACHINE CONSTANTS FOR VAX. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 / IF (I .LT. 1 .OR. I .GT. 16) GO TO 999 I1MACH=IMACH(I) C/6S C/7S IF(I.EQ.6) I1MACH=1 C/ RETURN 999 WRITE(OUTPUT,1999) I 1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10) STOP END C*********************************************************************** C*********************************************************************** SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) C C CONSTANT TIMES A VECTOR PLUS A VECTOR. C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. C JACK DONGARRA, LINPACK, 3/11/78. C DOUBLE PRECISION DX(1),DY(1),DA INTEGER I,INCX,INCY,IXIY,M,MP1,N C IF(N.LE.0)RETURN IF (DA .EQ. 0.0D0) RETURN IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 C C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS C NOT EQUAL TO 1 C IX = 1 IY = 1 IF(INCX.LT.0)IX = (-N+1)*INCX + 1 IF(INCY.LT.0)IY = (-N+1)*INCY + 1 DO 10 I = 1,N DY(IY) = DY(IY) + DA*DX(IX) IX = IX + INCX IY = IY + INCY 10 CONTINUE RETURN C C CODE FOR BOTH INCREMENTS EQUAL TO 1 C C C CLEAN-UP LOOP C 20 M = MOD(N,4) IF( M .EQ. 0 ) GO TO 40 DO 30 I = 1,M DY(I) = DY(I) + DA*DX(I) 30 CONTINUE IF( N .LT. 4 ) RETURN 40 MP1 = M + 1 DO 50 I = MP1,N,4 DY(I) = DY(I) + DA*DX(I) DY(I + 1) = DY(I + 1) + DA*DX(I + 1) DY(I + 2) = DY(I + 2) + DA*DX(I + 2) DY(I + 3) = DY(I + 3) + DA*DX(I + 3) 50 CONTINUE RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) C C COPIES A VECTOR, X, TO A VECTOR, Y. C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. C JACK DONGARRA, LINPACK, 3/11/78. C DOUBLE PRECISION DX(1),DY(1) INTEGER I,INCX,INCY,IX,IY,M,MP1,N C IF(N.LE.0)RETURN IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 C C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS C NOT EQUAL TO 1 C IX = 1 IY = 1 IF(INCX.LT.0)IX = (-N+1)*INCX + 1 IF(INCY.LT.0)IY = (-N+1)*INCY + 1 DO 10 I = 1,N DY(IY) = DX(IX) IX = IX + INCX IY = IY + INCY 10 CONTINUE RETURN C C CODE FOR BOTH INCREMENTS EQUAL TO 1 C C C CLEAN-UP LOOP C 20 M = MOD(N,7) IF( M .EQ. 0 ) GO TO 40 DO 30 I = 1,M DY(I) = DX(I) 30 CONTINUE IF( N .LT. 7 ) RETURN 40 MP1 = M + 1 DO 50 I = MP1,N,7 DY(I) = DX(I) DY(I + 1) = DX(I + 1) DY(I + 2) = DX(I + 2) DY(I + 3) = DX(I + 3) DY(I + 4) = DX(I + 4) DY(I + 5) = DX(I + 5) DY(I + 6) = DX(I + 6) 50 CONTINUE RETURN END C*********************************************************************** C*********************************************************************** DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) C C FORMS THE DOT PRODUCT OF TWO VECTORS. C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. C JACK DONGARRA, LINPACK, 3/11/78. C DOUBLE PRECISION DX(1),DY(1),DTEMP INTEGER I,INCX,INCY,IX,IY,M,MP1,N C DDOT = 0.0D0 DTEMP = 0.0D0 IF(N.LE.0)RETURN IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 C C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS C NOT EQUAL TO 1 C IX = 1 IY = 1 IF(INCX.LT.0)IX = (-N+1)*INCX + 1 IF(INCY.LT.0)IY = (-N+1)*INCY + 1 DO 10 I = 1,N DTEMP = DTEMP + DX(IX)*DY(IY) IX = IX + INCX IY = IY + INCY 10 CONTINUE DDOT = DTEMP RETURN C C CODE FOR BOTH INCREMENTS EQUAL TO 1 C C C CLEAN-UP LOOP C 20 M = MOD(N,5) IF( M .EQ. 0 ) GO TO 40 DO 30 I = 1,M DTEMP = DTEMP + DX(I)*DY(I) 30 CONTINUE IF( N .LT. 5 ) GO TO 60 40 MP1 = M + 1 DO 50 I = MP1,N,5 DTEMP = DTEMP + DX(I)*DY(I) + DX(I + 1)*DY(I + 1) + * DX(I + 2)*DY(I + 2) + DX(I + 3)*DY(I + 3) + DX(I + 4)*DY(I + 4) 50 CONTINUE 60 DDOT = DTEMP RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE DGEFA(A,LDA,N,IPVT,INFO) INTEGER LDA,N,IPVT(1),INFO DOUBLE PRECISION A(LDA,1) C C DGEFA FACTORS A DOUBLE PRECISION MATRIX BY GAUSSIAN ELIMINATION. C C DGEFA IS USUALLY CALLED BY DGECO, BUT IT CAN BE CALLED C DIRECTLY WITH A SAVING IN TIME IF RCOND IS NOT NEEDED. C (TIME FOR DGECO) = (1 + 9/N)*(TIME FOR DGEFA) . C C ON ENTRY C C A DOUBLE PRECISION(LDA, N) C THE MATRIX TO BE FACTORED. C C LDA INTEGER C THE LEADING DIMENSION OF THE ARRAY A . C C N INTEGER C THE ORDER OF THE MATRIX A . C C ON RETURN C C A AN UPPER TRIANGULAR MATRIX AND THE MULTIPLIERS C WHICH WERE USED TO OBTAIN IT. C THE FACTORIZATION CAN BE WRITTEN A = L*U WHERE C L IS A PRODUCT OF PERMUTATION AND UNIT LOWER C TRIANGULAR MATRICES AND U IS UPPER TRIANGULAR. C C IPVT INTEGER(N) C AN INTEGER VECTOR OF PIVOT INDICES. C C INFO INTEGER C = 0 NORMAL VALUE. C = K IF U(K,K) .EQ. 0.0 . THIS IS NOT AN ERROR C CONDITION FOR THIS SUBROUTINE, BUT IT DOES C INDICATE THAT DGESL OR DGEDI WILL DIVIDE BY ZERO C IF CALLED. USE RCOND IN DGECO FOR A RELIABLE C INDICATION OF SINGULARITY. C C LINPACK. THIS VERSION DATED 08/14/78 . C CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB. C C SUBROUTINES AND FUNCTIONS C C BLAS DAXPY,DSCAL,IDAMAX C C INTERNAL VARIABLES C DOUBLE PRECISION T INTEGER IDAMAX,J,K,KP1,L,NM1 C C C GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING C INFO = 0 NM1 = N - 1 IF (NM1 .LT. 1) GO TO 70 DO 60 K = 1, NM1 KP1 = K + 1 C C FIND L = PIVOT INDEX C L = IDAMAX(N-K+1,A(K,K),1) + K - 1 IPVT(K) = L C C ZERO PIVOT IMPLIES THIS COLUMN ALREADY TRIANGULARIZED C IF (A(L,K) .EQ. 0.0D0) GO TO 40 C C INTERCHANGE IF NECESSARY C IF (L .EQ. K) GO TO 10 T = A(L,K) A(L,K) = A(K,K) A(K,K) = T 10 CONTINUE C C COMPUTE MULTIPLIERS C T = -1.0D0/A(K,K) CALL DSCAL(N-K,T,A(K+1,K),1) C C ROW ELIMINATION WITH COLUMN INDEXING C DO 30 J = KP1, N T = A(L,J) IF (L .EQ. K) GO TO 20 A(L,J) = A(K,J) A(K,J) = T 20 CONTINUE CALL DAXPY(N-K,T,A(K+1,K),1,A(K+1,J),1) 30 CONTINUE GO TO 50 40 CONTINUE INFO = K 50 CONTINUE 60 CONTINUE 70 CONTINUE IPVT(N) = N IF (A(N,N) .EQ. 0.0D0) INFO = N RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE DGESL(A,LDA,N,IPVT,B,JOB) INTEGER LDA,N,IPVT(1),JOB DOUBLE PRECISION A(LDA,1),B(1) C C DGESL SOLVES THE DOUBLE PRECISION SYSTEM C A * X = B OR TRANS(A) * X = B C USING THE FACTORS COMPUTED BY DGECO OR DGEFA. C C ON ENTRY C C A DOUBLE PRECISION(LDA, N) C THE OUTPUT FROM DGECO OR DGEFA. C C LDA INTEGER C THE LEADING DIMENSION OF THE ARRAY A . C C N INTEGER C THE ORDER OF THE MATRIX A . C C IPVT INTEGER(N) C THE PIVOT VECTOR FROM DGECO OR DGEFA. C C B DOUBLE PRECISION(N) C THE RIGHT HAND SIDE VECTOR. C C JOB INTEGER C = 0 TO SOLVE A*X = B , C = NONZERO TO SOLVE TRANS(A)*X = B WHERE C TRANS(A) IS THE TRANSPOSE. C C ON RETURN C C B THE SOLUTION VECTOR X . C C ERROR CONDITION C C A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS A C ZERO ON THE DIAGONAL. TECHNICALLY THIS INDICATES SINGULARITY C BUT IT IS OFTEN CAUSED BY IMPROPER ARGUMENTS OR IMPROPER C SETTING OF LDA . IT WILL NOT OCCUR IF THE SUBROUTINES ARE C CALLED CORRECTLY AND IF DGECO HAS SET RCOND .GT. 0.0 C OR DGEFA HAS SET INFO .EQ. 0 . C C TO COMPUTE INVERSE(A) * C WHERE C IS A MATRIX C WITH P COLUMNS C CALL DGECO(A,LDA,N,IPVT,RCOND,Z) C IF (RCOND IS TOO SMALL) GO TO ... C DO 10 J = 1, P C CALL DGESL(A,LDA,N,IPVT,C(1,J),0) C 10 CONTINUE C C LINPACK. THIS VERSION DATED 08/14/78 . C CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB. C C SUBROUTINES AND FUNCTIONS C C BLAS DAXPY,DDOT C C INTERNAL VARIABLES C DOUBLE PRECISION DDOT,T INTEGER K,KB,L,NM1 C NM1 = N - 1 IF (JOB .NE. 0) GO TO 50 C C JOB = 0 , SOLVE A * X = B C FIRST SOLVE L*Y = B C IF (NM1 .LT. 1) GO TO 30 DO 20 K = 1, NM1 L = IPVT(K) T = B(L) IF (L .EQ. K) GO TO 10 B(L) = B(K) B(K) = T 10 CONTINUE CALL DAXPY(N-K,T,A(K+1,K),1,B(K+1),1) 20 CONTINUE 30 CONTINUE C C NOW SOLVE U*X = Y C DO 40 KB = 1, N K = N + 1 - KB B(K) = B(K)/A(K,K) T = -B(K) CALL DAXPY(K-1,T,A(1,K),1,B(1),1) 40 CONTINUE GO TO 100 50 CONTINUE C C JOB = NONZERO, SOLVE TRANS(A) * X = B C FIRST SOLVE TRANS(U)*Y = B C DO 60 K = 1, N T = DDOT(K-1,A(1,K),1,B(1),1) B(K) = (B(K) - T)/A(K,K) 60 CONTINUE C C NOW SOLVE TRANS(L)*X = Y C IF (NM1 .LT. 1) GO TO 90 DO 80 KB = 1, NM1 K = N - KB B(K) = B(K) + DDOT(N-K,A(K+1,K),1,B(K+1),1) L = IPVT(K) IF (L .EQ. K) GO TO 70 T = B(L) B(L) = B(K) B(K) = T 70 CONTINUE 80 CONTINUE 90 CONTINUE 100 CONTINUE RETURN END C*********************************************************************** C*********************************************************************** DOUBLE PRECISION FUNCTION DNRM2 ( N, DX, INCX) INTEGER NEXT DOUBLE PRECISION DX(1), CUTLO, CUTHI, HITEST, SUM, XMAX,ZERO,ONE DATA ZERO, ONE /0.0D0, 1.0D0/ C C EUCLIDEAN NORM OF THE N-VECTOR STORED IN DX() WITH STORAGE C INCREMENT INCX . C IF N .LE. 0 RETURN WITH RESULT = 0. C IF N .GE. 1 THEN INCX MUST BE .GE. 1 C C C.L.LAWSON, 1978 JAN 08 C C FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE C HOPEFULLY APPLICABLE TO ALL MACHINES. C CUTLO = MAXIMUM OF DSQRT(U/EPS) OVER ALL KNOWN MACHINES. C CUTHI = MINIMUM OF DSQRT(V) OVER ALL KNOWN MACHINES. C WHERE C EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1. C U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT) C V = LARGEST NO. (OVERFLOW LIMIT) C C BRIEF OUTLINE OF ALGORITHM.. C C PHASE 1 SCANS ZERO COMPONENTS. C MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO C MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO C MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M C WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. C C VALUES FOR CUTLO AND CUTHI.. C FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER C DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. C CUTLO, S.P. U/EPS = 2**(-102) FOR HONEYWELL. CLOSE SECONDS ARE C UNIVAC AND DEC AT 2**(-103) C THUS CUTLO = 2**(-51) = 4.44089E-16 C CUTHI, S.P. V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. C THUS CUTHI = 2**(63.5) = 1.30438E19 C CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC. C THUS CUTLO = 2**(-33.5) = 8.23181D-11 C CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D19 C DATA CUTLO, CUTHI / 8.232D-11, 1.304D19 / C DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 / DATA CUTLO, CUTHI / 8.232D-11, 1.304D19 / C IF(N .GT. 0) GO TO 10 DNRM2 = ZERO GO TO 300 C 10 ASSIGN 30 TO NEXT SUM = ZERO NN = N * INCX C BEGIN MAIN LOOP I = 1 20 GO TO NEXT,(30, 50, 70, 110) 30 IF( DABS(DX(I)) .GT. CUTLO) GO TO 85 ASSIGN 50 TO NEXT XMAX = ZERO C C PHASE 1. SUM IS ZERO C 50 IF( DX(I) .EQ. ZERO) GO TO 200 IF( DABS(DX(I)) .GT. CUTLO) GO TO 85 C C PREPARE FOR PHASE 2. ASSIGN 70 TO NEXT GO TO 105 C C PREPARE FOR PHASE 4. C 100 I = J ASSIGN 110 TO NEXT SUM = (SUM / DX(I)) / DX(I) 105 XMAX = DABS(DX(I)) GO TO 115 C C PHASE 2. SUM IS SMALL. C SCALE TO AVOID DESTRUCTIVE UNDERFLOW. C 70 IF( DABS(DX(I)) .GT. CUTLO ) GO TO 75 C C COMMON CODE FOR PHASES 2 AND 4. C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW. C 110 IF( DABS(DX(I)) .LE. XMAX ) GO TO 115 SUM = ONE + SUM * (XMAX / DX(I))**2 XMAX = DABS(DX(I)) GO TO 200 C 115 SUM = SUM + (DX(I)/XMAX)**2 GO TO 200 C C C PREPARE FOR PHASE 3. C 75 SUM = (SUM * XMAX) * XMAX C C C FOR REAL OR D.P. SET HITEST = CUTHI/N C FOR COMPLEX SET HITEST = CUTHI/(2*N) C 85 HITEST = CUTHI/FLOAT( N ) C C PHASE 3. SUM IS MID-RANGE. NO SCALING. C DO 95 J =I,NN,INCX IF(DABS(DX(J)) .GE. HITEST) GO TO 100 95 SUM = SUM + DX(J)**2 DNRM2 = DSQRT( SUM ) GO TO 300 C 200 CONTINUE I = I + INCX IF ( I .LE. NN ) GO TO 20 C C END OF MAIN LOOP. C C COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. C DNRM2 = XMAX * DSQRT(SUM) 300 CONTINUE RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE DSCAL(N,DA,DX,INCX) C C SCALES A VECTOR BY A CONSTANT. C USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE. C JACK DONGARRA, LINPACK, 3/11/78. C DOUBLE PRECISION DA,DX(1) INTEGER I,INCX,M,MP1,N,NINCX C IF(N.LE.0)RETURN IF(INCX.EQ.1)GO TO 20 C C CODE FOR INCREMENT NOT EQUAL TO 1 C NINCX = N*INCX DO 10 I = 1,NINCX,INCX DX(I) = DA*DX(I) 10 CONTINUE RETURN C C CODE FOR INCREMENT EQUAL TO 1 C C C CLEAN-UP LOOP C 20 M = MOD(N,5) IF( M .EQ. 0 ) GO TO 40 DO 30 I = 1,M DX(I) = DA*DX(I) 30 CONTINUE IF( N .LT. 5 ) RETURN 40 MP1 = M + 1 DO 50 I = MP1,N,5 DX(I) = DA*DX(I) DX(I + 1) = DA*DX(I + 1) DX(I + 2) = DA*DX(I + 2) DX(I + 3) = DA*DX(I + 3) DX(I + 4) = DA*DX(I + 4) 50 CONTINUE RETURN END C*********************************************************************** C*********************************************************************** INTEGER FUNCTION IDAMAX(N,DX,INCX) C C FINDS THE INDEX OF ELEMENT HAVING MAX. ABSOLUTE VALUE. C JACK DONGARRA, LINPACK, 3/11/78. C DOUBLE PRECISION DX(1),DMAX INTEGER I,INCX,IX,N C IDAMAX = 0 IF( N .LT. 1 ) RETURN IDAMAX = 1 IF(N.EQ.1)RETURN IF(INCX.EQ.1)GO TO 20 C C CODE FOR INCREMENT NOT EQUAL TO 1 C IX = 1 DMAX = DABS(DX(1)) IX = IX + INCX DO 10 I = 2,N IF(DABS(DX(IX)).LE.DMAX) GO TO 5 IDAMAX = I DMAX = DABS(DX(IX)) 5 IX = IX + INCX 10 CONTINUE RETURN C C CODE FOR INCREMENT EQUAL TO 1 C 20 DMAX = DABS(DX(1)) DO 30 I = 2,N IF(DABS(DX(I)).LE.DMAX) GO TO 30 IDAMAX = I DMAX = DABS(DX(I)) 30 CONTINUE RETURN END SUBROUTINE ADDBOX(CURPTR,BOXPTR,PTR) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (linked list and stack operations subpackage). C C*********************************************************************** C C Called by -- ROOTS, DELLST C C*********************************************************************** C C Function -- C C This routine inserts a box (with pointer BOXPTR) into a linked C list (after the box with pointer CURPTR). C C*********************************************************************** C C Argument declarations -- C INTEGER CURPTR, BOXPTR, PTR(2,*) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C CURPTR is the pointer of the box in the list after which the new C box is to be inserted. C (INPUT) C C BOXPTR is the pointer of the box to be inserted. C (INPUT) C C PTR contains the pointer values of the previous and next C boxes currently in linked lists. C (I/O) C C*********************************************************************** C C Internal variable declarations -- C INTEGER TMPPTR C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER PREV, NEXT, EOLIST DATA PREV/1/, NEXT/2/, EOLIST/0/ C C*********************************************************************** C C Internal constant descriptions -- C C PREV PTR(PREV,BOXPTR) is the pointer corresponding to the box C in the linked list at BOXPTR. C C NEXT PTR(NEXT,BOXPTR) is the pointer corresponding to the box C following the box in the linked list at BOXPTR. C C EOLIST is the end-of-list pointer. C C*********************************************************************** C C Beginning of executable statements -- C TMPPTR = PTR(NEXT,CURPTR) PTR(PREV,BOXPTR) = CURPTR PTR(NEXT,BOXPTR) = TMPPTR PTR(NEXT,CURPTR) = BOXPTR IF (TMPPTR.NE.EOLIST) PTR(PREV,TMPPTR) = BOXPTR C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE ALLOC(BOXPTR,MAXLST,UNUSED) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (linked list and stack operations subpackage). C C*********************************************************************** C C Called by -- ROOTS, DELLST C C*********************************************************************** C C Function -- C C This routine allocates a box from the linked list and passes its C pointer back to the calling routine. If there are is no free C space in the list, the routine returns end-of-list pointer. * C C*********************************************************************** C C Argument declarations -- C INTEGER BOXPTR, MAXLST LOGICAL UNUSED(MAXLST) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C BOXPTR is set to the pointer of the allocated box on return. C (OUTPUT) C C MAXLST is the total allowable number of nodes in the linked C list. C (INPUT) C C UNUSED UNUSED(I) is set to .TRUE. if the list space corresponding C to pointer I is not occupied; and UNUSED(I) is set to C .FALSE. otherwise. C (I/O) C C*********************************************************************** C C Internal variable declarations -- none C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER EOLIST DATA EOLIST/0/ C C*********************************************************************** C C Internal constant descriptions -- C C EOLIST is the end-of-list pointer. C C*********************************************************************** C C Beginning of executable statements -- C C Attempt to find an unused location in the linked list; return C with its pointer if one is found. C DO 10 BOXPTR = 1, MAXLST IF (UNUSED(BOXPTR)) THEN UNUSED(BOXPTR) = .FALSE. RETURN END IF 10 CONTINUE C C Return with the end-of-list pointer when no locations are free. C BOXPTR = EOLIST C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE DELBOX(BOXPTR,PTR) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (linked list and stack operations subpackage). C C*********************************************************************** C C Called by -- DELLST C C*********************************************************************** C C Function -- C C This routine removes the box at pointer BOXPTR from a linked C list. C C*********************************************************************** C C Argument declarations -- C INTEGER BOXPTR, PTR(2,*) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C BOXPTR is the pointer of the box to be removed from the list. C (INPUT) C C PTR contains the pointer values of the previous and next C boxes currently in linked lists. C (I/O) C C*********************************************************************** C C Internal variable declarations -- C INTEGER TPTR1, TPTR2 C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER PREV, NEXT, EOLIST DATA PREV/1/, NEXT/2/, EOLIST/0/ C C*********************************************************************** C C Internal constant descriptions -- C C PREV PTR(PREV,BOXPTR) is the pointer corresponding to the box C in the linked list at BOXPTR. C C NEXT PTR(NEXT,BOXPTR) is the pointer corresponding to the box C following the box in the linked list at BOXPTR. C C EOLIST is the end-of-list pointer. C C*********************************************************************** C C Beginning of executable statements -- C TPTR1 = PTR(PREV,BOXPTR) TPTR2 = PTR(NEXT,BOXPTR) PTR(NEXT,TPTR1) = TPTR2 IF (TPTR2.NE.EOLIST) PTR(PREV,TPTR2) = TPTR1 C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE FREE(BOXPTR,MAXLST,UNUSED) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (linked list and stack operations subpackage). C C*********************************************************************** C C Called by -- DELLST C C*********************************************************************** C C Function -- C C This routine sets UNUSED(BOXPTR) to .TRUE. to indicate that C the space in the linked list at BOXPTR is not occupied. C C*********************************************************************** C C Argument declarations -- C INTEGER BOXPTR, MAXLST LOGICAL UNUSED(MAXLST) C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C BOXPTR is set to the pointer of the box to be removed. C (INPUT) C C MAXLST MAXLST - 2 is the maximum number of root-containing boxes which C can be stored. C (INPUT) C C UNUSED UNUSED(I) is set to .TRUE. if the list space corresponding C to pointer I is not occupied; and UNUSED(I) is set to C .FALSE. otherwise. C (I/O) C C*********************************************************************** C C Internal variable declarations -- none C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- none C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER EOLIST DATA EOLIST/0/ C C*********************************************************************** C C Internal constant descriptions -- C C EOLIST is the end-of-list pointer. C C*********************************************************************** C C Beginning of executable statements -- C IF ( (BOXPTR.GT.0) .AND. (BOXPTR.LE.MAXLST) ) THEN UNUSED(BOXPTR) = .TRUE. END IF C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE POP(N,BOX,MAXDP,DEPTH,LEVEL,STACK,STKLVL,ERRFLG,ERRVAL) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (linked list and stack operations subpackage). C C*********************************************************************** C C Called by -- ROOTS C C*********************************************************************** C C Function -- C C This routine pops a box from the stack of boxes which are still C to be considered, and adjusts the depth of the stack accordingly. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION BOX(2,N) INTEGER MAXDP, DEPTH, LEVEL DOUBLE PRECISION STACK(2,N,MAXDP) INTEGER STKLVL(MAXDP), ERRFLG, ERRVAL C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of equations and variables. C (INPUT) C C BOX On return, BOX(1,I) will contain the left endpoint of the I-th C coordinate interval and BOX(2,I) will contain the right C endpoint of the I-th coordinate interval of the box taken C from the stack, for I between 1 and N. C (OUTPUT) C C MAXDP is the maximum allowable depth of the stack. C (INPUT) C C DEPTH is the current depth of the stack. C (I/O) C C LEVEL is the current level in the binary subdivision tree. C (I/O) C C STACK STACK(*,*,I) contains the box at depth I-1 in the stack C of boxes the algorithm has not yet processed. C (I/O) C C STKLVL STKLVL(I) contains the level in the binary search tree C corresponding to the box in STACK(*,*,I). C (I/O) C C ERRFLG Upon return, ERRFLG is set to 11 if the stack is empty, C and is set to 0 otherwise. C (OUTPUT) C C ERRVAL contains additional error information. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- none C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C DCOPY (from LINPACK) C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER NTTWO C C*********************************************************************** C C Beginning of executable statements -- C NTTWO = N * 2 C IF ((DEPTH.LT.0).OR.(DEPTH.GT.MAXDP)) THEN ERRFLG = 13 ERRVAL = DEPTH ELSE IF (DEPTH.EQ.0) THEN ERRFLG = 11 ERRVAL = DEPTH ELSE ERRFLG = 0 CALL DCOPY(NTTWO,STACK(1,1,DEPTH),1,BOX,1) LEVEL = STKLVL(DEPTH) DEPTH = DEPTH - 1 END IF END IF C RETURN END C*********************************************************************** C*********************************************************************** SUBROUTINE PUSH(N,BOX,MAXDP,DEPTH,LEVEL,STACK,STKLVL,ERRFLG, 1 ERRVAL) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) C C Written by: C C R. Baker Kearfott C C and C C Manuel Novoa III C C Department of Mathematics C U.S.L. Box 4-1010 C Lafayette, LA 70504 C C September 29, 1987 C C Part of the generalized bisection package C (linked list and stack operations subpackage). C C*********************************************************************** C C Called by -- ROOTS AND FTESTH C C*********************************************************************** C C Function -- C C This routine places a box onto the stack of boxes the algorithm needs C to process later. It also stores the level in the binary C subdivision tree corresponding to this box. C C*********************************************************************** C C Argument declarations -- C INTEGER N DOUBLE PRECISION BOX(2,N) INTEGER MAXDP, DEPTH, LEVEL DOUBLE PRECISION STACK(2,N,MAXDP) INTEGER STKLVL(MAXDP), ERRFLG, ERRVAL C C*********************************************************************** C C Argument descriptions -- (INPUT = set on entry and not alterable) C (OUTPUT = to be set by the routine) C (I/O = set on entry but alterable) C C N is the number of equations and variables. C (INPUT) C C BOX BOX(1,I) contains the left endpoint of the I-th coordinate C interval and BOX(2,I) will contain the right endpoint of C the I-th coordinate interval of the box to be placed on the C the stack, for I between 1 and N. C (OUTPUT) C C MAXDP is the maximum allowable depth of the stack. C (INPUT) C C DEPTH is the current depth of the stack. C (I/O) C C LEVEL is the current level in the binary subdivision tree. C (I/O) C C STACK STACK(*,*,I) contains the box at depth I-1 in the stack C of boxes the algorithm has not yet processed. C (I/O) C C STKLVL STKLVL(I) contains the level in the binary search tree C corresponding to the box in STACK(*,*,I). C (I/O) C C ERRFLG On return, ERRFLG is set to 10 if a stack overflow occurs; C ERRFLG is set to 0 otherwise. C (OUTPUT) C C ERRVAL contains additional error information. C (OUTPUT) C C*********************************************************************** C C Internal variable declarations -- none C C*********************************************************************** C C Common block declarations -- none C C*********************************************************************** C C Fortran-supplied functions and subroutines -- none C C*********************************************************************** C C Package-supplied functions and subroutines -- C C DCOPY (from LINPACK) C C*********************************************************************** C C User-supplied functions and subroutines -- none C C*********************************************************************** C C I/O functions -- none C C*********************************************************************** C C Internal constant declarations -- C INTEGER NTTWO C C*********************************************************************** C C Beginning of executable statements -- C NTTWO = N * 2 C IF ((DEPTH.LT.0).OR.(DEPTH.GE.MAXDP)) THEN ERRFLG = 12 ERRVAL = DEPTH ELSE IF (DEPTH.EQ.MAXDP-1) THEN ERRFLG = 10 ERRVAL = MAXDP ELSE ERRFLG = 0 END IF DEPTH = DEPTH + 1 CALL DCOPY(NTTWO,BOX,1,STACK(1,1,DEPTH),1) STKLVL(DEPTH) = LEVEL END IF C RETURN END 9 NPROBLEMS Test problem no. 1: cubic-parabola......................... 00002 N 00003 NUMTRM(1) 00003 DEG(1,1,1) 00000 DEG(1,2,1) 4.0D 00 A(1,1) 00001 DEG(1,1,2) 00000 DEG(1,2,2) -3.0D 00 A(1,2) 00000 DEG(1,1,3) 00001 DEG(1,2,3) -1.0D 00 A(1,3) 00002 NUMTRM(2) 00002 DEG(2,1,1) 00000 DEG(2,2,1) 1.0D 00 A(2,1) 00000 DEG(2,1,2) 00001 DEG(2,2,2) -1.0D 00 A(2,2) -2.0D 00 D0(1,1) 2.0D 00 D0(2,1) -2.0D 00 D0(1,2) 2.0D 00 D0(2,2) Test problem no. 2 -- a counterexample to a method of Branin 00002 N 00002 NUMTRM(1) 00001 DEG(1,1,1) 00000 DEG(1,2,1) 4.0D 00 A(1,1) 00000 DEG(1,1,2) 00001 DEG(1,2,2) 4.0D 00 A(1,2) 00008 NUMTRM(2) 00003 DEG(2,1,1) 00000 DEG(2,2,1) 1.0D 00 A(2,1) 00000 DEG(2,1,2) 00003 DEG(2,2,2) -1.0D 00 A(2,2) 00001 DEG(2,1,3) 00002 DEG(2,2,3) 1.0D 00 A(2,3) 00002 DEG(2,1,4) 00001 DEG(2,2,4) -1.0D 00 A(2,4) 00002 DEG(2,1,5) 00000 DEG(2,2,5) -4.0D 00 A(2,5) 00001 DEG(2,1,6) 00001 DEG(2,2,6) 4.0D 00 A(2,6) 00001 DEG(2,1,7) 00000 DEG(2,2,7) 7.0D 00 A(2,7) 00000 DEG(2,1,8) 00001 DEG(2,2,8) 1.0D 00 A(2,8) -2.0D 00 D0(1,1) 2.0D 00 D0(2,1) -2.0D 00 D0(1,2) 2.0D 00 D0(2,2) Test problem no. 9 -- circle-circle intersection.......... 00002 N 00005 NUMTRM(1) 00002 DEG(1,1,1) 00000 DEG(1,2,1) .100000000D 01 A(1,1) 00001 DEG(1,1,2) 00000 DEG(1,2,2 ) -.200000000D 03 A(1,2) 00000 DEG(1,1,3) 00002 DEG(1,2,3) .100000000D 01 A(1,3) 00000 DEG(1,1,4) 00001 DEG(1,2,4) -.105788612D 01 A(1,4) 00000 DEG(1,1,5) 00000 DEG(1,2,5) .100027344D 03 A(1,5) 00005 NUMTRM(2) 00002 DEG(2,1,1) 00000 DEG(2,2,1) .100000000D 01 A(2,1) 00001 DEG(2,1,2) 00000 DEG(2,2,2) .200000000D 03 A(2,2) 00000 DEG(2,1,3) 00002 DEG(2,2,3) .100000000D 01 A(2,3) 00000 DEG(2,1,4) 00001 DEG(2,2,4) -.100000000D 01 A(2,4) 00000 DEG(2,1,5) 00000 DEG(2,2,5) -.100000000D 03 A(2,5) 0.0D 00 D0(1,1) 1.0D 00 D0(2,1) 0.0D 00 D0(1,2) 1.0D 00 D0(2,2) Test problem no. 10 -- A combustion chemistry problem..... 00004 N 00005 NUMTRM(1) 00000 DEG(1,1,1) 00001 DEG(1,2,1) 00000 DEG(1,3,1) 00001 DEG(1,4,1) -1.6970D 07 A(1,1) 00000 DEG(1,1,2) 00001 DEG(1,2,2) 00000 DEG(1,3,2) 00000 DEG(1,4,2) 2.1770D 07 A(1,2) 00001 DEG(1,1,3) 00000 DEG(1,2,3) 00000 DEG(1,3,3) 00001 DEG(1,4,3) 0.5500D 00 A(1,3) 00001 DEG(1,1,4) 00000 DEG(1,2,4) 00000 DEG(1,3,4) 00000 DEG(1,4,4) 0.45000D 00 A(1,4) 00000 DEG(1,1,5) 00000 DEG(1,2,5) 00000 DEG(1,3,5) 00001 DEG(1,4,5) -1.00000D 00 A(1,5) 00007 NUMTRM(2) 00000 DEG(2,1,1) 00001 DEG(2,2,1) 00000 DEG(2,3,1) 00001 DEG(2,4,1) 1.58500D 14 A(2,1) 00001 DEG(2,1,2) 00000 DEG(2,2,2) 00001 DEG(2,3,2) 00000 DEG(2,4,2) 4.12600D 07 A(2,2) 00001 DEG(2,1,3) 00000 DEG(2,2,3) 00000 DEG(2,3,3) 00001 DEG(2,4,3) -8.28500D 06 A(2,3) 00000 DEG(2,1,4) 00000 DEG(2,2,4) 00001 DEG(2,3,4) 00001 DEG(2,4,4) 2.28400D 07 A(2,4) 00000 DEG(2,1,5) 00000 DEG(2,2,5) 00001 DEG(2,3,5) 00000 DEG(2,4,5) -1.91800D 07 A(2,5) 00000 DEG(2,1,6) 00000 DEG(2,2,6) 00000 DEG(2,3,6) 00001 DEG(2,4,6) 48.4000D 00 A(2,6) 00000 DEG(2,1,7) 00000 DEG(2,2,7) 00000 DEG(2,3,7) 00000 DEG(2,4,7) -27.7300D 00 A(2,7) 00002 NUMTRM(3) 00002 DEG(3,1,1) 00000 DEG(3,2,1) 00000 DEG(3,3,1) 00000 DEG(3,4,1) 1.00000D 00 A(3,1) 00000 DEG(3,1,2) 00001 DEG(3,2,2) 00000 DEG(3,3,2) 00000 DEG(3,4,2) -1.00000D 00 A(3,2) 00002 NUMTRM(4) 00000 DEG(4,1,1) 00000 DEG(4,2,1) 00000 DEG(4,3,1) 00002 DEG(4,4,1) 1.00000D 00 A(4,1) 00000 DEG(4,1,2) 00000 DEG(4,2,2) 00001 DEG(4,3,2) 00000 DEG(4,4,2) -1.00000D 00 A(4,2) 0.0D 00 D0(1,1) 1.0D 00 D0(2,1) 0.0D 00 D0(1,2) 1.0D 00 D0(2,2) 0.0D 00 D0(1,3) 1.0D 00 D0(2,3) 0.0D 00 D0(1,4) 1.0D 00 D0(2,4) Test problem no. 12 -- a numerical bifurcation problem.... 00003 N 00004 NUMTRM(1) 00009 DEG(1,1,1) 00000 DEG(1,2,1) 00000 DEG(1,3,1) .500000D 01 A(1,1) 00005 DEG(1,1,2) 00002 DEG(1,2,2) 00000 DEG(1,3,2) -.600000D 01 A(1,2) 00001 DEG(1,1,3) 00004 DEG(1,2,3) 00000 DEG(1,3,3) .100000D 01 A(1,3) 00001 DEG(1,1,4) 00000 DEG(1,2,4) 00001 DEG(1,3,4) .200000D 01 A(1,4) 00003 NUMTRM(2) 00006 DEG(2,1,1) 00001 DEG(2,2,1) 00000 DEG(2,3,1) -.200000D 01 A(2,1) 00002 DEG(2,1,2) 00003 DEG(2,2,2) 00000 DEG(2,3,2) .200000D 01 A(2,2) 00000 DEG(2,1,3) 00001 DEG(2,2,3) 00001 DEG(2,3,3) .200000D 01 A(2,3) 00003 NUMTRM(3) 00002 DEG(3,1,1) 00000 DEG(3,2,1) 00000 DEG(3,3,1) .100000D 01 A(3,1) 00000 DEG(3,1,2) 00002 DEG(3,2,2) 00000 DEG(3,3,2) .100000D 01 A(3,2) 00000 DEG(3,1,3) 00000 DEG(3,2,3) 00000 DEG(3,3,3) -.265625D 00 A(3,3) -0.6D 00 D0(1,1) 0.6D 00 D0(2,1) -0.6D 00 D0(1,2) 0.6D 00 D0(2,2) -5.0D 00 D0(1,3) 5.0D 00 D0(2,3) Test problem no. 14 -- two intersecting parabolas......... 00002 N 00002 NUMTRM(1) 00002 DEG(1,1,1) 00000 DEG(1,2,1) +.10000D 01 A(1,1) 00000 DEG(1,1,2) 00001 DEG(1,2,2) -.40000D 01 A(1,2) 00003 NUMTRM(2) 00000 DEG(2,1,1) 00002 DEG(2,2,1) +.10000D 01 A(2,1) 00001 DEG(2,1,2) 00000 DEG(2,2,2) -.20000D 01 A(2,2) 00000 DEG(2,1,3) 00001 DEG(2,2,3) +.40000D 01 A(2,3) -.400000+01 D0(1,1) +.400000+01 D0(2,1) -.400000+01 D0(1,2) +.400000+01 D0(2,2) Test problem no. 15 -- Rosenbrock's function.............. 00002 N 00002 NUMTRM(1) 00001 DEG(1,1,1) 00000 DEG(1,2,1) -.1D 01 A(1,1) 00000 DEG(1,1,2) 00000 DEG(1,2,2) .1D 01 A(1,2) 00002 NUMTRM(2) 00002 DEG(2,1,1) 00000 DEG(2,2,1) -.1D 02 A(2,1) 00000 DEG(2,1,2) 00001 DEG(2,2,2) .1D 02 A(2,2) -.4D 01 D0(1,1) .4D 01 D0(2,1) -.4D 01 D0(1,2) .4D 01 D0(2,2) Test problem no. 16 -- a variable-dimension system of quadrics 00004 N 00004 NUMTRM(1) 00002 DEG(1,1,1) 00000 DEG(1,2,1) 00000 DEG(1,3,1) 00000 DEG(1,4,1) .100D 01 A(1,1) 00001 DEG(1,1,2) 00000 DEG(1,2,2) 00000 DEG(1,3,2) 00000 DEG(1,4,2) -.200D 00 A(1,2) 00000 DEG(1,1,3) 00001 DEG(1,2,3) 00000 DEG(1,3,3) 00000 DEG(1,4,3) .100D 01 A(1,3) 00000 DEG(1,1,4) 00000 DEG(1,2,4) 00000 DEG(1,3,4) 00000 DEG(1,4,4) -.900D-01 A(1,4) 00004 NUMTRM(2) 00000 DEG(2,1,1) 00002 DEG(2,2,1) 00000 DEG(2,3,1) 00000 DEG(2,4,1) .100D 01 A(2,1) 00000 DEG(2,1,2) 00001 DEG(2,2,2) 00000 DEG(2,3,2) 00000 DEG(2,4,2) -.200D 00 A(2,2) 00000 DEG(2,1,3) 00000 DEG(2,2,3) 00001 DEG(2,3,3) 00000 DEG(2,4,3) .100D 01 A(2,3) 00000 DEG(2,1,4) 00000 DEG(2,2,4) 00000 DEG(2,3,4) 00000 DEG(2,4,4) -.900D-01 A(2,4) 00004 NUMTRM(3) 00000 DEG(3,1,1) 00000 DEG(3,2,1) 00002 DEG(3,3,1) 00000 DEG(3,4,1) .100D 01 A(3,1) 00000 DEG(3,1,2) 00000 DEG(3,2,2) 00001 DEG(3,3,2) 00000 DEG(3,4,2) -.200D 00 A(3,2) 00000 DEG(3,1,3) 00000 DEG(3,2,3) 00000 DEG(3,3,3) 00001 DEG(3,4,3) .100D 01 A(3,3) 00000 DEG(3,1,4) 00000 DEG(3,2,4) 00000 DEG(3,3,4) 00000 DEG(3,4,4) -.900D-01 A(3,4) 00004 NUMTRM(4) 00000 DEG(4,1,1) 00000 DEG(4,2,1) 00000 DEG(4,3,1) 00002 DEG(4,4,1) .100D 01 A(4,1) 00000 DEG(4,1,2) 00000 DEG(4,2,2) 00000 DEG(4,3,2) 00001 DEG(4,4,2) -.200D 00 A(4,2) 00001 DEG(4,1,3) 00000 DEG(4,2,3) 00000 DEG(4,3,3) 00000 DEG(4,4,3) .100D 01 A(4,3) 00000 DEG(4,1,4) 00000 DEG(4,2,4) 00000 DEG(4,3,4) 00000 DEG(4,4,4) -.900D-01 A(4,4) -0.2D 00 D0(1,1) 0.2D 00 D0(2,1) -0.2D 00 D0(1,2) 0.2D 00 D0(2,2) -0.2D 00 D0(1,3) 0.2D 00 D0(2,3) -0.2D 00 D0(1,4) 0.2D 00 D0(2,4) Test problem no. 17 -- Broyden's banded function with N=5. 00005 N 00005 NUMTRM(1) 00003 DEG(1,1,1) 00000 DEG(1,2,1) 00000 DEG(1,3,1) 00000 DEG(1,4,1) 00000 DEG(1,5,1) .500D 01 A(1,1) 00001 DEG(1,1,2) 00000 DEG(1,2,2) 00000 DEG(1,3,2) 00000 DEG(1,4,2) 00000 DEG(1,5,2) .200D 01 A(1,2) 00000 DEG(1,1,3) 00002 DEG(1,2,3) 00000 DEG(1,3,3) 00000 DEG(1,4,3) 00000 DEG(1,5,3) -.100D 01 A(1,3) 00000 DEG(1,1,4) 00001 DEG(1,2,4) 00000 DEG(1,3,4) 00000 DEG(1,4,4) 00000 DEG(1,5,4) -.100D 01 A(1,4) 00000 DEG(1,1,5) 00000 DEG(1,2,5) 00000 DEG(1,3,5) 00000 DEG(1,4,5) 00000 DEG(1,5,5) .100D 01 A(1,5) 00007 NUMTRM(2) 00002 DEG(2,1,1) 00000 DEG(2,2,1) 00000 DEG(2,3,1) 00000 DEG(2,4,1) 00000 DEG(2,5,1) -.100D 01 A(2,1) 00001 DEG(2,1,2) 00000 DEG(2,2,2) 00000 DEG(2,3,2) 00000 DEG(2,4,2) 00000 DEG(2,5,2) -.100D 01 A(2,2) 00000 DEG(2,1,3) 00003 DEG(2,2,3) 00000 DEG(2,3,3) 00000 DEG(2,4,3) 00000 DEG(2,5,3) .500D 01 A(2,3) 00000 DEG(2,1,4) 00001 DEG(2,2,4) 00000 DEG(2,3,4) 00000 DEG(2,4,4) 00000 DEG(2,5,4) .200D 01 A(2,4) 00000 DEG(2,1,5) 00000 DEG(2,2,5) 00002 DEG(2,3,5) 00000 DEG(2,4,5) 00000 DEG(2,5,5) -.100D 01 A(2,5) 00000 DEG(2,1,6) 00000 DEG(2,2,6) 00001 DEG(2,3,6) 00000 DEG(2,4,6) 00000 DEG(2,5,6) -.100D 01 A(2,6) 00000 DEG(2,1,7) 00000 DEG(2,2,7) 00000 DEG(2,3,7) 00000 DEG(2,4,7) 00000 DEG(2,5,7) .100D 01 A(2,7) 00009 NUMTRM(3) 00002 DEG(3,1,1) 00000 DEG(3,2,1) 00000 DEG(3,3,1) 00000 DEG(3,4,1) 00000 DEG(3,5,1) -.100D 01 A(3,1) 00001 DEG(3,1,2) 00000 DEG(3,2,2) 00000 DEG(3,3,2) 00000 DEG(3,4,2) 00000 DEG(3,5,2) -.100D 01 A(3,2) 00000 DEG(3,1,3) 00002 DEG(3,2,3) 00000 DEG(3,3,3) 00000 DEG(3,4,3) 00000 DEG(3,5,3) -.100D 01 A(3,3) 00000 DEG(3,1,4) 00001 DEG(3,2,4) 00000 DEG(3,3,4) 00000 DEG(3,4,4) 00000 DEG(3,5,4) -.100D 01 A(3,4) 00000 DEG(3,1,5) 00000 DEG(3,2,5) 00003 DEG(3,3,5) 00000 DEG(3,4,5) 00000 DEG(3,5,5) .500D 01 A(3,5) 00000 DEG(3,1,6) 00000 DEG(3,2,6) 00001 DEG(3,3,6) 00000 DEG(3,4,6) 00000 DEG(3,5,6) .200D 01 A(3,6) 00000 DEG(3,1,7) 00000 DEG(3,2,7) 00000 DEG(3,3,7) 00002 DEG(3,4,7) 00000 DEG(3,5,7) -.100D 01 A(3,7) 00000 DEG(3,1,8) 00000 DEG(3,2,8) 00000 DEG(3,3,8) 00001 DEG(3,4,8) 00000 DEG(3,5,8) -.100D 01 A(3,8) 00000 DEG(3,1,8) 00000 DEG(3,2,8) 00000 DEG(3,3,8) 00000 DEG(3,4,8) 00000 DEG(3,5,8) .100D 01 A(3,8) 00011 NUMTRM(4) 00002 DEG(4,1,1) 00000 DEG(4,2,1) 00000 DEG(4,3,1) 00000 DEG(4,4,1) 00000 DEG(4,5,1) -.100D 01 A(4,1) 00001 DEG(4,1,2) 00000 DEG(4,2,2) 00000 DEG(4,3,2) 00000 DEG(4,4,2) 00000 DEG(4,5,2) -.100D 01 A(4,2) 00000 DEG(4,1,3) 00002 DEG(4,2,3) 00000 DEG(4,3,3) 00000 DEG(4,4,3) 00000 DEG(4,5,3) -.100D 01 A(4,3) 00000 DEG(4,1,4) 00001 DEG(4,2,4) 00000 DEG(4,3,4) 00000 DEG(4,4,4) 00000 DEG(4,5,4) -.100D 01 A(4,4) 00000 DEG(4,1,5) 00000 DEG(4,2,5) 00002 DEG(4,3,5) 00000 DEG(4,4,5) 00000 DEG(4,5,5) -.100D 01 A(4,5) 00000 DEG(4,1,6) 00000 DEG(4,2,6) 00001 DEG(4,3,6) 00000 DEG(4,4,6) 00000 DEG(4,5,6) -.100D 01 A(4,6) 00000 DEG(4,1,7) 00000 DEG(4,2,7) 00000 DEG(4,3,7) 00003 DEG(4,4,7) 00000 DEG(4,5,7) .500D 01 A(4,7) 00000 DEG(4,1,8) 00000 DEG(4,2,8) 00000 DEG(4,3,8) 00001 DEG(4,4,8) 00000 DEG(4,5,8) .200D 01 A(4,8) 00000 DEG(4,1,9) 00000 DEG(4,2,9) 00000 DEG(4,3,9) 00000 DEG(4,4,8) 00002 DEG(4,5,9) -.100D 01 A(4,9) 00000 DEG(4,1,10) 00000 DEG(4,2,10) 00000 DEG(4,3,10) 00000 DEG(4,4,10) 00001 DEG(4,5,10) -.100D 01 A(4,10) 00000 DEG(4,1,11) 00000 DEG(4,2,11) 00000 DEG(4,3,11) 00000 DEG(4,4,11) 00000 DEG(4,5,11) .100D 01 A(4,11) 00011 NUMTRM(5) 00002 DEG(5,1,1) 00000 DEG(5,2,1) 00000 DEG(5,3,1) 00000 DEG(5,4,1) 00000 DEG(5,5,1) -.100D 01 A(5,1) 00001 DEG(5,1,2) 00000 DEG(5,2,2) 00000 DEG(5,3,2) 00000 DEG(5,4,2) 00000 DEG(5,5,2) -.100D 01 A(5,2) 00000 DEG(5,1,3) 00002 DEG(5,2,3) 00000 DEG(5,3,3) 00000 DEG(5,4,3) 00000 DEG(5,5,3) -.100D 01 A(5,3) 00000 DEG(5,1,4) 00001 DEG(5,2,4) 00000 DEG(5,3,4) 00000 DEG(5,4,4) 00000 DEG(5,5,4) -.100D 01 A(5,4) 00000 DEG(5,1,5) 00000 DEG(5,2,5) 00002 DEG(5,3,5) 00000 DEG(5,4,5) 00000 DEG(5,5,5) -.100D 01 A(5,5) 00000 DEG(5,1,6) 00000 DEG(5,2,6) 00001 DEG(5,3,6) 00000 DEG(5,4,6) 00000 DEG(5,5,6) -.100D 01 A(5,6) 00000 DEG(5,1,7) 00000 DEG(5,2,7) 00000 DEG(5,3,7) 00002 DEG(5,4,7) 00000 DEG(5,5,7) -.100D 01 A(5,7) 00000 DEG(5,1,8) 00000 DEG(5,2,8) 00000 DEG(5,3,8) 00001 DEG(5,4,8) 00000 DEG(5,5,8) -.100D 01 A(5,8) 00000 DEG(5,1,9) 00000 DEG(5,2,9) 00000 DEG(5,3,9) 00000 DEG(5,4,9) 00003 DEG(5,5,9) .500D 01 A(5,9) 00000 DEG(5,1,10) 00000 DEG(5,2,10) 00000 DEG(5,3,10) 00000 DEG(5,4,10) 00001 DEG(5,5,10) .200D 01 A(5,10) 00000 DEG(5,1,11) 00000 DEG(5,2,11) 00000 DEG(5,3,11) 00000 DEG(5,4,11) 00000 DEG(5,5,11) .100D 01 A(5,11) -1.0D 00 D0(1,1) 1.0D 00 D0(2,1) -1.0D 00 D0(1,2) 1.0D 00 D0(2,2) -1.0D 00 D0(1,3) 1.0D 00 D0(2,3) -1.0D 00 D0(1,4) 1.0D 00 D0(2,4) -1.0D 00 D0(1,5) 1.0D 00 D0(2,5) 1 DLSFLG (0 no del. list, 1 del. list) 2 PRTCON (1 ordinary, 2 extended, 3 1+path) 1 ITRFLG (presently unused) 2 PIVFLG (0 wid., 1 scl. wid., 2 max. sm.) 1 JACFLG (0 ordinary, 1 transpose) 1 ADJFLG (0 no expansion/del., 1 exp./del.) .6d0 TOL1 (good vol. ratio. in iteration) -.1d0 TOL2 (extremely good vol. rat. in it.) 0d0 TOL3 (presently unused) 1.0D-05 EPSMIN (domain tolerance times 16) 1.0D-10 EPSF (range tolerance) 10000 MAXFT (max. no. calls to inclusion tst.) 0 IECHO (0 no echo, 1 config., 2 all) 1 IPTFMT (0 lg, 1 med, 2 sh, 3 132) The interval arithmetic routines supplied with this package will be used. ************************************************************ Generalized bisection package Test problem no. 1: cubic-parabola......................... SUCCESSFUL COMPLETION OF BINARY SEARCH. After ROOTS: Number of roots found: 3 Number of leaves: 6 Number of adjusted boxes: 4 Number of boxes deleted due to redundancy: 2 Maximum binary tree level reached: 4 Maximum stack depth reached: 3 Number of ftest calls: 8 Number of interval function calls to determine the range: 22 Number of Jacobian calls: 21 Number of function calls to do the interval Newton method: 21 LIST OF ROOT-CONTAINING BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 7 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.999999993D+00 0.100000001D+01 0.999999970D+00 0.100000003D+01 Approximate root: 0.100000000D+01 0.100000000D+01 Euclidean norm of residual at approximate root: 0.184740490D-07 Interval residual vector: -0.147532542D-06 0.184097203D-06 -0.470687525D-07 0.523780047D-07 Residual vector at approx. root: 0.182823261D-07 0.265462585D-08 Resolved box number: 6 Box added at level: 3 Reason: underwent expansion step BOX NUMBER 2 Pointer in the linked list 6 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.139698386D-08 0.232830644D-08 -0.838173271D-08 0.651912543D-08 Approximate root: 0.465661287D-09 -0.931303639D-09 Euclidean norm of residual at approximate root: 0.104124183D-08 Interval residual vector: -0.135040447D-07 0.125726843D-07 -0.651912543D-08 0.838173272D-08 Residual vector at approx. root: -0.465680223D-09 0.931303639D-09 Resolved box number: 5 Box added at level: 4 Reason: underwent expansion step BOX NUMBER 3 Pointer in the linked list 4 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.753682961D+00 -0.734871669D+00 0.535426747D+00 0.596081562D+00 Approximate root: -0.750063473D+00 0.562561733D+00 Euclidean norm of residual at approximate root: 0.301655964D-03 Interval residual vector: -0.103948820D+00 0.138192421D+00 -0.560451918D-01 0.326112588D-01 Residual vector at approx. root: -0.299792321D-03 0.334796186D-04 Resolved box number: 2 Box added at level: 4 Reason: test signalled unique root LIST OF DELETED BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 5 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.100000000D+01 0.100000000D+01 0.100000000D+01 0.100000000D+01 Approximate root: 0.100000000D+01 0.100000000D+01 Euclidean norm of residual at approximate root: 0.116586745D-10 Interval residual vector: -0.105779621D-09 0.838678293D-10 -0.470131017D-10 0.390443511D-10 Residual vector at approx. root: -0.109567910D-10 -0.398414635D-11 Resolved box number: 4 Box added at level: 4 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 7 BOX NUMBER 2 Pointer in the linked list 3 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.197093959D-11 0.118256376D-11 -0.212860384D-10 0.165558077D-10 Approximate root: -0.394187918D-12 -0.236511538D-11 Euclidean norm of residual at approximate root: 0.426377743D-11 Interval residual vector: -0.201034989D-10 0.271988572D-10 -0.165558077D-10 0.212860384D-10 Residual vector at approx. root: 0.354767913D-11 0.236511538D-11 Resolved box number: 1 Box added at level: 4 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 6 ************************************************************ Generalized bisection package Test problem no. 2 -- a counterexample to a method of Branin SUCCESSFUL COMPLETION OF BINARY SEARCH. After ROOTS: Number of roots found: 1 Number of leaves: 24 Number of adjusted boxes: 4 Number of boxes deleted due to redundancy: 3 Maximum binary tree level reached: 9 Maximum stack depth reached: 5 Number of ftest calls: 41 Number of interval function calls to determine the range: 67 Number of Jacobian calls: 50 Number of function calls to do the interval Newton method: 50 LIST OF ROOT-CONTAINING BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 6 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.107508457D-06 0.179180761D-06 -0.104588895D-06 0.174314825D-06 Approximate root: 0.358361522D-07 0.348629650D-07 Euclidean norm of residual at approximate root: 0.402004344D-06 Interval residual vector: -0.848389407D-06 0.141398234D-05 -0.857148295D-06 0.142858028D-05 Residual vector at approx. root: 0.282796469D-06 0.285716030D-06 Resolved box number: 21 Box added at level: 6 Reason: underwent expansion step LIST OF DELETED BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 5 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.959985050D-08 0.159997508D-07 -0.160012338D-07 0.960074028D-08 Approximate root: 0.319995017D-08 -0.320024676D-08 Euclidean norm of residual at approximate root: 0.191994044D-07 Interval residual vector: -0.102404337D-06 0.102401964D-06 -0.832001893D-07 0.121598997D-06 Residual vector at approx. root: -0.118638023D-11 0.191994043D-07 Resolved box number: 7 Box added at level: 6 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 6 BOX NUMBER 2 Pointer in the linked list 4 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.133603154D-09 0.801618923D-10 -0.801622831D-10 0.133603805D-09 Approximate root: -0.267206308D-10 0.267207610D-10 Euclidean norm of residual at approximate root: 0.160323654D-09 Interval residual vector: -0.855061748D-09 0.855062790D-09 -0.101538436D-08 0.694737051D-09 Residual vector at approx. root: 0.521134480D-15 -0.160323654D-09 Resolved box number: 3 Box added at level: 3 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 5 BOX NUMBER 3 Pointer in the linked list 3 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.743550484D-10 0.446130291D-10 -0.767505690D-10 0.460503414D-10 Approximate root: -0.148710097D-10 -0.153501138D-10 Euclidean norm of residual at approximate root: 0.169943197D-09 Interval residual vector: -0.604422470D-09 0.362653482D-09 -0.597235908D-09 0.358341545D-09 Residual vector at approx. root: -0.120884494D-09 -0.119447182D-09 Resolved box number: 2 Box added at level: 4 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 4 ************************************************************ Generalized bisection package Test problem no. 9 -- circle-circle intersection.......... SUCCESSFUL COMPLETION OF BINARY SEARCH. After ROOTS: Number of roots found: 2 Number of leaves: 3 Number of adjusted boxes: 0 Number of boxes deleted due to redundancy: 0 Maximum binary tree level reached: 3 Maximum stack depth reached: 2 Number of ftest calls: 3 Number of interval function calls to determine the range: 12 Number of Jacobian calls: 12 Number of function calls to do the interval Newton method: 12 LIST OF ROOT-CONTAINING BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 4 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.499997045D+00 0.500000066D+00 0.478687548D+00 0.483766122D+00 Approximate root: 0.499998555D+00 0.481226835D+00 Euclidean norm of residual at approximate root: 0.141853587D-03 Interval residual vector: -0.529977489D-02 0.556778256D-02 -0.521827726D-02 0.535530127D-02 Residual vector at approx. root: 0.127555858D-03 0.620640266D-04 Resolved box number: 3 Box added at level: 2 Reason: test signalled unique root BOX NUMBER 2 Pointer in the linked list 3 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.499989058D+00 0.499989504D+00 0.546178836D+00 0.546646168D+00 Approximate root: 0.499989281D+00 0.546412502D+00 Euclidean norm of residual at approximate root: 0.155499915D-05 Interval residual vector: -0.545787360D-03 0.548902128D-03 -0.534163707D-03 0.533473753D-03 Residual vector at approx. root: 0.150278423D-05 -0.399577161D-06 Resolved box number: 1 Box added at level: 3 Reason: test signalled unique root No boxes were deleted from the list. ************************************************************ Generalized bisection package Test problem no. 10 -- A combustion chemistry problem..... SUCCESSFUL COMPLETION OF BINARY SEARCH. After ROOTS: Number of roots found: 1 Number of leaves: 50 Number of adjusted boxes: 0 Number of boxes deleted due to redundancy: 0 Maximum binary tree level reached: 22 Maximum stack depth reached: 21 Number of ftest calls: 87 Number of interval function calls to determine the range: 140 Number of Jacobian calls: 112 Number of function calls to do the interval Newton method: 112 LIST OF ROOT-CONTAINING BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 3 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.158798143D-03 0.158799788D-03 0.252170590D-07 0.252170590D-07 0.147861787D+00 0.147861788D+00 0.384528006D+00 0.384528006D+00 Approximate root: 0.158798965D-03 0.252170590D-07 0.147861788D+00 0.384528006D+00 Euclidean norm of residual at approximate root: 0.857319939D-05 Interval residual vector: -0.173860831D-08 0.173472503D-08 -0.113504421D-01 0.113332946D-01 -0.208712194D-12 0.313567457D-12 -0.677752021D-10 0.677756878D-10 Residual vector at approx. root: -0.194162741D-11 -0.857319939D-05 0.524269558D-13 0.249800181D-15 Resolved box number: 43 Box added at level: 8 Reason: test signalled unique root No boxes were deleted from the list. ************************************************************ Generalized bisection package Test problem no. 12 -- a numerical bifurcation problem.... SUCCESSFUL COMPLETION OF BINARY SEARCH. After ROOTS: Number of roots found: 12 Number of leaves: 196 Number of adjusted boxes: 20 Number of boxes deleted due to redundancy: 12 Maximum binary tree level reached: 13 Maximum stack depth reached: 9 Number of ftest calls: 375 Number of interval function calls to determine the range: 717 Number of Jacobian calls: 575 Number of function calls to do the interval Newton method: 574 LIST OF ROOT-CONTAINING BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 26 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.466980011D+00 0.466980011D+00 0.218070331D+00 0.218070331D+00 -0.211875963D-11 0.353126605D-11 Approximate root: 0.466980011D+00 0.218070331D+00 0.706253211D-12 Euclidean norm of residual at approximate root: 0.728030589D-12 Interval residual vector: -0.658626599D-10 0.671819584D-10 -0.326912729D-10 0.333072454D-10 -0.348077983D-09 0.348089710D-09 Residual vector at approx. root: 0.659650916D-12 0.307984977D-12 0.587030424D-14 Resolved box number: 190 Box added at level: 10 Reason: underwent expansion step BOX NUMBER 2 Pointer in the linked list 25 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.198852509D-09 0.331420848D-09 0.515388203D+00 0.515388203D+00 -0.151889304D-10 0.253148841D-10 Approximate root: 0.662841697D-10 0.515388203D+00 0.506297682D-11 Euclidean norm of residual at approximate root: 0.137626370D-10 Interval residual vector: -0.140303650D-10 0.233839417D-10 -0.156563911D-10 0.260939853D-10 -0.850213094D-10 0.108711609D-09 Residual vector at approx. root: 0.467678834D-11 0.521879705D-11 0.118449139D-10 Resolved box number: 182 Box added at level: 8 Reason: underwent expansion step BOX NUMBER 3 Pointer in the linked list 23 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.515388181D+00 0.515388232D+00 -0.764992691D-07 0.127498782D-06 -0.124456135D-01 -0.124455866D-01 Approximate root: 0.515388206D+00 0.254997564D-07 -0.124456000D-01 Euclidean norm of residual at approximate root: 0.360167070D-08 Interval residual vector: -0.207774855D-07 0.195670883D-07 -0.795266699D-08 0.477160020D-08 -0.229383880D-07 0.292869396D-07 Residual vector at approx. root: -0.605197456D-09 -0.159053243D-08 0.317426754D-08 Resolved box number: 166 Box added at level: 10 Reason: underwent expansion step BOX NUMBER 4 Pointer in the linked list 21 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.270771257D+00 0.289336146D+00 0.427952364D+00 0.436307642D+00 -0.147557267D-01 -0.135898718D-01 Approximate root: 0.280053701D+00 0.432130003D+00 -0.141727993D-01 Euclidean norm of residual at approximate root: 0.461358016D-03 Interval residual vector: -0.173361542D-02 0.159730327D-02 -0.189535369D-02 0.193741733D-02 -0.916470091D-02 0.845476363D-02 Residual vector at approx. root: -0.498351184D-04 -0.820973862D-05 -0.458585085D-03 Resolved box number: 152 Box added at level: 10 Reason: test signalled unique root BOX NUMBER 5 Pointer in the linked list 20 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.466980011D+00 0.466980011D+00 -0.218070331D+00 -0.218070331D+00 -0.211875963D-11 0.353126605D-11 Approximate root: 0.466980011D+00 -0.218070331D+00 0.706253211D-12 Euclidean norm of residual at approximate root: 0.728030589D-12 Interval residual vector: -0.658626599D-10 0.671819584D-10 -0.333072454D-10 0.326912729D-10 -0.348077983D-09 0.348089710D-09 Residual vector at approx. root: 0.659650916D-12 -0.307984977D-12 0.587030424D-14 Resolved box number: 144 Box added at level: 10 Reason: underwent expansion step BOX NUMBER 6 Pointer in the linked list 19 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.198852509D-09 0.331420848D-09 -0.515388203D+00 -0.515388203D+00 -0.151889304D-10 0.253148841D-10 Approximate root: 0.662841697D-10 -0.515388203D+00 0.506297682D-11 Euclidean norm of residual at approximate root: 0.137626370D-10 Interval residual vector: -0.140303650D-10 0.233839417D-10 -0.260939853D-10 0.156563911D-10 -0.850213094D-10 0.108711609D-09 Residual vector at approx. root: 0.467678834D-11 -0.521879705D-11 0.118449139D-10 Resolved box number: 130 Box added at level: 8 Reason: underwent expansion step BOX NUMBER 7 Pointer in the linked list 16 Point Newton method succeeded with NITR = 2 Containing intervals for the coordinates: 0.270771257D+00 0.289336146D+00 -0.436307642D+00 -0.427952364D+00 -0.147557267D-01 -0.135898718D-01 Approximate root: 0.279853847D+00 -0.432790134D+00 -0.141891944D-01 Euclidean norm of residual at approximate root: 0.488012189D-06 Interval residual vector: -0.173361542D-02 0.159730327D-02 -0.193741733D-02 0.189535369D-02 -0.916470091D-02 0.845476363D-02 Residual vector at approx. root: 0.108417018D-06 0.988905356D-08 0.475714046D-06 Resolved box number: 109 Box added at level: 10 Reason: test signalled unique root BOX NUMBER 8 Pointer in the linked list 13 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.466980011D+00 -0.466980011D+00 0.218070331D+00 0.218070331D+00 -0.211875963D-11 0.353126605D-11 Approximate root: -0.466980011D+00 0.218070331D+00 0.706253211D-12 Euclidean norm of residual at approximate root: 0.728030589D-12 Interval residual vector: -0.671819584D-10 0.658626599D-10 -0.326912729D-10 0.333072454D-10 -0.348077983D-09 0.348089710D-09 Residual vector at approx. root: -0.659650916D-12 0.307984977D-12 0.587030424D-14 Resolved box number: 84 Box added at level: 10 Reason: underwent expansion step BOX NUMBER 9 Pointer in the linked list 11 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.289336146D+00 -0.270771257D+00 0.427952364D+00 0.436307642D+00 -0.147557267D-01 -0.135898718D-01 Approximate root: -0.280053701D+00 0.432130003D+00 -0.141727993D-01 Euclidean norm of residual at approximate root: 0.461358016D-03 Interval residual vector: -0.159730327D-02 0.173361542D-02 -0.189535369D-02 0.193741733D-02 -0.916470091D-02 0.845476363D-02 Residual vector at approx. root: 0.498351184D-04 -0.820973862D-05 -0.458585085D-03 Resolved box number: 70 Box added at level: 10 Reason: test signalled unique root BOX NUMBER 10 Pointer in the linked list 9 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.515388232D+00 -0.515388181D+00 -0.764992691D-07 0.127498782D-06 -0.124456135D-01 -0.124455866D-01 Approximate root: -0.515388206D+00 0.254997564D-07 -0.124456000D-01 Euclidean norm of residual at approximate root: 0.360167070D-08 Interval residual vector: -0.195670883D-07 0.207774855D-07 -0.795266699D-08 0.477160020D-08 -0.229383880D-07 0.292869396D-07 Residual vector at approx. root: 0.605197456D-09 -0.159053243D-08 0.317426754D-08 Resolved box number: 52 Box added at level: 10 Reason: underwent expansion step BOX NUMBER 11 Pointer in the linked list 7 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.466980011D+00 -0.466980011D+00 -0.218070331D+00 -0.218070331D+00 -0.211875963D-11 0.353126605D-11 Approximate root: -0.466980011D+00 -0.218070331D+00 0.706253211D-12 Euclidean norm of residual at approximate root: 0.728030589D-12 Interval residual vector: -0.671819584D-10 0.658626599D-10 -0.333072454D-10 0.326912729D-10 -0.348077983D-09 0.348089710D-09 Residual vector at approx. root: -0.659650916D-12 -0.307984977D-12 0.587030424D-14 Resolved box number: 38 Box added at level: 10 Reason: underwent expansion step BOX NUMBER 12 Pointer in the linked list 6 Point Newton method succeeded with NITR = 2 Containing intervals for the coordinates: -0.289336146D+00 -0.270771257D+00 -0.436307642D+00 -0.427952364D+00 -0.147557267D-01 -0.135898718D-01 Approximate root: -0.279853847D+00 -0.432790134D+00 -0.141891944D-01 Euclidean norm of residual at approximate root: 0.488012189D-06 Interval residual vector: -0.159730327D-02 0.173361542D-02 -0.193741733D-02 0.189535369D-02 -0.916470091D-02 0.845476363D-02 Residual vector at approx. root: -0.108417018D-06 0.988905356D-08 0.475714046D-06 Resolved box number: 27 Box added at level: 10 Reason: test signalled unique root LIST OF DELETED BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 24 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.466980011D+00 0.466980011D+00 0.218070331D+00 0.218070331D+00 -0.313039671D-11 0.187823802D-11 Approximate root: 0.466980011D+00 0.218070331D+00 -0.626079342D-12 Euclidean norm of residual at approximate root: 0.641599200D-12 Interval residual vector: -0.528160693D-10 0.516637723D-10 -0.265449555D-10 0.259804553D-10 -0.272001366D-09 0.272013426D-09 Residual vector at approx. root: -0.576150260D-12 -0.282248356D-12 0.602295991D-14 Resolved box number: 167 Box added at level: 10 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 26 BOX NUMBER 2 Pointer in the linked list 22 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.207740665D-10 0.346234441D-10 0.515388203D+00 0.515388203D+00 -0.106562067D-11 0.639372400D-12 Approximate root: 0.692468883D-11 0.515388203D+00 -0.213124133D-12 Euclidean norm of residual at approximate root: 0.141433084D-11 Interval residual vector: -0.146574834D-11 0.244291391D-11 -0.109841664D-11 0.659049985D-12 -0.983992055D-11 0.124582011D-10 Residual vector at approx. root: 0.488582781D-12 -0.219683328D-12 0.130895295D-11 Resolved box number: 156 Box added at level: 12 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 25 BOX NUMBER 3 Pointer in the linked list 18 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.515388181D+00 0.515388232D+00 -0.127498782D-06 0.764992691D-07 -0.124456135D-01 -0.124455866D-01 Approximate root: 0.515388206D+00 -0.254997564D-07 -0.124456000D-01 Euclidean norm of residual at approximate root: 0.360167070D-08 Interval residual vector: -0.207774855D-07 0.195670883D-07 -0.477160020D-08 0.795266699D-08 -0.229383880D-07 0.292869396D-07 Residual vector at approx. root: -0.605197456D-09 0.159053243D-08 0.317426754D-08 Resolved box number: 127 Box added at level: 10 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 23 BOX NUMBER 4 Pointer in the linked list 14 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.331420848D-09 0.198852509D-09 0.515388203D+00 0.515388203D+00 -0.151889304D-10 0.253148841D-10 Approximate root: -0.662841697D-10 0.515388203D+00 0.506297682D-11 Euclidean norm of residual at approximate root: 0.137626370D-10 Interval residual vector: -0.233839417D-10 0.140303650D-10 -0.156563911D-10 0.260939853D-10 -0.850213094D-10 0.108711609D-09 Residual vector at approx. root: -0.467678834D-11 0.521879705D-11 0.118449139D-10 Resolved box number: 98 Box added at level: 8 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 22 BOX NUMBER 5 Pointer in the linked list 17 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.466980011D+00 0.466980011D+00 -0.218070331D+00 -0.218070331D+00 -0.313039671D-11 0.187823802D-11 Approximate root: 0.466980011D+00 -0.218070331D+00 -0.626079342D-12 Euclidean norm of residual at approximate root: 0.641599200D-12 Interval residual vector: -0.528160693D-10 0.516637723D-10 -0.259804553D-10 0.265449555D-10 -0.272001366D-09 0.272013426D-09 Residual vector at approx. root: -0.576150260D-12 0.282248356D-12 0.602295991D-14 Resolved box number: 126 Box added at level: 10 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 20 BOX NUMBER 6 Pointer in the linked list 15 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.207740665D-10 0.346234441D-10 -0.515388203D+00 -0.515388203D+00 -0.106562067D-11 0.639372400D-12 Approximate root: 0.692468883D-11 -0.515388203D+00 -0.213124133D-12 Euclidean norm of residual at approximate root: 0.141433084D-11 Interval residual vector: -0.146574834D-11 0.244291391D-11 -0.659049985D-12 0.109841664D-11 -0.983992055D-11 0.124582011D-10 Residual vector at approx. root: 0.488582781D-12 0.219683328D-12 0.130895295D-11 Resolved box number: 102 Box added at level: 12 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 19 BOX NUMBER 7 Pointer in the linked list 8 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.331420848D-09 0.198852509D-09 -0.515388203D+00 -0.515388203D+00 -0.151889304D-10 0.253148841D-10 Approximate root: -0.662841697D-10 -0.515388203D+00 0.506297682D-11 Euclidean norm of residual at approximate root: 0.137626370D-10 Interval residual vector: -0.233839417D-10 0.140303650D-10 -0.260939853D-10 0.156563911D-10 -0.850213094D-10 0.108711609D-09 Residual vector at approx. root: -0.467678834D-11 -0.521879705D-11 0.118449139D-10 Resolved box number: 46 Box added at level: 8 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 15 BOX NUMBER 8 Pointer in the linked list 12 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.401747837D-06 0.241048702D-06 0.515388057D+00 0.515388389D+00 -0.156867371D-07 0.941204227D-08 Approximate root: -0.803495675D-07 0.515388223D+00 -0.313734742D-08 Euclidean norm of residual at approximate root: 0.217080022D-07 Interval residual vector: -0.283460263D-07 0.170076239D-07 -0.161695243D-07 0.970175880D-08 -0.150574544D-06 0.191981967D-06 Residual vector at approx. root: -0.566919594D-08 -0.323390206D-08 0.207036096D-07 Resolved box number: 78 Box added at level: 12 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 14 BOX NUMBER 9 Pointer in the linked list 10 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.466980011D+00 -0.466980011D+00 0.218070331D+00 0.218070331D+00 -0.313039671D-11 0.187823802D-11 Approximate root: -0.466980011D+00 0.218070331D+00 -0.626079342D-12 Euclidean norm of residual at approximate root: 0.641599200D-12 Interval residual vector: -0.516637723D-10 0.528160693D-10 -0.265449555D-10 0.259804553D-10 -0.272001366D-09 0.272013426D-09 Residual vector at approx. root: 0.576150260D-12 -0.282248356D-12 0.602295991D-14 Resolved box number: 53 Box added at level: 10 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 13 BOX NUMBER 10 Pointer in the linked list 4 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.515388232D+00 -0.515388181D+00 -0.127498782D-06 0.764992691D-07 -0.124456135D-01 -0.124455866D-01 Approximate root: -0.515388206D+00 -0.254997564D-07 -0.124456000D-01 Euclidean norm of residual at approximate root: 0.360167070D-08 Interval residual vector: -0.195670883D-07 0.207774855D-07 -0.477160020D-08 0.795266699D-08 -0.229383880D-07 0.292869396D-07 Residual vector at approx. root: 0.605197456D-09 0.159053243D-08 0.317426754D-08 Resolved box number: 13 Box added at level: 10 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 9 BOX NUMBER 11 Pointer in the linked list 5 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.401747837D-06 0.241048702D-06 -0.515388389D+00 -0.515388057D+00 -0.156867371D-07 0.941204227D-08 Approximate root: -0.803495675D-07 -0.515388223D+00 -0.313734742D-08 Euclidean norm of residual at approximate root: 0.217080022D-07 Interval residual vector: -0.283460263D-07 0.170076239D-07 -0.970175880D-08 0.161695243D-07 -0.150574544D-06 0.191981967D-06 Residual vector at approx. root: -0.566919594D-08 0.323390206D-08 0.207036096D-07 Resolved box number: 24 Box added at level: 12 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 8 BOX NUMBER 12 Pointer in the linked list 3 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.466980011D+00 -0.466980011D+00 -0.218070331D+00 -0.218070331D+00 -0.313039671D-11 0.187823802D-11 Approximate root: -0.466980011D+00 -0.218070331D+00 -0.626079342D-12 Euclidean norm of residual at approximate root: 0.641599200D-12 Interval residual vector: -0.516637723D-10 0.528160693D-10 -0.259804553D-10 0.265449555D-10 -0.272001366D-09 0.272013426D-09 Residual vector at approx. root: 0.576150260D-12 0.282248356D-12 0.602295991D-14 Resolved box number: 12 Box added at level: 10 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 7 ************************************************************ Generalized bisection package Test problem no. 14 -- two intersecting parabolas......... SUCCESSFUL COMPLETION OF BINARY SEARCH. After ROOTS: Number of roots found: 2 Number of leaves: 8 Number of adjusted boxes: 3 Number of boxes deleted due to redundancy: 2 Maximum binary tree level reached: 6 Maximum stack depth reached: 3 Number of ftest calls: 13 Number of interval function calls to determine the range: 31 Number of Jacobian calls: 28 Number of function calls to do the interval Newton method: 28 LIST OF ROOT-CONTAINING BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 6 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.279329086D-11 0.465548476D-11 -0.119327242D-11 0.198878736D-11 Approximate root: 0.931096952D-12 0.397757472D-12 Euclidean norm of residual at approximate root: 0.161397213D-11 Interval residual vector: -0.795514945D-11 0.477308967D-11 -0.140840592D-10 0.135417312D-10 Residual vector at approx. root: -0.159102989D-11 -0.271164015D-12 Resolved box number: 6 Box added at level: 6 Reason: underwent expansion step BOX NUMBER 2 Pointer in the linked list 5 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.166368417D+01 0.171499114D+01 0.708805763D+00 0.727804579D+00 Approximate root: 0.168933765D+01 0.718305171D+00 Euclidean norm of residual at approximate root: 0.220268458D-01 Interval residual vector: -0.143373311D+00 0.105971550D+00 -0.923536129D-01 0.113549489D+00 Residual vector at approx. root: -0.193589822D-01 0.105076994D-01 Resolved box number: 5 Box added at level: 6 Reason: test signalled unique root LIST OF DELETED BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 4 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.299923679D-10 0.179954207D-10 -0.292219915D-11 0.487033192D-11 Approximate root: -0.599847358D-11 0.974066383D-12 Euclidean norm of residual at approximate root: 0.163638350D-10 Interval residual vector: -0.194813277D-10 0.116887966D-10 -0.476796380D-10 0.794660634D-10 Residual vector at approx. root: -0.389626553D-11 0.158932127D-10 Resolved box number: 4 Box added at level: 3 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 6 BOX NUMBER 2 Pointer in the linked list 3 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.254662645D-06 0.229080884D-06 -0.653331570D-07 0.391998942D-07 Approximate root: -0.127908804D-07 -0.130666314D-07 Euclidean norm of residual at approximate root: 0.586844646D-07 Interval residual vector: -0.156799577D-06 0.261332693D-06 -0.719494396D-06 0.666124870D-06 Residual vector at approx. root: 0.522665258D-07 -0.266847647D-07 Resolved box number: 3 Box added at level: 4 Reason: underwent expansion step Reason box deleted: 3 Pointer of intersecting box: 4 ************************************************************ Generalized bisection package Test problem no. 15 -- Rosenbrock's function.............. SUCCESSFUL COMPLETION OF BINARY SEARCH. After ROOTS: Number of roots found: 1 Number of leaves: 1 Number of adjusted boxes: 1 Number of boxes deleted due to redundancy: 0 Maximum binary tree level reached: 1 Maximum stack depth reached: 0 Number of ftest calls: 1 Number of interval function calls to determine the range: 2 Number of Jacobian calls: 2 Number of function calls to do the interval Newton method: 2 LIST OF ROOT-CONTAINING BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 3 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: 0.100000000D+01 0.100000000D+01 0.100000000D+01 0.100000000D+01 Approximate root: 0.100000000D+01 0.100000000D+01 Euclidean norm of residual at approximate root: 0.111022302D-15 Interval residual vector: -0.235922393D-15 0.277555756D-16 -0.932587341D-14 0.510702591D-14 Residual vector at approx. root: 0.111022302D-15 0.000000000D+00 Resolved box number: 1 Box added at level: 1 Reason: underwent expansion step No boxes were deleted from the list. ************************************************************ Generalized bisection package Test problem no. 16 -- a variable-dimension system of quad SUCCESSFUL COMPLETION OF BINARY SEARCH. After ROOTS: Number of roots found: 1 Number of leaves: 1 Number of adjusted boxes: 0 Number of boxes deleted due to redundancy: 0 Maximum binary tree level reached: 1 Maximum stack depth reached: 0 Number of ftest calls: 1 Number of interval function calls to determine the range: 2 Number of Jacobian calls: 2 Number of function calls to do the interval Newton method: 2 LIST OF ROOT-CONTAINING BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 3 Point Newton method succeeded with NITR = 2 Containing intervals for the coordinates: 0.823445622D-01 0.117740115D+00 0.952866222D-01 0.104798057D+00 0.978750353D-01 0.102209646D+00 0.983927181D-01 0.101691964D+00 Approximate root: 0.100000002D+00 0.100000002D+00 0.100000002D+00 0.100000002D+00 Euclidean norm of residual at approximate root: 0.358504834D-08 Interval residual vector: -0.114807740D-01 0.121918793D-01 -0.400503572D-02 0.413495436D-02 -0.246968854D-02 0.256376834D-02 -0.183127035D-01 0.184028273D-01 Residual vector at approx. root: 0.179242680D-08 0.179248912D-08 0.179258118D-08 0.179259958D-08 Resolved box number: 1 Box added at level: 1 Reason: test signalled unique root No boxes were deleted from the list. ************************************************************ Generalized bisection package Test problem no. 17 -- Broyden's banded function with N=5. SUCCESSFUL COMPLETION OF BINARY SEARCH. After ROOTS: Number of roots found: 1 Number of leaves: 39 Number of adjusted boxes: 0 Number of boxes deleted due to redundancy: 0 Maximum binary tree level reached: 11 Maximum stack depth reached: 5 Number of ftest calls: 76 Number of interval function calls to determine the range: 108 Number of Jacobian calls: 80 Number of function calls to do the interval Newton method: 80 LIST OF ROOT-CONTAINING BOXES FOLLOWS: BOX NUMBER 1 Pointer in the linked list 3 Point Newton method succeeded with NITR = 1 Containing intervals for the coordinates: -0.428399174D+00 -0.428208473D+00 -0.480437220D+00 -0.472948156D+00 -0.531193847D+00 -0.506070166D+00 -0.606159841D+00 -0.540108589D+00 -0.600805375D+00 -0.542046332D+00 Approximate root: -0.428303824D+00 -0.476692688D+00 -0.518632006D+00 -0.573134215D+00 -0.571425854D+00 Euclidean norm of residual at approximate root: 0.131763662D+00 Interval residual vector: -0.778173152D-02 0.775344124D-02 -0.467609635D-01 0.452820797D-01 -0.152324617D+00 0.156055570D+00 -0.434132133D+00 0.215859681D+00 -0.402572661D+00 0.210926042D+00 Residual vector at approx. root: -0.652113119D-07 -0.481373612D-03 0.419779963D-02 -0.987245462D-01 -0.871623399D-01 Resolved box number: 1 Box added at level: 5 Reason: test signalled unique root No boxes were deleted from the list. 0 MESSAGE SUMMARY: MESSAGE NUMBER - COUNT 0 208 44