|
1 #====================================================================== |
|
2 # N R U T I L . P L |
|
3 # doc: Wed Feb 24 17:44:49 1999 |
|
4 # dlm: Sun Jul 2 00:47:04 2006 |
|
5 # (c) 1999 A.M. Thurnherr |
|
6 # uE-Info: 45 31 NIL 0 0 72 2 2 4 NIL ofnI |
|
7 #====================================================================== |
|
8 |
|
9 # extract from nrutil.c/nrutil.h (Numerical Recipes) adapted for ANTS |
|
10 |
|
11 # HISTORY: |
|
12 # Feb 24, 1999: - created from c-source |
|
13 # Aug 01, 1999: - added macros from nrutil.h |
|
14 # Sep 26, 1999: - added &dumpMatrix() |
|
15 # Jul 1, 2006: - Version 3.3 [HISTORY] |
|
16 |
|
17 # NOTES: |
|
18 # - allocation routines &vector, &matrix needed to make sure |
|
19 # right number of elts is allocated (for $# op) |
|
20 # - array elts are initialized with nan |
|
21 # - array indices MUST start with 1 (in the spirit of FORTRAN IV, bless) |
|
22 # - instead of pointer return, we use refs |
|
23 |
|
24 sub vector($$$) |
|
25 { |
|
26 my($vR,$nl,$nh) = @_; |
|
27 my($i); |
|
28 |
|
29 croak("vector must be 1-relative") |
|
30 unless ($nl == 1); |
|
31 for ($i=1; $i<=$nh; $i++) { |
|
32 $vR->[$i] = nan; |
|
33 } |
|
34 } |
|
35 |
|
36 sub matrix($$$$$) |
|
37 { |
|
38 my($mR,$nrl,$nrh,$ncl,$nch) = @_; |
|
39 my($i,$j); |
|
40 |
|
41 croak("matrix must be 1-relative") |
|
42 unless ($nrl == 1 && $ncl == 1); |
|
43 for ($i=1; $i<=$nrh; $i++) { |
|
44 for ($j=1; $j<=$nch; $j++) { |
|
45 $mR->[$i][$j] = nan; |
|
46 } |
|
47 } |
|
48 } |
|
49 |
|
50 #---------------------------------------------------------------------- |
|
51 |
|
52 sub dumpMatrix($$) |
|
53 { |
|
54 my($msg,$mR) = @_; |
|
55 my($rows) = $#{$mR}; |
|
56 my($cols) = $#{$mR->[1]}; |
|
57 my($r,$c); |
|
58 |
|
59 print(STDERR "$msg: $rows x $cols (rows x cols)\n"); |
|
60 for ($r=1; $r<=$rows; $r++) { |
|
61 for ($c=1; $c<=$cols; $c++) { |
|
62 printf(STDERR "%.3e\t",$mR->[$r][$c]); |
|
63 } |
|
64 print(STDERR "\n"); |
|
65 } |
|
66 } |
|
67 |
|
68 #---------------------------------------------------------------------- |
|
69 # Macros |
|
70 #---------------------------------------------------------------------- |
|
71 |
|
72 sub SQR($) { return $_[0] * $_[0]; } # D?SQR |
|
73 sub MAX($$) { return ($_[0] > $_[1]) ? $_[0] : $_[1]; } # [DF]MAX |
|
74 sub MIN($$) { return ($_[0] < $_[1]) ? $_[0] : $_[1]; } # [DF]MIN |
|
75 sub SIGN($$) { return ($_[1] >= 0) ? $_[0] : -$_[0]; } # SIGN |
|
76 |
|
77 1; |