home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / CEL.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  1.1 KB  |  52 lines
  1. PROGRAM d6r29(input,output);
  2. (* driver for routine CEL *)
  3. CONST
  4.    pio2=1.5707963;
  5. VAR
  6.    glit : integer;
  7.    glinext,glinextp : integer;
  8.    glma : ARRAY [1..55] OF real;
  9.    gla,glb,glp,glakc : real;
  10.    ago,astop,s : real;
  11.    i,idum : integer;
  12.  
  13. FUNCTION func(phi: real): real;
  14. (* Programs using routine FUNC must declare the variables
  15. VAR
  16.    gla,glb,glp,glakc : real;
  17. in the main routine. *)
  18. VAR
  19.    cs,csq,ssq : real;
  20. BEGIN
  21.    cs := cos(phi);
  22.    csq := cs*cs;
  23.    ssq := 1.0-csq;
  24.    func := (gla*csq+glb*ssq)/(csq+glp*ssq)/sqrt(csq+glakc*glakc*ssq)
  25. END;
  26.  
  27. (*$I MODFILE.PAS *)
  28. (*$I RAN3.PAS *)
  29.  
  30. (*$I TRAPZD.PAS *)
  31.  
  32. (*$I QSIMP.PAS *)
  33.  
  34. (*$I CEL.PAS *)
  35.  
  36. BEGIN
  37.    writeln('complete elliptic integral');
  38.    writeln('kc':7,'p':10,'a':10,'b':10,'cel':11,'integral':12);
  39.    idum := -55;
  40.    ago := 0.0;
  41.    astop := pio2;
  42.    FOR i := 1 to 20 DO BEGIN
  43.       glakc := 0.1+ran3(idum);
  44.       gla := 10.0*ran3(idum);
  45.       glb := 10.0*ran3(idum);
  46.       glp := 0.1+ran3(idum);
  47.       qsimp(ago,astop,s);
  48.       writeln(glakc:10:6,glp:10:6,gla:10:6,glb:10:6,
  49.          cel(glakc,glp,gla,glb):10:6,s:10:6)
  50.    END
  51. END.
  52.