Procedures | Cast3M

   1 : * MDNRIS    PROCEDUR  CHLOE     99/03/18    21:15:15     3528           
   2 : DEBPROC MDNRIS P*FLOTTANT;
   3 : *--------------------------------
   4 : *-----procedure mdnris.gib--------
   5 : *
   6 : * Auteur : Fabien Heidinger
   7 : *
   8 : * Date : 29 septembre 1995
   9 : *
  10 : *--------------------------------
  11 : *mess 'debut de mdnris';
  12 : XINF=1e+9;
  13 : SQRT2=1.414214;
  14 : ZEPS=0.00000011921;
  15 : G0=0.0001851159;G1=-.002028152;G2=-.1498384;G3=.01078639;
  16 : H0=.09952975;H1=.5211733;H2=-.06888301;
  17 : IER=0;
  18 : SI (ET (>EG P 0.) (<EG P 1.));
  19 :  SI (EGA P 0.);
  20 :   P=ZEPS*ZEPS;
  21 :  FINSI;
  22 :  SI (EGA P 1.);
  23 :   P=P - (ZEPS*ZEPS);
  24 :  FINSI;
  25 :  SI (<EG P ZEPS);
  26 :   A=P+P;
  27 :   W=0-(LOG (A+A-(A*A)))**0.5;
  28 :   WI=1./W;
  29 :   SN=WI*(G3*WI+G2*WI+G1);
  30 :   SD=WI*(WI+H2*WI+H1)+H0;
  31 :   Y=W+(W*(G0+(SN/SD)));
  32 :   Y=0-Y*SQRT2;
  33 :   QUITTER MDNRIS;
  34 :  FINSI;
  35 :   X=1-(P+P);
  36 : *
  37 : repeter ba1 1;
  38 : A1=-.5751703;A2=-1.896513;A3=-.05496261;
  39 : B0=-.1137730;B1=-3.293474;B2=-2.374996;
  40 : B3=-1.187515;
  41 : C0=-.1146666;C1=-.1314774;C2=-.2368201;
  42 : C3=.05073975;D0=-44.27977;D1=21.98546;
  43 : D2=-7.586103;E0=-.05668422;E1=.3937021;
  44 : E2=-.3166501;E3=.06208963;
  45 : F0=-6.266786;F1=4.666263;F2=-2.962883;
  46 : G0=.0001851159;G1=-.002028152;
  47 : G2=-.1498384;G3=.01078639;
  48 : H0=.09952975;H1=.5211733;
  49 : H2=-.06888301;
  50 : RINFM=1000000000.;
  51 : 
  52 : IER = 0;
  53 : *X = P;
  54 : FSIG=SIGN X;
  55 : 
  56 : SI (OU (< X -1.) (> X 1.));
  57 :  IER = 129;
  58 :  Y = FSIG * RINFM;
  59 :  MESS 'ERREUR : MERFI';
  60 : * QUITTER MERFI;
  61 : iterer ba1;
  62 : FINSI;
  63 : 
  64 : Z = ABS X;
  65 : 
  66 : SI (<EG Z .85);
  67 :  Z2 = Z*Z;
  68 :  F=Z*(B0+(A1*Z2/(B1+Z2+(A2/(B2+Z2+(A3/(B3+Z2)))))))+Z;
  69 :  Y = FSIG*F;
  70 :  IER = 0;
  71 : * QUITTER MERFI;
  72 : iterer ba1;
  73 : FINSI;
  74 :  
  75 : A = 1.-Z;
  76 : B = Z;
  77 : W=0-(LOG (A*B+A))**0.5;
  78 :  
  79 : SI (< W 2.5);
  80 :  SN = ((C3*W+C2)*W+C1)*W;
  81 :  SD = ((W+D2)*W+D1)*W+D0;
  82 :  F = W + (W*(C0+(SN/SD)));
  83 :  Y = FSIG*F;
  84 :  IER = 0;
  85 : * QUITTER MERFI;
  86 : iterer ba1;
  87 : FINSI;
  88 :  
  89 : SI (< W 4);
  90 :  SN = ((E3*W+E2)*W+E1)*W;
  91 :  SD = ((W+F2)*W+F1)*W+F0;
  92 :  F = W + (W*(E0+(SN/SD)));
  93 :  Y=FSIG*F;
  94 :  IER=0;
  95 : * QUITTER MERFI;
  96 : iterer ba1;
  97 : FINSI;
  98 :  
  99 : WI = 1./W;
 100 : SN = ((G3*WI+G2)*WI+G1)*WI;
 101 : SD = ((WI+H2)*WI+H1)*WI+H0;
 102 : F = W + (W*(G0+(SN/SD)));
 103 : Y=FSIG*F;
 104 : IER=0;
 105 : fin ba1;
 106 : *  Y IER =MERFI X;
 107 :   Y=0 - SQRT2*Y;
 108 :   QUITTER MDNRIS;
 109 : SINON;
 110 :  IER=129;
 111 :  FG=SIGN P;
 112 :  Y=FG*XINF;
 113 :  MESS 'ERREUR MDNRIS';
 114 :  QUITTER MDNRIS;
 115 : FINSI;
 116 : FINPROC Y IER;
 117 : 
 118 : 
 119 : 
 120 : 
 121 :