home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / SQRT.CMD < prev    next >
OS/2 REXX Batch file  |  1998-07-11  |  3KB  |  105 lines
  1. /* REXX-Programm sqrt.CMD */
  2.    signal on syntax name sqrtMsg
  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.    bufND =Pfd||"NDZahl.DAT"
  10.    bufMsg=Pfd||"Meldung.DAT"
  11.    ND = LineIn(bufND, 1)
  12.  
  13. /* An dieser Stelle muß  "bufMsg"  gelöscht werden, damit dann,   */
  14. /* die Datei  "Meldung.DAT"  leer ist, diese auch leer bleibt.    */
  15.    call charout(bufMsg)
  16.    Call SysFileDelete bufMsg
  17.  
  18.    parse arg x,y
  19.    p0p=x*x /* Diese Anweisung prvoziert eine Syntax-Fehlermeldung */
  20.  
  21.    if length(y) > 0 then
  22.    do
  23.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  24.   /*  damit in den diesbezüglichen temporären Dateien                      */
  25.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  26.      ret=LineOut(bufMsg, "Im Argument von  sqrt(...)  ist mindestens  1  nicht zulässiges Komma !")
  27.      EXIT
  28.    end
  29.  
  30.    if (x=0) then return(0)
  31.    if (x=1) then return(1)
  32.  
  33.    if (x<0) then
  34.    do
  35.      /* An dieser Stelle muß  "bufMsg"  gelöscht werden, damit Meldungen   */
  36.      /* nicht aneinandergehängt werden.                                    */
  37.      call charout(bufMsg)
  38.      Call SysFileDelete bufMsg
  39.      ret=LineOut(bufMsg, "Die zweite Wurzel aus " x"  ist eine komplexe Zahl !")
  40.      EXIT
  41.    end
  42.  
  43.    if x < 1.0E-10000 | x > 1.0E+10000 then
  44.    do
  45.      /* An dieser Stelle muß  "bufMsg"  gelöscht werden, damit Meldungen   */
  46.      /* nicht aneinandergehängt werden.                                    */
  47.      call charout(bufMsg)
  48.      Call SysFileDelete bufMsg
  49.      call charout(bufND)
  50.      Call SysFileDelete bufND
  51.      ret=LineOut(bufMsg, "     Das Argument der Funktion sqrt(...)",
  52.                          "                                           ",
  53.                          "sollte entweder gleich  0                                                      ",
  54.                          "oder größer als  1.0E-10000  und kleiner als  1.0E+10000  sein.")
  55.      EXIT
  56.    end
  57.  
  58.    NUMERIC DIGITS ND+12
  59.  
  60.    if x<1 then SIGNAL A
  61.    else
  62.    do
  63.      n=0
  64.      do while x>100
  65.        x=x/100
  66.        n=n+1
  67.      end
  68.    end
  69.    SIGNAL B
  70.  
  71.    A:
  72.      n=0
  73.      do while x<(0.01)
  74.        x=x*100
  75.        n=n-1
  76.      end
  77.      SIGNAL B
  78.  
  79.    B:
  80.      y=1
  81.      t=x/y
  82.      do while abs(y-t) > y*10**(-ND-7)
  83.        y=(y+t)/2
  84.        t=x/y
  85.      end
  86.  
  87.    u=y*10**n
  88.    numeric digits ND
  89.    return(Format(u))
  90.  
  91.  
  92. sqrtMsg:
  93.    sf=ErrorText(RC)
  94.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  95.    do
  96.      /* An dieser Stelle muß  "bufMsg"  gelöscht werden, damit Meldungen   */
  97.      /* nicht aneinandergehängt werden.                                    */
  98.      call charout(bufMsg)
  99.      Call SysFileDelete bufMsg
  100.      call charout(bufND)
  101.      Call SysFileDelete bufND
  102.      ret=LineOut(bufMsg, "Sie haben in  sqrt(...)  kein gültiges Argument eingegeben !")
  103.    end
  104.  
  105.