SUBROUTINE DSMNFB( P, X,B, CALCF, MXFCAL, ACC ) C C ** SIMPLIED VERSION OF DMNF C C INPUT PARAMETERS C P NUMBER OF UNKNOWNS C X APPROXIMATE SOLUTION C B FIRST ROW OF B GIVES LOWER BOUNDS ON X AND SECOND GIVES UPPER C BOUNDS C CALCF SUBROUTINE TO EVALUATE FUNCTION C MXFCAL MAXIMUM NUMBER OF PERMITTED FUNCTION EVALUATIONS C ACC ACCURACY IN X C OUTPUT PARAMETERS C X SOLUTION INTEGER P, MXFCAL DOUBLE PRECISION X(P), ACC ,B(2,P) EXTERNAL CALCF, DC6LCF C C C C *** LOCAL VARIABLES *** C INTEGER IV, LIV, LV, V1 INTEGER IDI,IDM1,ID,J DOUBLE PRECISION UR DOUBLE PRECISION DSTAK(500) COMMON /CSTAK/ DSTAK INTEGER ISTAK(1000) EQUIVALENCE (DSTAK(1), ISTAK(1)) C C *** BODY *** C CALL ENTER(0) C/6S C IF (P.LT.1) C 1CALL SETERR(14HDSMNFB- P.LT.1,14,1,2) C IF (MXFCAL.LT.1) C 1CALL SETERR(19HDSMNFB- MXFCAL.LT.1,19,2,2) C IF (ACC.LT.0.0D0) C 1CALL SETERR(18HDSMNFB-ACC .LT.0.0,18,3,2) C/7S IF (P.LT.1) 1CALL SETERR('DSMNFB- P.LT.1',14,1,2) IF (MXFCAL.LT.1) 1CALL SETERR('DSMNFB- MXFCAL.LT.1',19,2,2) IF (ACC.LT.0.0D0) 1CALL SETERR('DSMNFB-ACC .LT.0.0',18,3,2) C/ LIV =59+P LV=77+P*(P+23)/2 IV=ISTKGT(LIV,2) V1=ISTKGT(LV, 4) CALL DIVSET(2,ISTAK(IV),LIV,LV,DSTAK(V1)) ISTAK(IV+20)=0 ISTAK(IV+16)=MXFCAL ISTAK(IV+17)=MXFCAL DSTAK(V1+32)=ACC DSTAK(V1+31)=ACC ID=ISTKGT(P, 4) IDM1=ID-1 DO 10 I=1,P IDI=IDM1+I DSTAK(IDI)=1.0 IF (X(I).NE.0.0)DSTAK(IDI)=1.0/DABS(X(I)) 10 CONTINUE CALL DMNFB( P, DSTAK(ID),X,B, DC6LCF, ISTAK(IV), LIV, LV, 1 DSTAK(V1), IU, UR, CALCF) J=ISTAK(IV) IF(J.LT.7) GO TO 20 C/6S C IF (J.EQ.82)CALL SETERR(26HDSMNFB-INCONSISTENT BOUNDS,26,4,1) C IF (J.EQ.7)CALL SETERR(27HDSMNFB-SINGULAR CONVERGENCE,27,5,1) C IF(J.EQ.8)CALL SETERR(24HDSMNFB-FALSE CONVERGENCE,24,6,1) C IF(J.EQ.9)CALL SETERR(32HDSMNFB-FUNCTION EVALUATION LIMIT,32,7,1) C IF (J.EQ.63) C 1CALL SETERR(43HDSMNFB-F(X) CANNOT BE COMPUTED AT INITIAL X,43,8,1) C/7S IF (J.EQ.82)CALL SETERR('DSMNFB-INCONSISTENT BOUNDS',26,4,1) IF (J.EQ.7)CALL SETERR('DSMNFB-SINGULAR CONVERGENCE',27,5,1) IF(J.EQ.8)CALL SETERR('DSMNFB-FALSE CONVERGENCE',24,6,1) IF(J.EQ.9)CALL SETERR('DSMNFB-FUNCTION EVALUATION LIMIT',32,7,1) IF (J.EQ.63) 1CALL SETERR('DSMNFB-F(X) CANNOT BE COMPUTED AT INITIAL X',43,8,1) C/ 20 CALL LEAVE C RETURN C *** LAST LINE OF DSMNFB FOLLOWS *** END .