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