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