home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / GA.CMD < prev    next >
OS/2 REXX Batch file  |  1998-07-11  |  9KB  |  203 lines
  1. /* REXX-Programm ga.CMD  Gammafunktion.  */
  2.    Signal on syntax name gaMsg 
  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.    NDAga=Pfd||"NDAga.DAT"  /* hier ändern */
  10.    bufND  =Pfd||"NDZahl.DAT"
  11.    bufMsg =Pfd||"Meldung.DAT"
  12.    ND = LineIn(bufND, 1)
  13.  
  14.    if ND > 50 then
  15.    do
  16.      ND=50
  17.      call charout(NDAga) ; Call SysFileDelete NDAga
  18.      ret=LineOut(NDAga, 50)
  19.      Call Charout,"   Achtung, nur  50 Dezimalstellen bei der Berechnung von  ga(...)"
  20.      say
  21.      Beep(444, 200); Beep(628,300)  /* Hier kein EXIT ! */
  22.    end
  23.  
  24.    /* Wenn ND <= 64 ist, wird ND = ND  weitergegeben */
  25.    call charout(NDAga) ; Call SysFileDelete NDAga
  26.    ret=LineOut(NDAga, ND)
  27.  
  28.    /* Hier offenbar erforderlich wegen der hohen Stellenzahl der Konstanten. */
  29.    NUMERIC DIGITS 90  /* Beispiele für Konstanten */
  30.    c.1  = +1
  31.    c.2  = +0.577215664901532860606512090082402431042159335939923598805767234884867726777664670937
  32.    c.3  = -0.655878071520253881077019515145390481279766380478584347292362445683870838353722115169
  33.    c.4  = -0.042002635034095235529003934875429818711394500401106093522065812976180096875975992828
  34.    c.5  = +0.166538611382291489501700795102105235717781502247174340570468903178993866056474270428
  35.    c.6  = -0.042197734555544336748208301289187391301652684189822486376918873275459011185588987857
  36.    c.7  = -0.009621971527876973562114921672348198975362942252113002105138862627311673514460748057
  37.    c.8  = +0.007218943246663099542395010340446572709904800880238318001094781173622594974158536044
  38.    c.9  = -0.001165167591859065112113971084018388666809333795384057443407505275620025848166554809
  39.    c.10 = -0.215241674114950972815729963053647806478241923378338750350267489085639463716794790E-3
  40.    c.11 = +0.128050282388116186153198626328164323394892099693677214900545838041203552043479432E-3
  41.    c.12 = -0.20134854780788238655689391421021818382294833297979115261162670908229186188974321E-4
  42.    c.13 = -0.1250493482142670657345359473833092242322655621153959815349923157491212455619465E-5
  43.    c.14 = +0.1133027231981695882374129620330744943324004838621075654295505395460408427300846E-5
  44.    c.15 = -0.205633841697760710345015413002057283651257902629337945346831725332456803677140E-6
  45.    c.16 = +0.6116095104481415817862498682855342867275865719712320867324029277235074371825E-8
  46.    c.17 = +0.5002007644469222930055665048059991303044612742494481718953378877374721307221E-8
  47.    c.18 = -0.1181274570487020144588126565436505577738759504932587590961892631696433908487E-8
  48.    c.19 = +0.104342671169110051049154033231225019140070982312581212108710739273475883450E-9
  49.    c.20 = +0.7782263439905071254049937311360777226068086181392938819435507326929867498E-11
  50.    c.21 = -0.3696805618642205708187815878085766236570963451360995136484546554430003231E-11
  51.    c.22 = +0.510037028745447597901548132286323180272688606970763211735010485657351901E-12
  52.    c.23 = -0.20583260535665067832224295448552374197460910808101471880581964443490807E-13
  53.    c.24 = -0.5348122539423017982370017318727939948989715478120682111680954932114273E-14
  54.    c.25 = +0.1226778628238260790158893846622422428165455750456321366011359996084009E-14
  55.    c.26 = -0.118125930169745876951376458684229783121155729180484787983750812319057E-15
  56.    c.27 = +0.1186692254751600332579777242928674071088494079664827110740061069760E-17
  57.    c.28 = +0.1412380655318031781555803947566709037086350750334525625641222624694E-17
  58.    c.29 = -0.229874568443537020659247858063369926028450593141903670148898286642E-18
  59.    c.30 = +0.17144063219273374333839633702672570668126560625174331746498588308E-19
  60.    c.31 = +0.133735173049369311486478139512226802287505947176189478985818939E-21
  61.    c.32 = -0.205423355176667278932502535135573379668203793523873641273007117E-21
  62.    c.33 = +0.27360300486079998448315099043309820148653116958363633701669795E-22
  63.    c.34 = -0.1732356445910516639057428451564779799069749108794998413766676E-23
  64.    c.35 = -0.23606190244992872873434507354275310079264135521453704860562E-25
  65.    c.36 = +0.18649829417172944307184131618786668989458684290736682328610E-25
  66.    c.37 = -0.2218095624207197204399716913626860379731779500675675809751E-26
  67.    c.38 = +0.129778197494799366882441448633059416561949986463913317193E-27
  68.    c.39 = +0.1180697474966528406222745415509971518559684637841594596E-29
  69.    c.40 = -0.1124584349277088090293654674261439512119411795583008206E-29
  70.    c.41 = +0.127708517514086620399020667775112464774877206560051803E-30
  71.    c.42 = -0.7391451169615140823461289330108552823710568992445898E-32
  72.    c.43 = +0.11347502575542157609541652594693063930086121953326E-34
  73.    c.44 = +0.46391346410587220299448049079522284630579686795706E-34
  74.    c.45 = -0.5347336818439198875077418196709893320904885913120E-35
  75.    c.46 = +0.320799592361335262286123727908279439109014630583E-36
  76.    c.47 = -0.4445829736550756882101590352124643637401430593E-38
  77.    c.48 = -0.1311174518881988712901058494389922190236626122E-38
  78.    c.49 = +0.164703335254381388681825932790639414539953401E-39
  79.    c.50 = -0.10562331785035812186005610715382850499973709E-40
  80.    c.51 = +0.267844298264304947835496307189085194852391E-42
  81.    c.52 = +0.24247154948517826896730329383709212404954E-43
  82.    c.53 = -0.3736587834535612554034559121270316378515E-44
  83.    c.54 = +0.262833298094019544908903761187363931565E-45
  84.    c.55 = -0.9298175995376886299601668991518164566E-47
  85.    c.56 = -0.232794241869947059860426205562226943E-48
  86.    c.57 = +0.61696208352443874203544317731506464E-49
  87.    c.58 = -0.4928295586770989930504458682209762E-50
  88.    c.59 = +0.218351318341451069727782849863970E-51
  89.    c.60 = -0.1218722189147516555250452609259E-53
  90.    c.61 = -0.711710884166287463194565265340E-54
  91.    c.62 = +0.69205040543286892535284226555E-55
  92.    c.63 = -0.3676438468356676327679747226E-56
  93.    c.64 = +0.85630980562756543279818817E-58
  94.    c.65 = +0.4963045428366844384839756E-59
  95.    c.66 = -0.715429457708161521818575E-60
  96.    c.67 = +0.45517276890885041138065E-61
  97.    c.68 = -0.1618399305320294461039E-62
  98.    c.69 = -0.3818043424399946698E-65
  99.    c.70 = +0.5185052411905838705E-65
  100.    c.71 = -0.416713680922385348E-66
  101.    c.72 = +0.19162906929376614E-67
  102.    c.73 = -0.38089281324981E-69
  103.    c.74 = -0.2206386105545E-70
  104.    c.75 = +0.277223109628E-71
  105.    c.76 = -0.15987660491E-72
  106.    c.77 = +0.531973079E-74
  107.    c.78 = -0.805174E-77
  108.    c.79 = -0.12485E-76
  109.    c.80 = +0.964E-78
  110.    c.81 = -0.21E-79
  111.  
  112.    arg x,y  /* y soll "illegale" Komma's im Funktions-Argument aufspüren */
  113.    p0p=x*x /* Diese Anweisung prvoziert eine Syntax-Fehlermeldung       */
  114.  
  115.    if length(y) > 0 then
  116.    do
  117.      call charout(NDAga); Call SysFileDelete NDAga  /* hier ändern */
  118.      ret=LineOut(bufMsg, "Im Argument von  ga(...)  ist mindestens  1  nicht zulässiges Komma !")
  119.      /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  120.      /*  damit in den diesbezüglichen temporären Dateien                      */
  121.      /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  122.      EXIT
  123.    end
  124.  
  125.    if abs(x) > 3000 then
  126.    do
  127.      ret=LineOut(bufMsg, "Das Argument der Funktion  ga(...)  sollte ±3000 nicht überschreiten,",
  128.                          "         ",
  129.                          "weil sonst die Rechenzeit zu groß werden würde.")
  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.  
  137.  
  138. if x>0 then SIGNAL A; else SIGNAL B
  139.  
  140. A: xi=x%1; xd=x//1
  141.    uxi=1; i=1  /* Berechnung vom xi! */
  142.    do while  (i<xi)
  143.      uxi=uxi*i
  144.      i=i+1
  145.    end
  146.  
  147.    if xd=0 then do y=uxi; SIGNAL W; end
  148.  
  149.    u=0; n=1
  150.    do while n<82
  151.      g=(c.n)*(xd**n); u=u+g; n=n+1
  152.    end
  153.  
  154.    v=1; n=0
  155.    do while n<abs(xi)
  156.      g=(n+xd); v=v*g; n=n+1
  157.    end
  158.    y=v/u; SIGNAL W
  159.  
  160. B: xi=x%1-1; xd=1-abs(x//1)
  161.  
  162.    if abs(x//1)=0 then
  163.    do
  164.      call charout(NDAga); Call SysFileDelete NDAga  /* hier ändern */
  165.      ret=LineOut(bufMsg, "    Für  x=0  und für negative ganzzahlige Werte von x",
  166.                          "                        ",
  167.                          "    hat die Gammafunktion  ga(x)  Pole; sie ist dort nicht definiert.")
  168.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  169.   /*  damit in den diesbezüglichen temporären Dateien                      */
  170.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  171.      EXIT
  172.    end
  173.  
  174.    u=0; n=1
  175.    do while n<82
  176.      g=(c.n)*(xd**n); u=u+g; n=n+1
  177.    end
  178.  
  179.    v=1; n=1
  180.    do while n<abs(xi)+1
  181.      g=(xd-n); v=v*g; n=n+1
  182.    end
  183.    y=1/(v*u)
  184.  
  185.    /* Ausgabe */
  186. W: numeric digits ND
  187.    return(Format(y))
  188.  
  189.  
  190.  
  191. gaMsg:  /* hier ändern */
  192.    sf=ErrorText(RC)
  193.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  194.    do
  195.      call charout(NDAga); Call SysFileDelete NDAga  /* hier ändern */
  196.      ret=LineOut(bufMsg, "Sie haben in  ga(...)  kein gültiges Argument eingegeben !")
  197.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  198.   /*  damit in den diesbezüglichen temporären Dateien                      */
  199.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  200.      EXIT
  201.    end
  202.  
  203.