1 // This code has been mechanically translated from the original FORTRAN 2 // code at http://netlib.org/napack. 3 4 /** Authors: Lars Tandle Kyllingstad 5 Copyright: Copyright (c) 2009, Lars T. Kyllingstad. All rights reserved. 6 License: Boost License 1.0 7 */ 8 module scid.ports.napack.stopit; 9 10 11 import std.math; 12 13 14 15 16 // 17 // ________________________________________________________ 18 // | | 19 // | TEST FOR CONVERGENCE | 20 // | | 21 // | INPUT: | 22 // | | 23 // | DIF --ABSOLUTE DIFFERENCE | 24 // | | 25 // | SIZE --ABSOLUTE VALUE | 26 // | | 27 // | NDIGIT--DESIRED NUMBER CORRECT DIGITS | 28 // | | 29 // | LIMIT --MAXIMUM NUMBER ITERATIONS | 30 // | | 31 // | OUTPUT: | 32 // | | 33 // | DIF --POSITIVE TO CONTINUE ITERATIONS | 34 // | | 35 // | SIZE --ABSOLUTE DIFFERENCE | 36 // | | 37 // | BUILTIN FUNCTIONS: ABS | 38 // |________________________________________________________| 39 /// 40 void stopit(Real)(ref Real dif, ref Real size, int ndigit, int limit) 41 { 42 43 Real e; 44 static Real t; 45 static int i = 0; 46 dif = fabs(dif); 47 size = fabs(size); 48 // ----------------------------------------------- 49 // |*** INITIALIZATION DURING FIRST ITERATION ***| 50 // ----------------------------------------------- 51 if (i > 0) goto l10; 52 t = 10.0^^(-ndigit); 53 // ------------------------------ 54 // |*** STOPPING CRITERION I ***| 55 // ------------------------------ 56 l10: i++; 57 e = 3*i; 58 if (dif > t*size) goto l20; 59 e += 1.0; 60 goto l30; 61 // ------------------------------- 62 // |*** STOPPING CRITERION II ***| 63 // ------------------------------- 64 l20: if (i < limit) goto l40; 65 e += 2.0; 66 l30: dif = -dif; 67 i = 0; 68 l40: size = e; 69 } 70 71 72 unittest 73 { 74 alias stopit!float fstopit; 75 alias stopit!double dstopit; 76 alias stopit!real rstopit; 77 }