home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / ERFC.CMD < prev    next >
OS/2 REXX Batch file  |  1998-07-11  |  3KB  |  90 lines
  1. /*  REXX-Programm ercf(x) */
  2.    signal on syntax name erfcMsg
  3.  
  4. /* Diese Variablen müssen für jede Prozedur definiert werden, damit die  */
  5. /* Prozedur die Variable bufND kennt und die Variable ND übernehmen kann.*/
  6.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  7.    lp=LastPos("\", Pfd)
  8.    Pfd=DelStr(Pfd, 1+lp)
  9.    NDAerfc=Pfd||"NDAerfc.DAT"
  10.    bufND  =Pfd||"NDZahl.DAT"
  11.    bufMsg =Pfd||"Meldung.DAT"
  12.    ND = LineIn(bufND, 1)
  13.    NDa=ND
  14.  
  15.    if ND > 50 then
  16.    do
  17.      ND=50
  18.      call charout(NDAerfc) ; Call SysFileDelete NDAerfc
  19.      ret=LineOut(NDAerfc, 50)
  20.      Call Charout,"   Achtung, nur  50 Dezimalstellen bei der Berechnung von erfc(...)"
  21.      say
  22.      Beep(444, 200); Beep(628,300)  /* Hier kein EXIT ! */
  23.    end
  24.  
  25.    /* Wenn ND <= 50 ist, wird ND = ND  weitergegeben */
  26.    call charout(NDAerfc) ; Call SysFileDelete NDAerfc
  27.    ret=LineOut(NDAerfc, ND)
  28.  
  29.    numeric digits 125
  30.    /*    1/sqrt(Pi)     */
  31.    c2=0.5641895835477562869480794515607725858440506293289988568440857217106424684414934144867436602021073634430283479063617073516899
  32.    Numeric Digits ND+10
  33.  
  34.    arg x,y
  35.    z=x*x /* Diese Anweisung prvoziert eine Syntax-Fehlermeldung */
  36.  
  37.    if length(y) > 0 then
  38.    do
  39.      call charout(NDAerfc) ; Call SysFileDelete NDAerfc
  40.      ret=LineOut(bufMsg, "Im Argument von  erfc(...)  ist mindestens  1  nicht zulässiges Komma !")
  41.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  42.   /*  damit in den diesbezüglichen temporären Dateien                      */
  43.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  44.      EXIT
  45.    end
  46.  
  47.    if x>=0 then sgn=1; else sgn=-1
  48.    x=abs(x)
  49.    if 0    <= x then if x < 4.5  then SIGNAL A
  50.    if 4.5  <= x then if x < 10.5 then SIGNAL B
  51.    if 10.5 <= x then do y=1; SIGNAL C; end
  52.  
  53. A: n=1; u=1; v=1;
  54.    do while u/v>10**(-ND-7)
  55.    g=2*z/(2*n+1); u=u*g; v=v+u; n=n+1; end
  56.    y=2*c2*x*v*exp(-z); Signal C
  57.  
  58. B:
  59.    v10=40/x
  60.    v9 =36/(x+36.5/(x+37/(x+37.5/(x+38/(x+38.5/(x+39/(x+39.5/(x+v10))))))))
  61.    v8 =32/(x+32.5/(x+33/(x+33.5/(x+34/(x+34.5/(x+35/(x+35.5/(x+v9 ))))))))
  62.    v7 =28/(x+28.5/(x+29/(x+29.5/(x+30/(x+30.5/(x+31/(x+31.5/(x+v8 ))))))))
  63.    v6 =24/(x+24.5/(x+25/(x+25.5/(x+26/(x+26.5/(x+27/(x+27.5/(x+v7 ))))))))
  64.    v5 =20/(x+20.5/(x+21/(x+21.5/(x+22/(x+22.5/(x+23/(x+23.5/(x+v6 ))))))))
  65.    v4 =16/(x+16.5/(x+17/(x+17.5/(x+18/(x+18.5/(x+19/(x+19.5/(x+v5 ))))))))
  66.    v3 =12/(x+12.5/(x+13/(x+13.5/(x+14/(x+14.5/(x+15/(x+15.5/(x+v4 ))))))))
  67.    v2 = 8/(x+ 8.5/(x+ 9/(x+ 9.5/(x+10/(x+10.5/(x+11/(x+11.5/(x+v3 ))))))))
  68.    v1 = 4/(x+ 4.5/(x+ 5/(x+ 5.5/(x+ 6/(x+ 6.5/(x+ 7/(x+ 7.5/(x+v2 ))))))))
  69.    v  = 1/(x+ 0.5/(x+ 1/(x+ 1.5/(x+ 2/(x+ 2.5/(x+ 3/(x+ 3.5/(x+v1 ))))))))
  70.  
  71.    y=1-c2*v*exp(-z);
  72.  
  73. C: y=sgn*y     /* Bis hierher ist  y = erf(x)   */
  74.    u=1-y       /* u = 1 - erf(x))    = erfc(x)  */
  75.    numeric digits ND
  76.    return(Format(u))
  77.  
  78. erfcMsg:
  79.    sf=ErrorText(RC)
  80.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  81.    do
  82.      call charout(NDAerfc) ; Call SysFileDelete NDAerfc
  83.      ret=LineOut(bufMsg, "Sie haben in  erfc(...)  kein gültiges Argument eingegeben !")
  84.    /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  85.    /*  damit in den diesbezüglichen temporären Dateien                      */
  86.    /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  87.      EXIT
  88.    end
  89.  
  90.