home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / SIN.CMD < prev    next >
OS/2 REXX Batch file  |  1999-02-18  |  4KB  |  116 lines
  1. /* REXX-Programm sin.cmd */
  2.    Signal on syntax name sinMsg
  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.    NDAsin=Pfd||"NDAsin.DAT"
  10.    bufND =Pfd||"NDZahl.DAT"
  11.    bufMsg=Pfd||"Meldung.DAT"
  12.    ND = LineIn(bufND, 1)
  13.    Numeric Digits ND+10
  14.    
  15.    arg xx,y
  16.    p0p=xx*xx /* Diese Anweisung provoziert eine Syntax-Fehlermeldung */
  17.  
  18.    if length(y) > 0 then
  19.    do
  20.      call charout(NDAsin); Call SysFileDelete NDAsin
  21.      ret=LineOut(bufMsg, "Im Argument von  sin(...)  ist mindestens  1  nicht zulässiges Komma !")
  22.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  23.   /*  damit in den diesbezüglichen temporären Dateien                      */
  24.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  25.      EXIT
  26.    end
  27.  
  28.                                     
  29.    if ND > 450 then
  30.    do
  31.      ND=450
  32.      call charout(NDAsin) ; Call SysFileDelete NDAsin
  33.      ret=LineOut(NDAln, 450)
  34.      Call Charout,"   Achtung, nur 450 Dezimalstellen bei der Berechnung von  sin(...)"
  35.      say
  36.      Beep(444, 200); Beep(628,300)  /* Hier kein EXIT ! */
  37.    end
  38.  
  39.    /* Wenn ND <= 450 ist, wird ND = ND  weitergegeben */
  40.    call charout(NDAsin) ; Call SysFileDelete NDAsin
  41.    ret=LineOut(NDAsin, ND)
  42.  
  43.    if xx = 0 then do; y=0; Signal W; end
  44.  
  45.    pi=3.||,
  46.    1415926535897932384626433832795028841971693993751058209749445923078||,
  47.    164062862089986280348253421170679821480865132823066470938446095505822317||,
  48.    253594081284811174502841027019385211055596446229489549303819644288109756||,
  49.    659334461284756482337867831652712019091456485669234603486104543266482133||,
  50.    936072602491412737245870066063155881748815209209628292540917153643678925||,
  51.    903600113305305488204665213841469519415116094330572703657595919530921861||,
  52.    173819326117931051185480744623799627495673518857527248912279381830119491||,
  53.    298336733624406566430860213949463952247371907021798609437027705392171762||,
  54.    93176752384674818467669405132
  55.  
  56.    pi14=pi/4
  57.  
  58.    x=abs(xx)//(2*pi)
  59.    /* x bleibt im Intervall  0 < x < 2π  */
  60.  
  61.    vz=1
  62.    /* Das Intervall  0 < x < 2*pi  wird so zerlegt, daß die Reihen für     */
  63.    /* sin(x)  und  cos(x)  immer nur für Werte  x < π/4  verwendet werden. */
  64.    select
  65.      when x > 7*pi14 then do; x = 2*pi-x;   vz=-1; Signal Sin; end
  66.      when x > 6*pi14 then do; x = x-3*pi/2; vz=-1; Signal Cos; end
  67.      when x > 5*pi14 then do; x = 3*pi/2-x; vz=-1; Signal Cos; end
  68.      when x > 4*pi14 then do; x = x-pi;     vz=-1; Signal Sin; end
  69.      when x > 3*pi14 then do; x = pi-x;     vz=+1; Signal Sin; end
  70.      when x > 2*pi14 then do; x = x-pi/2;   vz=+1; Signal Cos; end
  71.      when x >   pi14 then do; x = pi/2-x;   vz=+1; Signal Cos; end
  72.      when x >   0    then do; x = x;        vz=+1; Signal Sin; end
  73.      otherwise NOP
  74.    end
  75.  
  76. Sin:
  77.    /* Reihe sin(x) */
  78.    g=1; z=x**2 ; m=2; v=1
  79.    do forever
  80.      g=-g*z/(m*(m+1))
  81.      if abs(g/v) < 10**(-ND-7) then leave
  82.      v=v+g
  83.      m=m+2
  84.    end
  85.    y=v*x*vz
  86.    Signal W
  87.  
  88. Cos:
  89.    /* Reihe cos(x) */
  90.    g=1; z=x**2; m=2; v=1
  91.    do forever
  92.      g=-g*z/(m*(m-1))
  93.      if (abs(g/v) < 10**(-ND-7)) then leave
  94.      v=v+g
  95.      m=m+2
  96.    end
  97.    y=v*vz
  98.  
  99. W: numeric digits ND
  100.    return(Format(y*sign(xx)))
  101.  
  102. EXIT
  103.  
  104. sinMsg:
  105.    sf=ErrorText(RC)
  106.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  107.    do
  108.      call charout(NDAsin); Call SysFileDelete NDAsin
  109.      ret=LineOut(bufMsg, "Sie haben in  sin(...)  kein gültiges Argument eingegeben !")
  110.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  111.   /*  damit in den diesbezüglichen temporären Dateien                      */
  112.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  113.      EXIT
  114.    end
  115.  
  116.