home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / TAN.CMD < prev    next >
OS/2 REXX Batch file  |  1999-08-23  |  4KB  |  131 lines
  1. /* REXX-Programm tan.cmd                  */
  2.  
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5. /*   Signal on syntax name tanMsg */
  6.  
  7. /* Diese Variablen müssen für jede Prozedur definiert werden, damit die  */
  8. /* Prozedur die Variable bufND kennt und die Variable ND übernehmen kann.*/
  9.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  10.    lp=LastPos("\", Pfd)
  11.    Pfd=DelStr(Pfd, 1+lp)
  12.    NDAtan=Pfd||"NDAtan.DAT"
  13.    bufND =Pfd||"NDZahl.DAT"
  14.    bufMsg=Pfd||"Meldung.DAT"
  15.    ND = LineIn(bufND, 1)
  16.    NUMERIC DIGITS ND+14
  17.  
  18.    arg xx,y
  19.    p0p=xx*xx /* Diese Anweisung porvoziert eine Syntax-Fehlermeldung */
  20.  
  21.    if length(y) > 0 then
  22.    do
  23.      call charout(NDAtan) ; Call SysFileDelete NDAtan
  24.      ret=LineOut(bufMsg, "Im Argument von  tan(..) ist mindestens  1  nicht zulässiges Komma !")
  25.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  26.   /*  damit in den diesbezüglichen temporären Dateien                      */
  27.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  28.      EXIT
  29.    end
  30.  
  31.    if ND > 450 then
  32.    do
  33.      ND=450
  34.      call charout(NDAtan) ; Call SysFileDelete NDAtan
  35.      ret=LineOut(NDAtan, 450)
  36.      Call Charout,"   Achtung, nur 450 Dezimalstellen bei der Berechnung von   tan(...)"
  37.      say
  38.      Beep(444, 200); Beep(628,300)  /* Hier kein EXIT ! */
  39.    end
  40.  
  41.    /* Wenn ND <= 450 ist, wird ND = ND  weitergegeben */
  42.    call charout(NDAtan) ; Call SysFileDelete NDAtan
  43.    ret=LineOut(NDAtan, ND)
  44.  
  45.    if xx = 0 then do; yy=0; Signal X; end
  46.  
  47.    pi=3.||,
  48.    1415926535897932384626433832795028841971693993751058209749445923078||,
  49.    164062862089986280348253421170679821480865132823066470938446095505822317||,
  50.    253594081284811174502841027019385211055596446229489549303819644288109756||,
  51.    659334461284756482337867831652712019091456485669234603486104543266482133||,
  52.    936072602491412737245870066063155881748815209209628292540917153643678925||,
  53.    903600113305305488204665213841469519415116094330572703657595919530921861||,
  54.    173819326117931051185480744623799627495673518857527248912279381830119491||,
  55.    298336733624406566430860213949463952247371907021798609437027705392171762||,
  56.    93176752384674818467669405132
  57.  
  58.    pi14=pi/4; /* = π/4 */  pi24=pi/2  /* = π/2  */
  59.  
  60.    /* x bleibt im Intervall  0 < x < 2π  */
  61.    x=abs(xx)//(2*pi)
  62.    /* x bleibt im Intervall  0 < x < π   */
  63.    x=x//pi
  64.  
  65.    NUMERIC DIGITS ND+10
  66.    vzs=1; vzc=1
  67.    /* Das Intervall  0 < x < 2*pi  wird so zerlegt, daß die Reihen für     */
  68.    /* sin(x)  und  cos(x)  immer nur für Werte  x < π/4  verwendet werden. */
  69.    /* vzs ist ein internes Vorzeichen sür die sinus-Reihe                  */
  70.    /* vzc ist ein internes Vorzeichen sür die cosinus-Reihe                */
  71.    select
  72.      when x > 3*pi14 then do; x = pi-x;    vzs=+1;  vzc=-1; Signal A; end
  73.      when x > 2*pi14 then do; x = x-pi/2;  vzs=+1;  vzc=-1; Signal B; end
  74.      when x >   pi14 then do; x = pi/2-x;  vzs=+1;  vzc=+1; Signal C; end
  75.      when x >   0    then do; x = x;       vzs=+1;  vzc=+1; Signal D; end
  76.      otherwise NOP
  77.    end
  78.  
  79.    /* yz = Wert des Zählers;  yn = Wert des Nenners */
  80. A: yz=sin(x,ND,vzs); yn=cos(x,ND,vzc); Signal W
  81. B: yz=cos(x,ND,vzc); yn=sin(x,ND,vzs); Signal W
  82. C: yz=cos(x,ND,vzc); yn=sin(x,ND,vzs); Signal W
  83. D: yz=sin(x,ND,vzs); yn=cos(x,ND,vzc);
  84.  
  85. W: yy=yz/yn
  86. X: numeric digits ND
  87.    return(Format(sign(xx)*yy))
  88.  
  89. EXIT
  90.  
  91. Sin:
  92.    Procedure
  93.    /* Reihe sin(x) */
  94.    arg x,ND,vzs
  95.    g=1; z=x**2 ; m=2; v=1
  96.    do forever
  97.      g=-g*z/(m*(m+1))
  98.      if abs(g/v) < 10**(-ND-7) then leave
  99.      v=v+g
  100.      m=m+2
  101.    end
  102.    ys=v*x*vzs
  103.    return(ys)
  104.  
  105. Cos:
  106.    Procedure
  107.    /* Reihe cos(x) */
  108.    arg x,ND,vzc
  109.    g=1; z=x**2; m=2; v=1
  110.    do forever
  111.      g=-g*z/(m*(m-1))
  112.      if (abs(g/v) < 10**(-ND-7)) then leave
  113.      v=v+g
  114.      m=m+2
  115.    end
  116.    yc=v*vzc
  117.    return(yc)
  118.  
  119. tanMsg:
  120.    sf=ErrorText(RC)
  121.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  122.    do
  123.      call charout(NDAtan) ; Call SysFileDelete NDAtan
  124.      ret=LineOut(bufMsg, "Sie haben in  tan(..)  kein gültiges Argument eingegeben !")
  125.    /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  126.    /*  damit in den diesbezüglichen temporären Dateien                      */
  127.    /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  128.      EXIT
  129.    end
  130.  
  131.