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