8 |
|
use strict; |
9 |
|
use File::Temp qw/ :mktemp /; |
10 |
|
sub userror { |
11 |
< |
print STDERR "Usage: genBSDF [-n Nproc][-c Nsamp][-t{3|4} Nlog2][-r \"ropts\"][-dim xmin xmax ymin ymax zmin zmax][{+|-}f][{+|-}b][{+|-}mgf][{+|-}geom] [input ..]\n"; |
11 |
> |
print STDERR "Usage: genBSDF [-n Nproc][-c Nsamp][-t{3|4} Nlog2][-r \"ropts\"][-dim xmin xmax ymin ymax zmin zmax][{+|-}f][{+|-}b][{+|-}mgf][{+|-}geom units] [input ..]\n"; |
12 |
|
exit 1; |
13 |
|
} |
14 |
|
my $td = mkdtemp("/tmp/genBSDF.XXXXXX"); |
23 |
|
my $nproc = 1; |
24 |
|
my $doforw = 0; |
25 |
|
my $doback = 1; |
26 |
< |
my $pctcull = 95; |
26 |
> |
my $pctcull = 90; |
27 |
|
my $gunit = "Meter"; |
28 |
|
my @dim; |
29 |
|
# Get options |
45 |
|
} elsif ("$ARGV[0]" =~ /^[-+]b/) { |
46 |
|
$doback = ("$ARGV[0]" =~ /^\+/); |
47 |
|
} elsif ("$ARGV[0]" eq "-t") { |
48 |
+ |
# Use value < 0 for rttree_reduce bypass |
49 |
|
$pctcull = $ARGV[1]; |
50 |
|
shift @ARGV; |
51 |
|
} elsif ("$ARGV[0]" =~ /^-t[34]$/) { |
322 |
|
sub ttree_out { |
323 |
|
my $forw = shift; |
324 |
|
my $side = ("Back","Front")[$forw]; |
325 |
+ |
my $cmd; |
326 |
|
# Only output one transmitted distribution, preferring backwards |
327 |
|
if ( !$forw || !$doback ) { |
328 |
|
print |
337 |
|
<ScatteringDataType>BTDF</ScatteringDataType> |
338 |
|
<ScatteringData> |
339 |
|
'; |
340 |
< |
system "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . |
341 |
< |
q{-e '$1=(0.265*$1+0.670*$2+0.065*$3)/Omega' -of } . |
342 |
< |
"$td/" . ($bmodnm,$fmodnm)[$forw] . "_???.flt " . |
340 |
> |
$cmd = "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . |
341 |
> |
q{-e '$1=(0.265*$1+0.670*$2+0.065*$3)/Omega' }; |
342 |
> |
if ($pctcull >= 0) { |
343 |
> |
$cmd .= "-of $td/" . ($bmodnm,$fmodnm)[$forw] . "_???.flt " . |
344 |
|
"| rttree_reduce -a -h -ff -t $pctcull -r $tensortree -g $ttlog2"; |
345 |
< |
die "Failure running rttree_reduce" if ( $? ); |
345 |
> |
system "$cmd" || die "Failure running rttree_reduce"; |
346 |
> |
} else { |
347 |
> |
$cmd .= "$td/" . ($bmodnm,$fmodnm)[$forw] . "_???.flt"; |
348 |
> |
print "{\n"; |
349 |
> |
system "$cmd" || die "Failure running rcalc"; |
350 |
> |
print "}\n"; |
351 |
> |
} |
352 |
|
print |
353 |
|
' </ScatteringData> |
354 |
|
</WavelengthDataBlock> |
370 |
|
<ScatteringDataType>BRDF</ScatteringDataType> |
371 |
|
<ScatteringData> |
372 |
|
'; |
373 |
< |
system "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . |
374 |
< |
q{-e '$1=(0.265*$1+0.670*$2+0.065*$3)/Omega' -of } . |
375 |
< |
"$td/" . ($fmodnm,$bmodnm)[$forw] . "_???.flt " . |
373 |
> |
$cmd = "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . |
374 |
> |
q{-e '$1=(0.265*$1+0.670*$2+0.065*$3)/Omega' }; |
375 |
> |
if ($pctcull >= 0) { |
376 |
> |
$cmd .= "-of $td/" . ($fmodnm,$bmodnm)[$forw] . "_???.flt " . |
377 |
|
"| rttree_reduce -a -h -ff -t $pctcull -r $tensortree -g $ttlog2"; |
378 |
< |
die "Failure running rttree_reduce" if ( $? ); |
378 |
> |
system "$cmd" || die "Failure running rttree_reduce"; |
379 |
> |
} else { |
380 |
> |
$cmd .= "$td/" . ($fmodnm,$bmodnm)[$forw] . "_???.flt"; |
381 |
> |
print "{\n"; |
382 |
> |
system "$cmd" || die "Failure running rcalc"; |
383 |
> |
print "}\n"; |
384 |
> |
} |
385 |
|
print |
386 |
|
' </ScatteringData> |
387 |
|
</WavelengthDataBlock> |
419 |
|
$kcal = ' |
420 |
|
DEGREE : PI/180; |
421 |
|
abs(x) : if(x, x, -x); |
422 |
< |
Acos(x) : 1/DEGREE * if(x-1, 0, if(-1-x, 0, acos(x))); |
422 |
> |
Acos(x) : if(x-1, 0, if(-1-x, PI, acos(x))) / DEGREE; |
423 |
|
posangle(a) : if(-a, a + 2*PI, a); |
424 |
< |
Atan2(y,x) : 1/DEGREE * posangle(atan2(y,x)); |
424 |
> |
Atan2(y,x) : posangle(atan2(y,x)) / DEGREE; |
425 |
|
kpola(r) : select(r, 5, 15, 25, 35, 45, 55, 65, 75, 90); |
426 |
|
knaz(r) : select(r, 1, 8, 16, 20, 24, 24, 24, 16, 12); |
427 |
|
kaccum(r) : if(r-.5, knaz(r) + kaccum(r-1), 0); |
453 |
|
"-o '$td/%s.flt' -m $fmodnm -m $bmodnm $octree"; |
454 |
|
my $rccmd = "rcalc -e '$tcal' " . |
455 |
|
"-e 'mod(n,d):n-floor(n/d)*d' -e 'Kbin=mod(recno-.999,$ndiv)' " . |
456 |
< |
q{-if3 -e 'oval=(0.265*$1+0.670*$2+0.065*$3)/KprojOmega' } . |
441 |
< |
q[-o '${ oval },']; |
456 |
> |
q{-if3 -e '$1=(0.265*$1+0.670*$2+0.065*$3)/KprojOmega' }; |
457 |
|
if ( $doforw ) { |
458 |
|
$cmd = "cnt $ndiv $ny $nx | rcalc -of -e '$tcal' " . |
459 |
|
"-e 'xp=(\$3+rand(.12*recno+288))*(($dim[1]-$dim[0])/$nx)+$dim[0]' " . |
479 |
|
system "$cmd" || die "Failure running: $cmd\n"; |
480 |
|
@tbarr = `$rccmd $td/$bmodnm.flt`; |
481 |
|
die "Failure running: $rccmd $td/$bmodnm.flt\n" if ( $? ); |
482 |
+ |
chomp(@tbarr); |
483 |
|
@rbarr = `$rccmd $td/$fmodnm.flt`; |
484 |
|
die "Failure running: $rccmd $td/$fmodnm.flt\n" if ( $? ); |
485 |
+ |
chomp(@rbarr); |
486 |
|
} |
487 |
|
# Output angle basis |
488 |
|
print |
582 |
|
# Output front transmission (transposed order) |
583 |
|
for (my $od = 0; $od < $ndiv; $od++) { |
584 |
|
for (my $id = 0; $id < $ndiv; $id++) { |
585 |
< |
print $tfarr[$ndiv*$id + $od]; |
585 |
> |
print $tfarr[$ndiv*$id + $od], ",\n"; |
586 |
|
} |
587 |
|
print "\n"; |
588 |
|
} |
602 |
|
<ScatteringDataType>BRDF</ScatteringDataType> |
603 |
|
<ScatteringData> |
604 |
|
'; |
605 |
< |
# Output front reflection (reciprocity averaging) |
605 |
> |
# Output front reflection (transposed order) |
606 |
|
for (my $od = 0; $od < $ndiv; $od++) { |
607 |
|
for (my $id = 0; $id < $ndiv; $id++) { |
608 |
< |
print .5*($rfarr[$ndiv*$id + $od] + $rfarr[$ndiv*$od + $id]); |
608 |
> |
print $rfarr[$ndiv*$id + $od], ",\n"; |
609 |
|
} |
610 |
|
print "\n"; |
611 |
|
} |
632 |
|
# Output back transmission (transposed order) |
633 |
|
for (my $od = 0; $od < $ndiv; $od++) { |
634 |
|
for (my $id = 0; $id < $ndiv; $id++) { |
635 |
< |
print $tbarr[$ndiv*$id + $od]; |
635 |
> |
print $tbarr[$ndiv*$id + $od], ",\n"; |
636 |
|
} |
637 |
|
print "\n"; |
638 |
|
} |
652 |
|
<ScatteringDataType>BRDF</ScatteringDataType> |
653 |
|
<ScatteringData> |
654 |
|
'; |
655 |
< |
# Output back reflection (reciprocity averaging) |
655 |
> |
# Output back reflection (transposed order) |
656 |
|
for (my $od = 0; $od < $ndiv; $od++) { |
657 |
|
for (my $id = 0; $id < $ndiv; $id++) { |
658 |
< |
print .5*($rbarr[$ndiv*$id + $od] + $rbarr[$ndiv*$od + $id]); |
658 |
> |
print $rbarr[$ndiv*$id + $od], ",\n"; |
659 |
|
} |
660 |
|
print "\n"; |
661 |
|
} |