home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / MISC / RCDSPLAY.ZIP / MATH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-10  |  8.7 KB  |  230 lines
  1. UNIT MATH;
  2.  
  3. {*******************************************************************************
  4.  AUTHOR   : Roger Carlson
  5.  VERSION  : 1.3
  6.  UPDATES  : 3/28/91 (1.1,RJC) - Added the 95% students T function.
  7.             5/3/91  (1.2,RJC) - Added wavelength/wavenumber conversions.
  8.             5/10/91 (1.3,RJC) - Added HEX function.
  9. *******************************************************************************}
  10.  
  11. INTERFACE
  12.  
  13. FUNCTION T(DF:INTEGER):DOUBLE;
  14. FUNCTION LOG(INP : REAL) : REAL;
  15. FUNCTION PWROF2(X:longint):LONGINT;
  16. FUNCTION PWROFTWO(X : INTEGER) : INTEGER;
  17. FUNCTION PWROF10(NUMBER:LONGINT):DOUBLE;
  18. FUNCTION ARCCOS(COSTHETA:DOUBLE):DOUBLE;
  19. FUNCTION ARCSIN(SINTHETA:DOUBLE):DOUBLE;
  20. FUNCTION TAN(THETA:DOUBLE):DOUBLE;
  21. FUNCTION COTAN(THETA:DOUBLE):DOUBLE;
  22. FUNCTION A_TO_CM(WAVELENGTH:DOUBLE):DOUBLE;
  23. FUNCTION CM_TO_A(WAVENUMBER:DOUBLE):DOUBLE;
  24. FUNCTION HEX(B:BYTE):STRING;
  25.  
  26. IMPLEMENTATION
  27.  
  28. {***************************************************************************
  29.  TITLE   : FUNCTION HEX(B:BYTE):STRING;
  30.  AUTHOR  : Roger Carlson  (May 1991)
  31.  FUNCTION: Converts a binary byte to hexidecimal format.
  32.  INPUTS  : B - Byte in binary.
  33.  OUTPUTS : String containing hex representation of B.
  34. ****************************************************************************}
  35. FUNCTION HEX;
  36. VAR B1,B2:BYTE; C1,C2:CHAR;
  37. BEGIN
  38.   B1:=B AND $F; B2:=(B AND $F0) SHR 4;
  39.   IF B1>9 THEN C1:=CHAR(55+B1) ELSE C1:=CHAR(48+B1);
  40.   IF B2>9 THEN C2:=CHAR(55+B2) ELSE C2:=CHAR(48+B2);
  41.   HEX:=CONCAT(C2,C1);
  42. END;
  43.  
  44. {*******************************************************************************
  45.  TITLE   : FUNCTION T(DF:INTEGER):DOUBLE;
  46.  AUTHOR  : Roger Carlson   (August 1986)
  47.  FUNCTION: This function returns the 95% double sided Student's t.
  48.  INPUTS  : DF - degrees of freedom
  49.  NOTES   : 1. DF must be at least 1.
  50. *******************************************************************************}
  51. FUNCTION T; BEGIN
  52.   CASE DF OF
  53.     1: T:=12.706;  2: T:=4.303;   3: T:=3.182;   4: T:=2.776;   5: T:=2.571;
  54.     6: T:=2.447;   7: T:=2.365;   8: T:=2.306;   9: T:=2.262;   10:T:=2.228;
  55.     11:T:=2.201;   12:T:=2.179;   13:T:=2.160;   14:T:=2.145;   15:T:=2.131;
  56.     16:T:=2.120;   17:T:=2.110;   18:T:=2.101;   19:T:=2.093;   20:T:=2.086;
  57.     21:T:=2.080;   22:T:=2.074;   23:T:=2.069;   24:T:=2.064;   25:T:=2.060;
  58.     26:T:=2.056;   27:T:=2.052;   28:T:=2.048;   29:T:=2.045;
  59.     ELSE T:=1.960;
  60.   END; {CASE}
  61. END; {FUNCTION T}
  62.  
  63. {******************************************************************************
  64.   TITLE:      LOG(INP : REAL) : REAL;
  65.   VERSION:    1.0
  66.   FUNCTION:   Takes base 10 logarithm of a number.
  67.   INPUTS:     A real number.
  68.   OUTPUTS:    The log of the input real number.
  69.   NOTES:      Why doesn't standard PASCAL have this???
  70.   AUTHOR:     M. Riebe 5/2/85
  71.   CHANGES:
  72. ******************************************************************************}
  73. FUNCTION LOG; BEGIN
  74.   LOG := LN(INP)/2.3025851;
  75. END;
  76.  
  77. {******************************************************************************
  78.  TITLE   : FUNCTION PWROF2(X:longint):LONGINT;
  79.  AUTHOR  : Roger Carlson      3/14/87
  80.  FUNCTION: This function returns 2 raised to the power x.
  81.  INPUTS  : X - Exponent of 2 (a positive number).
  82.  OUTPUTS : 2**X
  83.  NOTES   : 1. The maximum LONGINT is 2147483647=$7FFFFFFF or x=31.
  84.  CHANGES :
  85. *******************************************************************************}
  86. FUNCTION PWROF2; BEGIN
  87.   X:=ABS(X);
  88.   CASE X OF
  89.     0:PWROF2:=1;   1:PWROF2:=2;    2:PWROF2:=4;     3:PWROF2:=8;
  90.     4:PWROF2:=16;  5:PWROF2:=32;   6:PWROF2:=64;    7:PWROF2:=128;
  91.     8:PWROF2:=256; 9:PWROF2:=512; 10:PWROF2:=1024; 11:PWROF2:=2048;
  92.     ELSE PWROF2:=2*PWROF2(X-1);
  93.   END; {CASE}
  94. END; {FUNCTION PWROF2}
  95.  
  96. {******************************************************************************
  97.   TITLE:      PWROFTWO(X : INTEGER) : INTEGER;
  98.   VERSION:    1.0
  99.   FUNCTION:   Takes 2 to the X power.
  100.   INPUTS:     X, an integer value.
  101.   OUTPUTS:    2 to the X power, also an integer.
  102.   NOTES:
  103.   AUTHOR:     Adapted for integer output from R. Carlson's by M. Riebe, 6/23/85
  104.   CHANGES:
  105. ******************************************************************************}
  106. FUNCTION PWROFTWO;BEGIN
  107.  IF X=0 THEN PWROFTWO := 1 ELSE PWROFTWO := 2 * PWROFTWO(X-1);
  108. END;
  109.  
  110. {******************************************************************************
  111.   TITLE:    PWROF10(NUMBER:LONGINT): DOUBLE
  112.   VERSION:  1.1
  113.   FUNCTION: Calculates integral powers of ten to double precision.
  114.   NOTES:
  115.   AUTHOR:   RJC 9/25/85
  116.   CHANGES:  (4/8/90, 1.1, RJC) Modified to use a look up table for small
  117.               values of NUMBER.
  118.             (5/31/90, 1.2, RJC) Fixed error in look-up table.
  119. ******************************************************************************}
  120. FUNCTION PWROF10; BEGIN
  121.   IF NUMBER<0 THEN PWROF10:=1/PWROF10(ABS(NUMBER))
  122.   ELSE CASE NUMBER OF
  123.     0: PWROF10:=1;    1: PWROF10:=10;    2: PWROF10:=1E2;
  124.     3: PWROF10:=1E3;  4: PWROF10:=1E4;   5: PWROF10:=1E5;
  125.     6: PWROF10:=1E6;  7: PWROF10:=1E7;   8: PWROF10:=1E8;
  126.     9: PWROF10:=1E9; 10: PWROF10:=1E10; 11: PWROF10:=1E11;
  127.     ELSE PWROF10:=10E0*PWROF10(NUMBER-1);
  128.     END {CASE}
  129. END;
  130.  
  131. {*****************************************************************************
  132.  TITLE    : FUNCTION ARCCOS(COSTHETA:DOUBLE):DOUBLE;
  133.  VERSION  : 1.0
  134.  AUTHOR   : RJC 11/21/85
  135.  FUNCTION : Calculates the inverse cosine of COSTHETA in radians.
  136.  CHANGES  :
  137. ****************************************************************************}
  138. FUNCTION ARCCOS; BEGIN
  139.   IF ABS(COSTHETA)>1E0 THEN BEGIN
  140.     ARCCOS:=0;
  141.     WRITELN('Error in ARCCOS function of MATH!  Arguement out of range.');
  142.     END {IF}
  143.   ELSE ARCCOS:=ARCTAN(SQRT(1E0/SQR(COSTHETA)-1E0));
  144. END; {FUNCTION ARCCOS}
  145.  
  146. {*******************************************************************************
  147.  TITLE    : FUNCTION ARCSIN(SINTHETA:DOUBLE):DOUBLE;
  148.  VERSION  : 1.0
  149.  AUTHOR   : RJC 11/21/85
  150.  FUNCTION : Calculates the inverse sine of SINTHETA in radians.
  151.  CHANGES  :
  152. *******************************************************************************}
  153. FUNCTION ARCSIN;
  154. VAR THETA:DOUBLE;
  155. BEGIN
  156.   IF ABS(SINTHETA)>1E0 THEN BEGIN
  157.     ARCSIN:=0;
  158.     WRITELN('Error in ARCSIN function of MATH!  Arguement out of range.');
  159.     END {IF}
  160.   ELSE THETA:=ARCTAN(SQRT(1E0/(1E0/SQR(SINTHETA)-1E0)));
  161.   IF SINTHETA<0 THEN ARCSIN:=-THETA
  162.   ELSE ARCSIN:=THETA;
  163. END; {FUNCTION ARCSIN}
  164.  
  165. {*******************************************************************************
  166.  TITLE    : FUNCTION TAN(THETA:DOUBLE):DOUBLE;
  167.  VERSION  : 1.0
  168.  AUTHOR   : RJC 11/21/85
  169.  FUNCTION : Calculates the tangent of THETA where THETA is in radians.
  170.  CHANGES  :
  171. *******************************************************************************}
  172. FUNCTION TAN; BEGIN
  173.   TAN:=SIN(THETA)/COS(THETA);
  174.   END; {FUNCTION TAN}
  175.  
  176. {*******************************************************************************
  177.  TITLE    : FUNCTION COTAN(THETA:DOUBLE):DOUBLE;
  178.  VERSION  : 1.0
  179.  AUTHOR   : RJC 11/21/85
  180.  FUNCTION : Calculates the cotangent of THETA where THETA is in radians.
  181.  CHANGES  :
  182. *******************************************************************************}
  183. FUNCTION COTAN; BEGIN
  184.   COTAN:=COS(THETA)/SIN(THETA);
  185.   END; {FUNCTION COTAN}
  186.  
  187. {*************************************************************************
  188.  TITLE:    REF_IND(WAVENUM:DOUBLE):DOUBLE
  189.  VERSION:  1.0   (Roger Carlson, 5/3/91)
  190.  FUNCTION: Calculates refractive index of air according to Eblens formula.
  191.  INPUT:    Vacuum wavenumber.
  192.  OUTPUT:   Refractive index in air.
  193. **************************************************************************}
  194. FUNCTION REF_IND(WAVENUM:DOUBLE):DOUBLE;
  195. CONST A=6432.8E-8; B=2.949810E6; C=1.46E10; D=2.5540E4; E=4.1E9;
  196. BEGIN
  197.   REF_IND:=1.0E0 + A + B/(C-SQR(WAVENUM)) + D/(E-SQR(WAVENUM));
  198. END;
  199.  
  200. {**************************************************************************
  201.  TITLE    : CM_TO_A(WAVENUMBER:DOUBLE):DOUBLE
  202.  VERSION  : 1.0
  203.  FUNCTION : Converts wavenumbers to wavelength.
  204.  INPUTS   : Vacuum wavenumber in cm-1.
  205.  OUTPUTS  : Air wavelength in Angstroms.
  206. ***************************************************************************}
  207. FUNCTION CM_TO_A; BEGIN
  208.   CM_TO_A:=1.0E8/WAVENUMBER/REF_IND(WAVENUMBER);
  209. END;
  210.  
  211. {**************************************************************************
  212.  TITLE    : A_TO_CM(WAVELENGTH:DOUBLE):DOUBLE;
  213.  VERSION  : 1.0
  214.  FUNCTION : Converts wavelength in Angstroms in air to vacuum wavenumbers.
  215.  INPUTS   : Wavelength in Angstroms (air).
  216.  OUTPUTS  : Wavenumber in cm-1 (vacuum).
  217. ***************************************************************************}
  218. FUNCTION A_TO_CM;
  219. CONST LIMIT=1.0E-5; {level of precision in Angstroms}
  220. VAR CM:DOUBLE;
  221. BEGIN
  222.   CM:=1.0E8/WAVELENGTH;
  223.   REPEAT
  224.     CM:=1.0E8/WAVELENGTH/REF_IND(CM);
  225.   UNTIL ABS(CM_TO_A(CM)-WAVELENGTH)<LIMIT;
  226.   A_TO_CM:=CM;
  227. END; {FUNCTION A_TO_CM}
  228.  
  229. END. {UNIT}
  230.