71 |
# relative acceptable variation. If $ref is zero, $prec is an absolute |
# relative acceptable variation. If $ref is zero, $prec is an absolute |
72 |
# acceptable variation. |
# acceptable variation. |
73 |
|
|
74 |
|
sub BoundCheck{ |
75 |
|
my($title,$value,$ref,$prec) = @_; |
76 |
|
|
77 |
|
# Is it in the given bounds? |
78 |
|
if(($ref == 0 && ($value < -$prec || $value > $prec)) |
79 |
|
|| ($ref > 0 |
80 |
|
&& ($value < (1-$prec)*$ref || $value > (1+$prec)*$ref)) |
81 |
|
|| ($ref < 0 |
82 |
|
&& ($value < (1+$prec)*$ref || $value > (1-$prec)*$ref)) |
83 |
|
){ |
84 |
|
print "*** $title$value (it should be $ref +/- $prec)\n"; |
85 |
|
$errors += 1; |
86 |
|
} |
87 |
|
} |
88 |
|
|
89 |
sub NumCheck{ |
sub NumCheck{ |
90 |
|
|
91 |
my($title,$ref,$prec) = @_; |
my($title,$ref,$prec) = @_; |
105 |
$errors += 1; |
$errors += 1; |
106 |
} |
} |
107 |
|
|
108 |
# Is it in the given bounds? |
BoundCheck($title,$value,$ref,$prec); |
|
if(($ref == 0 && ($value < -$prec || $value > $prec)) |
|
|
|| ($ref > 0 |
|
|
&& ($value < (1-$prec)*$ref || $value > (1+$prec)*$ref)) |
|
|
|| ($ref < 0 |
|
|
&& ($value < (1+$prec)*$ref || $value > (1-$prec)*$ref)) |
|
|
){ |
|
|
print "*** $title$value (it should be $ref +/- $prec)\n"; |
|
|
$errors += 1; |
|
|
} |
|
109 |
} |
} |
110 |
else{ |
else{ |
111 |
print "*** \"$title\" not found\n"; |
print "*** \"$title\" not found\n"; |
257 |
// Therefore, the correct solution for the above problem is one |
// Therefore, the correct solution for the above problem is one |
258 |
// on all points inside the object, and a value between 0 and 1 |
// on all points inside the object, and a value between 0 and 1 |
259 |
// at all other points. |
// at all other points. |
260 |
|
EOF |
261 |
|
|
262 |
|
# Only set boundary conditions on existing boundaries (see |
263 |
|
# WriteDomainPovrayScene() for list of all possible objects). |
264 |
|
|
265 |
u = 1 on <1,0,0>; |
$script .= "u = 1 on <1,0,0>;\n" if $domainop =~ /<1,0,0>/; |
266 |
u = 1 on <0,1,0>; |
$script .= "u = 1 on <0,1,0>;\n" if $domainop =~ /<0,1,0>/; |
267 |
|
$script .= "u = 1 on <0,0,1>;\n" if $domainop =~ /<0,0,1>/; |
268 |
|
$script .= << 'EOF'; |
269 |
u = 0 on M; |
u = 0 on M; |
270 |
} |
} |
271 |
EOF |
EOF |
305 |
} |
} |
306 |
} |
} |
307 |
|
|
308 |
|
# Reads data from a file in edit format and gives back a array of |
309 |
|
# floating point values |
310 |
|
sub ReadMEdit{ |
311 |
|
my ($filename) = @_; |
312 |
|
die "$filename does not exist" unless -f $filename; |
313 |
|
open DATA,"<$filename"; |
314 |
|
my $firstline = <DATA>; |
315 |
|
die "$filename is not in the required MEdit format" |
316 |
|
unless $firstline =~ /^3\s+1\s+(\d+)\s+2$/; |
317 |
|
my $nbval = $1; |
318 |
|
|
319 |
|
my @vals = (); |
320 |
|
while(<DATA>){ |
321 |
|
die "Error in $filename data" unless /^\s*([0-9.+-eE]+)\s*$/; |
322 |
|
push @vals,$1; |
323 |
|
} |
324 |
|
close DATA; |
325 |
|
|
326 |
|
die "$filename does not contain the right amount of data" |
327 |
|
unless @vals == $nbval; |
328 |
|
|
329 |
|
return @vals; |
330 |
|
} |
331 |
|
|
332 |
|
# Computes the L2 norm of the difference between two vectors. The two |
333 |
|
# vectors are passed as references. |
334 |
|
|
335 |
|
sub L2Diff{ |
336 |
|
my($ref1,$ref2) = @_; |
337 |
|
die "The two vectors should have the same size" unless @$ref1 == @$ref2; |
338 |
|
my $diff = 0; |
339 |
|
for(my $i = 0;$i < @$ref1;$i++){ |
340 |
|
$diff += ($$ref2[$i] - $$ref1[$i])**2; |
341 |
|
} |
342 |
|
return sqrt($diff); |
343 |
|
} |
344 |
|
|
345 |
|
# Checks that two result files in MEdit format contain the same value. |
346 |
|
|
347 |
|
sub VectorCheck{ |
348 |
|
|
349 |
|
my ($file1,$file2,$prec) = @_; |
350 |
|
my @vec1 = ReadMEdit($file1); |
351 |
|
my @vec2 = ReadMEdit($file2); |
352 |
|
BoundCheck($file1 ." / ".$file2." = ",L2Diff(\@vec1,\@vec2),0,$prec); |
353 |
|
} |
354 |
|
|
355 |
1; |
1; |