PROGRAM MAINSP *********************************************************************** * * * This is a sample driver program for our mathematical software * * package CHABIS (CHAracteristic BISection) which solves systems * * of nonlinear (algebraic and/or transcendental) equations of the * * form * * - - - * * F ( X ) = 0 , * * where * * - T * * F = ( f1, f2, ... , fn ) is a continuous mapping of a * * bounded region in the real N-space into the real N-space. * * * * First, CHABIS locates at least one solution of the given system * * within an N-dimensional Polyhedron. Then it obtains an approxi- * * mate solution using a new generalized method of bisection. * * * * This driver program runs all the examples of the accompanying * * paper. It echoes the example number and the input values (ini- * * tial guess and stepsizes), and prints out the final approximate * * root. Also, it prints out performance information such as that * * given in the accompanying paper. It takes the input values from * * the file SINPUT and provides the print out in the file OUTPUT. * * * * * * CHABIS. Version of June 1988 * * Michael N. Vrahatis * * * *********************************************************************** INTRINSIC INT, FLOAT INTEGER NEXT, N, NFCALL, LIU, LOU, I, ICON, LWA, J, INF1, INF2 REAL DELTA, EPSILO, XO(9), H(9), AS(9), VAS(9) REAL WA(28178) CHARACTER*9 EXAMP CHARACTER*70 F1, F2 EXTERNAL FNC COMMON / BLK1 / NEXT, N, NFCALL * * The Logical Input Unit is assumed to be the number 7. * * DATA LIU / 7 / * * The Logical Output Unit is assumed to be the number 8. * * DATA LOU / 8 / * * Open the Input and Output files. * * OPEN ( UNIT = LIU, FILE = 'SINPUT', STATUS = 'OLD' ) OPEN ( UNIT = LOU, FILE = 'OUTPUT', STATUS = 'NEW' ) DO 10 I = 1, 24 * * Set the value of DELTA. DELTA is a positive variable which * * determines the accuracy of the computation of the roots, of * * the components of the given function, which are located on * * the edges of the Initial N-Polyhedron, and are used for the * * construction of a Characteristic N-Polyhedron. Note that if * * DELTA is less than the machine precision EPSMCH, or if DELTA * * is not defined, the default value of DELTA becomes equal to * * 0.0625 . The EPSMCH is computed within CHABIS. * * DELTA = 0.625E-1 * * Set the value of EPSILO , which is a nonnegative variable. * * Termination occurs when the algorithm estimates that the * * Infinity Norm, of the function values at an approximate * * solution, is at most EPSILO. If EPSILO is less than the * * machine precision EPSMCH, or if EPSILO is not defined, the * * default value of EPSILO becomes equal to EPSMCH. * * EPSILO = 1.0E-8 * * Set the condition variable ICON. Note that if ICON is equal * * to 1, then CHABIS attempts to find an approximate solution * * even if the default Characteristic N-Polyhedron construction * * fails. Otherwise, set ICON equal to another integer value. * * ICON = 1 * * Set the starting values. * * READ (LIU, *) EXAMP READ (LIU, *) F1, F2 READ (LIU, *) N READ (LIU, *) ( XO(J), J = 1, N ) READ (LIU, *) ( H(J), J = 1, N ) READ (LIU, *) NEXT * * Set the length LWA of the workspace array WA. Note that LWA * * must be at least equal to the value ( 2*N+(6*N+1)*2**N ). * * LWA = 2*N + (6*N+1) * 2**N * WRITE (LOU, 9999) EXAMP, F1, F2, N WRITE (LOU, 9998) ( XO(J), H(J), J = 1, N ) * * Call the interface subroutine INTSUB. * * NFCALL = 0 CALL INTSUB( FNC, N, XO, H, DELTA, EPSILO, ICON, INF1, + AS, VAS, INF2, WA, LWA) * IF ( INF1 .EQ. 0 ) THEN WRITE (LOU, 9997) ELSEIF ( INF1 .EQ. 2 .AND. ICON .NE. 1 ) THEN WRITE (LOU, 9996) N ELSE WRITE (LOU, 9995) DELTA, EPSILO, (AS(J), VAS(J), J = 1, N) ENDIF NFCALL = INT( FLOAT( NFCALL ) / FLOAT( N ) ) WRITE (LOU, 9994) INF1, INF2, NFCALL 10 CONTINUE STOP * * Format statements. * * 9999 FORMAT (//3X, 14('====='),//14X,' EXAMPLE ', A /15X,9('--')// + 3X, A / 3X, A //2X,' n =', I2 ) 9998 FORMAT (//2X,' INITIAL GUESS :', 17X, ' STEPSIZES :'// + 9( F16.7, 16X, F16.7 / ) ) 9997 FORMAT (//5X,' * * * IMPROPER INPUT PARAMETERS * * *'// ) 9996 FORMAT (//5X,'* * * THE CHARACTERISTIC', I2, '-POLYHEDRON HAS', + ' NOT BEEN COMPLETED * * *'// ) 9995 FORMAT (//2X,' DELTA = ',F20.18 //2X,' EPSILO = ',F20.18 + ////2X,' FINAL APPROXIMATE SOLUTION :', 5X, + 'VERIFICATION OF THE SOLUTION :'//9(F24.18, 9X,F24.18/)) 9994 FORMAT (//2X,' EXIT PARAMETERS : INF1 = ',I1,1X,', INF2 = ' + ,I1//2X,' NUMBER OF FUNCTION CALLS : NFCALL =',I4 ) * * Last statement of the main program. * * END *---------------------------------------------------------------------* * REAL FUNCTION FNC( X, IFLAG ) *********************************************************************** * * * FUNCTION FNC * * * * The purpose of this subprogram is to evaluate the IFLAG-th * * component of the given function. * * * * * * The function statement is : * * * * REAL FUNCTION FNC( X, IFLAG ) * * * * where * * * * X is an array of length N and contains the corresponding com- * * ponents of the independent variable. * * * * IFLAG determines the component of the function to be evalu- * * ated. * * * *********************************************************************** INTEGER IFLAG, NEXT, N, NFCALL, I REAL X(9), ZERO, ONE, TWO, FOUR, TEN, ONETEN COMMON / BLK1 / NEXT, N, NFCALL PARAMETER ( ZERO = 0.0, ONE = 1.0, TWO = 2.0, + FOUR = 4.0, TEN = 10.0, ONETEN = 0.1 ) NFCALL = NFCALL + 1 GO TO ( 100, 200, 300, 400, 500, 600 ), NEXT 100 GO TO ( 1, 2 ), IFLAG 1 FNC = X(1)**2 - FOUR * X(2) RETURN 2 FNC = X(2)**2 - TWO * X(1) + FOUR * X(2) RETURN 200 GO TO ( 3, 4 ), IFLAG 3 FNC = ONE - X(1) RETURN 4 FNC = TEN * ( X(2) - X(1) ** 2 ) RETURN 300 IF ( X(1) .EQ. ZERO ) THEN IF ( X(2) .EQ. ZERO ) THEN FNC = ZERO RETURN ENDIF ENDIF GO TO ( 5, 6 ), IFLAG 5 FNC = ( X(1)**3 - X(2)**3 ) / ( X(1)**2 + X(2)**2 ) RETURN 6 FNC = ( X(1)**3 + X(2)**3 ) / ( X(1)**2 + X(2)**2 ) RETURN 400 FNC = X(IFLAG) RETURN 500 I = IFLAG + 1 IF ( IFLAG .EQ. N ) I = 1 FNC = ( X(IFLAG) - ONETEN ) ** 2 + ( X(I) - ONETEN ) RETURN 600 I = IFLAG + 1 IF ( IFLAG .EQ. N ) I = 1 FNC = X(IFLAG) ** 2 - X(I) RETURN * * Last statement of the function FNC. * * END *---------------------------------------------------------------------* *