| 1 |
greg |
2.1 |
#!/usr/bin/perl -w
|
| 2 |
greg |
2.6 |
# RCSid $Id: iso2klems.pl,v 2.5 2022/10/04 14:08:17 greg Exp $
|
| 3 |
greg |
2.1 |
#
|
| 4 |
|
|
# Convert tabulated isotropic direct-hemispherical and direct-direct to Klems XML
|
| 5 |
|
|
#
|
| 6 |
|
|
# G. Ward
|
| 7 |
|
|
#
|
| 8 |
|
|
use strict;
|
| 9 |
|
|
my $windoz = ($^O eq "MSWin32" or $^O eq "MSWin64");
|
| 10 |
|
|
use File::Temp qw/ :mktemp /;
|
| 11 |
|
|
sub userror {
|
| 12 |
greg |
2.2 |
print STDERR "Usage: iso2klems [-t][-f \"x=string;y=string\"][-u unit] [input.dat]\n";
|
| 13 |
greg |
2.1 |
exit 1;
|
| 14 |
|
|
}
|
| 15 |
|
|
my ($td,$rmtmp,$cmd);
|
| 16 |
|
|
if ($windoz) {
|
| 17 |
|
|
my $tmploc = `echo \%TMP\%`;
|
| 18 |
|
|
chomp $tmploc;
|
| 19 |
|
|
$td = mkdtemp("$tmploc\\iso2klems.XXXXXX");
|
| 20 |
|
|
$rmtmp = "rd /S /Q $td";
|
| 21 |
|
|
} else {
|
| 22 |
|
|
$td = mkdtemp("/tmp/iso2klems.XXXXXX");
|
| 23 |
|
|
chomp $td;
|
| 24 |
|
|
$rmtmp = "rm -rf $td";
|
| 25 |
|
|
}
|
| 26 |
|
|
my $wrapper = 'wrapBSDF -W -a kf -C "Generated by iso2klems"';
|
| 27 |
|
|
my $reverse = 0;
|
| 28 |
|
|
# Get options
|
| 29 |
|
|
while ($#ARGV >= 0) {
|
| 30 |
|
|
if ("$ARGV[0]" eq "-t") {
|
| 31 |
|
|
$reverse = ! $reverse;
|
| 32 |
greg |
2.2 |
} elsif ("$ARGV[0]" =~ /^-[fs]$/) {
|
| 33 |
greg |
2.1 |
$wrapper .= " -f \"$ARGV[1]\"";
|
| 34 |
|
|
shift @ARGV;
|
| 35 |
greg |
2.2 |
} elsif ("$ARGV[0]" eq "-u") {
|
| 36 |
|
|
$wrapper .= " -u $ARGV[1]";
|
| 37 |
|
|
shift @ARGV;
|
| 38 |
greg |
2.1 |
} elsif ("$ARGV[0]" =~ /^-./) {
|
| 39 |
|
|
userror();
|
| 40 |
|
|
} else {
|
| 41 |
|
|
last;
|
| 42 |
|
|
}
|
| 43 |
|
|
shift @ARGV;
|
| 44 |
|
|
}
|
| 45 |
greg |
2.6 |
userror() if ($#ARGV > 0);
|
| 46 |
greg |
2.1 |
my $funcfile = "$td/isofuncs.cal";
|
| 47 |
|
|
my @vnm = ("Tspec","Tdiff","Rspec","Rdiff");
|
| 48 |
greg |
2.5 |
if ($#ARGV == 0) {
|
| 49 |
|
|
system "tabfunc -i @vnm < \"$ARGV[0]\" > $funcfile";
|
| 50 |
|
|
} else {
|
| 51 |
|
|
system "tabfunc -i @vnm > $funcfile";
|
| 52 |
|
|
}
|
| 53 |
greg |
2.1 |
die "Invalid input data, requires 5 columns\n" if ( $? );
|
| 54 |
|
|
open (MYFH, ">> $funcfile");
|
| 55 |
|
|
print MYFH "DEG : PI/180;\n";
|
| 56 |
greg |
2.4 |
print MYFH "sq(x) : x*x;\n";
|
| 57 |
greg |
2.1 |
print MYFH "eq(a,b) : min(a-b+1e-5,b-a+1e-5);\n";
|
| 58 |
|
|
print MYFH "rtheta(i) : select(i,5,15,25,35,45,55,65,75,90);\n";
|
| 59 |
|
|
print MYFH "nphis(i) : select(i,1,8,16,20,24,24,24,16,12);\n";
|
| 60 |
|
|
print MYFH "tdeg1(tb) : if(tb-1.5, (rtheta(tb)+rtheta(tb-1))/2, 0);\n";
|
| 61 |
greg |
2.4 |
print MYFH "omega1(tb) : PI*if(tb-1.5, (sq(cos(rtheta(tb-1)*DEG))-sq(cos(rtheta(tb)*DEG)))/nphis(tb),";
|
| 62 |
|
|
print MYFH "\t(1 - sq(cos(rtheta(1)*DEG))));\n";
|
| 63 |
greg |
2.1 |
print MYFH "tbin(b,cnt) : if(nphis(b)-cnt-.5, b, tbin(b+1,cnt-nphis(b)));\n";
|
| 64 |
|
|
print MYFH "tdeg(b) : tdeg1(tbin(1,b-1));\n";
|
| 65 |
|
|
print MYFH "omega(b) : omega1(tbin(1,b-1));\n";
|
| 66 |
|
|
close MYFH;
|
| 67 |
|
|
# Compute front and back diffuse hemispherical integrals
|
| 68 |
|
|
my $hsamps = 26;
|
| 69 |
|
|
my $nsamps = $hsamps * 2;
|
| 70 |
|
|
if ($windoz) {
|
| 71 |
|
|
$cmd = qq{cnt $nsamps } .
|
| 72 |
|
|
qq{| rcalc -f $funcfile -w -e "tdeg=180/$nsamps*(\$1+.5);abs(x):if(x,x,-x)" } .
|
| 73 |
greg |
2.4 |
qq{-e "theta=tdeg*DEG;ifact=PI*PI*abs(cos(theta))*sin(theta)" } .
|
| 74 |
greg |
2.1 |
q{-e "$1=ifact*Tdiff(tdeg);$2=ifact*Rdiff(tdeg)" } .
|
| 75 |
|
|
qq{| total -$hsamps -m};
|
| 76 |
|
|
} else {
|
| 77 |
|
|
$cmd = qq{cnt $nsamps } .
|
| 78 |
|
|
qq{| rcalc -f $funcfile -w -e 'tdeg=180/$nsamps*(\$1+.5);abs(x):if(x,x,-x)' } .
|
| 79 |
greg |
2.4 |
qq{-e 'theta=tdeg*DEG;ifact=PI*PI*abs(cos(theta))*sin(theta)' } .
|
| 80 |
greg |
2.1 |
q{-e '$1=ifact*Tdiff(tdeg);$2=ifact*Rdiff(tdeg)' -od } .
|
| 81 |
|
|
qq{| total -id2 -$hsamps -m};
|
| 82 |
|
|
}
|
| 83 |
|
|
# Returns side 1 Th-h, side 1 Rh-h, side 2 Th-h, side 2 Rh-h
|
| 84 |
|
|
my @h2h = split /\s+/, `$cmd`;
|
| 85 |
|
|
die "Error running rcalc" if ( $? || $#h2h != 3 );
|
| 86 |
|
|
# Compute Klems matrices
|
| 87 |
|
|
my $TK1dataf = "$td/trans1m.txt";
|
| 88 |
|
|
my $RK1dataf = "$td/refl1m.txt";
|
| 89 |
|
|
my $TK2dataf = "$td/trans2m.txt";
|
| 90 |
|
|
my $RK2dataf = "$td/refl2m.txt";
|
| 91 |
|
|
if ($windoz) {
|
| 92 |
|
|
$cmd = qq{cnt 145 145 } .
|
| 93 |
|
|
qq{| rcalc -f $funcfile } .
|
| 94 |
|
|
q{-e "diag=eq($1,$2);tideg=tdeg($1+1);tsdeg=tdeg($2+1);om=omega($1+1);corr=PI/(PI-om)" } .
|
| 95 |
|
|
qq{-e "Td1=if($h2h[0]-.001,Tdiff(tideg)*Tdiff(tsdeg)/$h2h[0],0)" } .
|
| 96 |
|
|
qq{-e "Rd1=if($h2h[1]-.001,Rdiff(tideg)*Rdiff(tsdeg)/$h2h[1],0)" } .
|
| 97 |
|
|
qq{-e "Td2=if($h2h[2]-.001,Tdiff(180-tideg)*Tdiff(180-tsdeg)/$h2h[2],0)" } .
|
| 98 |
|
|
qq{-e "Rd2=if($h2h[3]-.001,Rdiff(180-tideg)*Rdiff(180-tsdeg)/$h2h[3],0)" } .
|
| 99 |
greg |
2.3 |
q{-e "$1=if(Tspec(0),if(diag,Tspec(tideg)/om,Td1*corr),Td1)" } .
|
| 100 |
|
|
q{-e "$2=if(Rspec(0),if(diag,Rspec(tideg)/om,Rd1*corr),Rd1)" } .
|
| 101 |
|
|
q{-e "$3=if(Tspec(180),if(diag,Tspec(180-tideg)/om,Td2*corr),Td2)" } .
|
| 102 |
|
|
q{-e "$4=if(Rspec(180),if(diag,Rspec(180-tideg)/om,Rd2*corr),Rd2)" };
|
| 103 |
greg |
2.1 |
} else {
|
| 104 |
|
|
$cmd = qq{cnt 145 145 } .
|
| 105 |
|
|
qq{| rcalc -f $funcfile } .
|
| 106 |
|
|
q{-e 'diag=eq($1,$2);tideg=tdeg($1+1);tsdeg=tdeg($2+1);om=omega($1+1);corr=PI/(PI-om)' } .
|
| 107 |
|
|
qq{-e 'Td1=if($h2h[0]-.001,Tdiff(tideg)*Tdiff(tsdeg)/$h2h[0],0)' } .
|
| 108 |
|
|
qq{-e 'Rd1=if($h2h[1]-.001,Rdiff(tideg)*Rdiff(tsdeg)/$h2h[1],0)' } .
|
| 109 |
|
|
qq{-e 'Td2=if($h2h[2]-.001,Tdiff(180-tideg)*Tdiff(180-tsdeg)/$h2h[2],0)' } .
|
| 110 |
|
|
qq{-e 'Rd2=if($h2h[3]-.001,Rdiff(180-tideg)*Rdiff(180-tsdeg)/$h2h[3],0)' } .
|
| 111 |
greg |
2.3 |
q{-e '$1=if(Tspec(0),if(diag,Tspec(tideg)/om,Td1*corr),Td1)' } .
|
| 112 |
|
|
q{-e '$2=if(Rspec(0),if(diag,Rspec(tideg)/om,Rd1*corr),Rd1)' } .
|
| 113 |
|
|
q{-e '$3=if(Tspec(180),if(diag,Tspec(180-tideg)/om,Td2*corr),Td2)' } .
|
| 114 |
|
|
q{-e '$4=if(Rspec(180),if(diag,Rspec(180-tideg)/om,Rd2*corr),Rd2)' };
|
| 115 |
greg |
2.1 |
}
|
| 116 |
|
|
system qq{$cmd | rsplit "-t " $TK1dataf $RK1dataf $TK2dataf $RK2dataf};
|
| 117 |
|
|
die "Error running rcalc or rsplit" if ( $? );
|
| 118 |
|
|
if ($reverse) {
|
| 119 |
|
|
$wrapper .= " -tf $TK2dataf -rf $RK2dataf -tb $TK1dataf -rb $RK1dataf";
|
| 120 |
|
|
} else {
|
| 121 |
|
|
$wrapper .= " -tf $TK1dataf -rf $RK1dataf -tb $TK2dataf -rb $RK2dataf";
|
| 122 |
|
|
}
|
| 123 |
|
|
system $wrapper;
|
| 124 |
|
|
die "Error running: $wrapper\n" if ( $? );
|
| 125 |
|
|
exec $rmtmp;
|
