1 SUBROUTINE BSRL(S,CENTER,HWIDTH,F,MAXVLS,FUNCLS, 2 * ERRMIN,ERREST,BASEST,DIVAXO,DIVAXN) 3 EXTERNAL F 4 INTEGER S, DIVAXN, DIVAXO, FUNCLS, INTCLS, I, MINDEG, MAXDEG, 5 * MAXORD, MINORD, MAXCLS 6 REAL ONE, TWO, THREE, FIVE, TEN, DIF, ERRORM, ERRMIN, 7 * CENTER(S), HWIDTH(S), SUM0, SUM1, SUM2, DIFMAX, X1, X2, 8 * INTVLS(20), Z(20), FULSMS(200), WEGHTS(200), ERREST, BASEST 9 MAXDEG = 12 10 MINDEG = 4 11 MINORD = 0 12 ZERO = 0 13 ONE = 1 14 TWO = 2 15 THREE = 3 16 FIVE = 5 17 TEN = 10 18 DO 10 MAXORD = MINDEG,MAXDEG 19 CALL SYMRL(S, CENTER, HWIDTH, F, MINORD, MAXORD, INTVLS, 20 * INTCLS, 200, WEGHTS, FULSMS, IFAIL) 21 IF (IFAIL.EQ.2) GOTO 20 22 ERREST = ABS(INTVLS(MAXORD)-INTVLS(MAXORD-1)) 23 ERRORM = ABS(INTVLS(MAXORD-1)-INTVLS(MAXORD-2)) 24 IF (ERREST.NE.ZERO) 25 * ERREST = ERREST*AMAX1(ONE/TEN,ERREST/AMAX1(ERREST/TWO,ERRORM)) 26 IF (ERRORM.LE.FIVE*ERREST) GOTO 20 27 IF (2*INTCLS.GT.MAXVLS) GOTO 20 28 IF (ERREST.LT.ERRMIN) GOTO 20 29 10 CONTINUE 30 20 DIFMAX = -1 31 X1 = ONE/TWO**2 32 X2 = THREE*X1 33 DO 30 I = 1,S 34 Z(I) = CENTER(I) 35 30 CONTINUE 36 SUM0 = F(S,Z) 37 DO 40 I = 1,S 38 Z(I) = CENTER(I) - X1*HWIDTH(I) 39 SUM1 = F(S,Z) 40 Z(I) = CENTER(I) + X1*HWIDTH(I) 41 SUM1 = SUM1 + F(S,Z) 42 Z(I) = CENTER(I) - X2*HWIDTH(I) 43 SUM2 = F(S,Z) 44 Z(I) = CENTER(I) + X2*HWIDTH(I) 45 SUM2 = SUM2 + F(S,Z) 46 Z(I) = CENTER(I) 47 DIF = ABS((SUM1-TWO*SUM0) - (X1/X2)**2*(SUM2-TWO*SUM0)) 48 IF (DIF.LT.DIFMAX) GOTO 40 49 DIFMAX = DIF 50 DIVAXN = I 51 40 CONTINUE 52 IF (SUM0.EQ.SUM0+DIFMAX/TWO) DIVAXN = MOD(DIVAXO,S) + 1 53 BASEST = INTVLS(MINORD) 54 FUNCLS = INTCLS + 4*S 55 RETURN 56 END 57