| 1 | #!/usr/bin/perl -w | 
| 2 | # RCSid $Id: genBSDF.pl,v 2.21 2011/06/08 23:16:47 greg Exp $ | 
| 3 | # | 
| 4 | # Compute BSDF based on geometry and material description | 
| 5 | # | 
| 6 | #       G. Ward | 
| 7 | # | 
| 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"; | 
| 12 | exit 1; | 
| 13 | } | 
| 14 | my $td = mkdtemp("/tmp/genBSDF.XXXXXX"); | 
| 15 | chomp $td; | 
| 16 | my @savedARGV = @ARGV; | 
| 17 | my $tensortree = 0; | 
| 18 | my $ttlog2 = 4; | 
| 19 | my $nsamp = 1000; | 
| 20 | my $rtargs = "-w -ab 5 -ad 700 -lw 3e-6"; | 
| 21 | my $mgfin = 0; | 
| 22 | my $geout = 1; | 
| 23 | my $nproc = 1; | 
| 24 | my $doforw = 0; | 
| 25 | my $doback = 1; | 
| 26 | my $gunit = "Meter"; | 
| 27 | my @dim; | 
| 28 | # Get options | 
| 29 | while ($#ARGV >= 0) { | 
| 30 | if ("$ARGV[0]" =~ /^[-+]m/) { | 
| 31 | $mgfin = ("$ARGV[0]" =~ /^\+/); | 
| 32 | } elsif ("$ARGV[0]" eq "-r") { | 
| 33 | $rtargs = "$rtargs $ARGV[1]"; | 
| 34 | shift @ARGV; | 
| 35 | } elsif ("$ARGV[0]" =~ /^[-+]g/) { | 
| 36 | $geout = ("$ARGV[0]" =~ /^\+/); | 
| 37 | $gunit = $ARGV[1]; | 
| 38 | if ($gunit !~ /^(?i)(meter|foot|inch|centimeter|millimeter)$/) { | 
| 39 | die "Illegal geometry unit '$gunit': must be meter, foot, inch, centimeter, or millimeter\n"; | 
| 40 | } | 
| 41 | shift @ARGV; | 
| 42 | } elsif ("$ARGV[0]" =~ /^[-+]f/) { | 
| 43 | $doforw = ("$ARGV[0]" =~ /^\+/); | 
| 44 | } elsif ("$ARGV[0]" =~ /^[-+]b/) { | 
| 45 | $doback = ("$ARGV[0]" =~ /^\+/); | 
| 46 | } elsif ("$ARGV[0]" =~ /^-t[34]$/) { | 
| 47 | $tensortree = substr($ARGV[0], 2, 1); | 
| 48 | $ttlog2 = $ARGV[1]; | 
| 49 | shift @ARGV; | 
| 50 | } elsif ("$ARGV[0]" eq "-c") { | 
| 51 | $nsamp = $ARGV[1]; | 
| 52 | shift @ARGV; | 
| 53 | } elsif ("$ARGV[0]" eq "-n") { | 
| 54 | $nproc = $ARGV[1]; | 
| 55 | shift @ARGV; | 
| 56 | } elsif ("$ARGV[0]" =~ /^-d/) { | 
| 57 | userror() if ($#ARGV < 6); | 
| 58 | @dim = @ARGV[1..6]; | 
| 59 | shift @ARGV for (1..6); | 
| 60 | } elsif ("$ARGV[0]" =~ /^[-+]./) { | 
| 61 | userror(); | 
| 62 | } else { | 
| 63 | last; | 
| 64 | } | 
| 65 | shift @ARGV; | 
| 66 | } | 
| 67 | # Check that we're actually being asked to do something | 
| 68 | die "Must have at least one of +forward or +backward\n" if (!$doforw && !$doback); | 
| 69 | # Name our own persist file? | 
| 70 | my $persistfile; | 
| 71 | if ( $tensortree && $nproc > 1 && "$rtargs" !~ /-PP /) { | 
| 72 | $persistfile = "$td/pfile.txt"; | 
| 73 | $rtargs = "-PP $persistfile $rtargs"; | 
| 74 | } | 
| 75 | # Get scene description and dimensions | 
| 76 | my $radscn = "$td/device.rad"; | 
| 77 | my $mgfscn = "$td/device.mgf"; | 
| 78 | my $octree = "$td/device.oct"; | 
| 79 | if ( $mgfin ) { | 
| 80 | system "mgfilt '#,o,xf,c,cxy,cspec,cmix,m,sides,rd,td,rs,ts,ir,v,p,n,f,fh,sph,cyl,cone,prism,ring,torus' @ARGV > $mgfscn"; | 
| 81 | die "Could not load MGF input\n" if ( $? ); | 
| 82 | system "mgf2rad $mgfscn > $radscn"; | 
| 83 | } else { | 
| 84 | system "xform -e @ARGV > $radscn"; | 
| 85 | die "Could not load Radiance input\n" if ( $? ); | 
| 86 | system "rad2mgf $radscn > $mgfscn" if ( $geout ); | 
| 87 | } | 
| 88 | if ($#dim != 5) { | 
| 89 | @dim = split ' ', `getbbox -h $radscn`; | 
| 90 | } | 
| 91 | print STDERR "Warning: Device extends into room\n" if ($dim[5] > 1e-5); | 
| 92 | # Add receiver surfaces (rectangular) | 
| 93 | my $fmodnm="receiver_face"; | 
| 94 | my $bmodnm="receiver_behind"; | 
| 95 | open(RADSCN, ">> $radscn"); | 
| 96 | print RADSCN "void glow $fmodnm\n0\n0\n4 1 1 1 0\n\n"; | 
| 97 | print RADSCN "$fmodnm source f_receiver\n0\n0\n4 0 0 1 180\n"; | 
| 98 | print RADSCN "void glow $bmodnm\n0\n0\n4 1 1 1 0\n\n"; | 
| 99 | print RADSCN "$bmodnm source b_receiver\n0\n0\n4 0 0 -1 180\n"; | 
| 100 | close RADSCN; | 
| 101 | # Generate octree | 
| 102 | system "oconv -w $radscn > $octree"; | 
| 103 | die "Could not compile scene\n" if ( $? ); | 
| 104 | # Output XML prologue | 
| 105 | print | 
| 106 | '<?xml version="1.0" encoding="UTF-8"?> | 
| 107 | <WindowElement xmlns="http://windows.lbl.gov" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://windows.lbl.gov/BSDF-v1.4.xsd"> | 
| 108 | '; | 
| 109 | print "<!-- File produced by: genBSDF @savedARGV -->\n"; | 
| 110 | print | 
| 111 | '<WindowElementType>System</WindowElementType> | 
| 112 | <Optical> | 
| 113 | <Layer> | 
| 114 | <Material> | 
| 115 | <Name>Name</Name> | 
| 116 | <Manufacturer>Manufacturer</Manufacturer> | 
| 117 | '; | 
| 118 | printf "\t\t<Thickness unit=\"$gunit\">%.3f</Thickness>\n", $dim[5] - $dim[4]; | 
| 119 | printf "\t\t<Width unit=\"$gunit\">%.3f</Width>\n", $dim[1] - $dim[0]; | 
| 120 | printf "\t\t<Height unit=\"$gunit\">%.3f</Height>\n", $dim[3] - $dim[2]; | 
| 121 | print "\t\t<DeviceType>Integral</DeviceType>\n"; | 
| 122 | # Output MGF description if requested | 
| 123 | if ( $geout ) { | 
| 124 | print "\t\t<Geometry format=\"MGF\" unit=\"$gunit\">\n"; | 
| 125 | printf "xf -t %.6f %.6f 0\n", -($dim[0]+$dim[1])/2, -($dim[2]+$dim[3])/2; | 
| 126 | open(MGFSCN, "< $mgfscn"); | 
| 127 | while (<MGFSCN>) { print $_; } | 
| 128 | close MGFSCN; | 
| 129 | print "xf\n"; | 
| 130 | print "\t\t</Geometry>\n"; | 
| 131 | } | 
| 132 | print " </Material>\n"; | 
| 133 | # Set up surface sampling | 
| 134 | my $nx = int(sqrt($nsamp*($dim[1]-$dim[0])/($dim[3]-$dim[2])) + .5); | 
| 135 | my $ny = int($nsamp/$nx + .5); | 
| 136 | $nsamp = $nx * $ny; | 
| 137 | my $ns = 2**$ttlog2; | 
| 138 | my (@pdiv, $disk2sq, $sq2disk, $tcal, $kcal); | 
| 139 | # Create data segments (all the work happens here) | 
| 140 | if ( $tensortree ) { | 
| 141 | do_tree_bsdf(); | 
| 142 | } else { | 
| 143 | do_matrix_bsdf(); | 
| 144 | } | 
| 145 | # Output XML epilogue | 
| 146 | print | 
| 147 | '</Layer> | 
| 148 | </Optical> | 
| 149 | </WindowElement> | 
| 150 | '; | 
| 151 | # Clean up temporary files and exit | 
| 152 | if ( $persistfile && open(PFI, "< $persistfile") ) { | 
| 153 | while (<PFI>) { | 
| 154 | s/^[^ ]* //; | 
| 155 | kill('ALRM', $_); | 
| 156 | last; | 
| 157 | } | 
| 158 | close PFI; | 
| 159 | } | 
| 160 | exec("rm -rf $td"); | 
| 161 |  | 
| 162 | #-------------- End of main program segment --------------# | 
| 163 |  | 
| 164 | #++++++++++++++ Tensor tree BSDF generation ++++++++++++++# | 
| 165 | sub do_tree_bsdf { | 
| 166 | # Get sampling rate and subdivide task | 
| 167 | my $ns2 = $ns; | 
| 168 | $ns2 /= 2 if ( $tensortree == 3 ); | 
| 169 | @pdiv = (0, int($ns2/$nproc)); | 
| 170 | my $nrem = $ns2 % $nproc; | 
| 171 | for (my $i = 1; $i < $nproc; $i++) { | 
| 172 | my $nv = $pdiv[$i] + $pdiv[1]; | 
| 173 | ++$nv if ( $nrem-- > 0 ); | 
| 174 | push @pdiv, $nv; | 
| 175 | } | 
| 176 | die "Script error 1" if ($pdiv[-1] != $ns2); | 
| 177 | # Shirley-Chiu mapping from unit square to disk | 
| 178 | $sq2disk = ' | 
| 179 | in_square_a = 2*in_square_x - 1; | 
| 180 | in_square_b = 2*in_square_y - 1; | 
| 181 | in_square_rgn = if(in_square_a + in_square_b, | 
| 182 | if(in_square_a - in_square_b, 1, 2), | 
| 183 | if(in_square_b - in_square_a, 3, 4)); | 
| 184 | out_disk_r = .999995*select(in_square_rgn, in_square_a, in_square_b, | 
| 185 | -in_square_a, -in_square_b); | 
| 186 | out_disk_phi = PI/4 * select(in_square_rgn, | 
| 187 | in_square_b/in_square_a, | 
| 188 | 2 - in_square_a/in_square_b, | 
| 189 | 4 + in_square_b/in_square_a, | 
| 190 | if(in_square_b*in_square_b, | 
| 191 | 6 - in_square_a/in_square_b, 0)); | 
| 192 | Dx = out_disk_r*cos(out_disk_phi); | 
| 193 | Dy = out_disk_r*sin(out_disk_phi); | 
| 194 | Dz = sqrt(1 - out_disk_r*out_disk_r); | 
| 195 | '; | 
| 196 | # Shirley-Chiu mapping from unit disk to square | 
| 197 | $disk2sq = ' | 
| 198 | norm_radians(p) : if(-p - PI/4, p + 2*PI, p); | 
| 199 | in_disk_r = .999995*sqrt(Dx*Dx + Dy*Dy); | 
| 200 | in_disk_phi = norm_radians(atan2(Dy, Dx)); | 
| 201 | in_disk_rgn = floor((in_disk_phi + PI/4)/(PI/2)) + 1; | 
| 202 | out_square_a = select(in_disk_rgn, | 
| 203 | in_disk_r, | 
| 204 | (PI/2 - in_disk_phi)*in_disk_r/(PI/4), | 
| 205 | -in_disk_r, | 
| 206 | (in_disk_phi - 3*PI/2)*in_disk_r/(PI/4)); | 
| 207 | out_square_b = select(in_disk_rgn, | 
| 208 | in_disk_phi*in_disk_r/(PI/4), | 
| 209 | in_disk_r, | 
| 210 | (PI - in_disk_phi)*in_disk_r/(PI/4), | 
| 211 | -in_disk_r); | 
| 212 | out_square_x = (out_square_a + 1)/2; | 
| 213 | out_square_y = (out_square_b + 1)/2; | 
| 214 | '; | 
| 215 | # Announce ourselves in XML output | 
| 216 | print "\t<DataDefinition>\n"; | 
| 217 | print "\t\t<IncidentDataStructure>TensorTree$tensortree</IncidentDataStructure>\n"; | 
| 218 | print "\t</DataDefinition>\n"; | 
| 219 | # Fork parallel rtcontrib processes to compute each side | 
| 220 | if ( $doback ) { | 
| 221 | for (my $proc = 0; $proc < $nproc; $proc++) { | 
| 222 | bg_tree_rtcontrib(0, $proc); | 
| 223 | } | 
| 224 | while (wait() >= 0) { | 
| 225 | die "rtcontrib process reported error" if ( $? ); | 
| 226 | } | 
| 227 | ttree_out(0); | 
| 228 | } | 
| 229 | if ( $doforw ) { | 
| 230 | for (my $proc = 0; $proc < $nproc; $proc++) { | 
| 231 | bg_tree_rtcontrib(1, $proc); | 
| 232 | } | 
| 233 | while (wait() >= 0) { | 
| 234 | die "rtcontrib process reported error" if ( $? ); | 
| 235 | } | 
| 236 | ttree_out(1); | 
| 237 | } | 
| 238 | }       # end of sub do_tree_bsdf() | 
| 239 |  | 
| 240 | # Run i'th rtcontrib process for generating tensor tree samples | 
| 241 | sub bg_tree_rtcontrib { | 
| 242 | my $pid = fork(); | 
| 243 | die "Cannot fork new process" unless defined $pid; | 
| 244 | if ($pid > 0) { return $pid; } | 
| 245 | my $forw = shift; | 
| 246 | my $pn = shift; | 
| 247 | my $pbeg = $pdiv[$pn]; | 
| 248 | my $plen = $pdiv[$pn+1] - $pbeg; | 
| 249 | my $matargs = "-m $bmodnm"; | 
| 250 | if ( !$forw || !$doback ) { $matargs .= " -m $fmodnm"; } | 
| 251 | my $cmd = "rtcontrib $rtargs -h -ff -fo -c $nsamp " . | 
| 252 | "-e '$disk2sq' -bn '$ns*$ns' " . | 
| 253 | "-b '$ns*floor(out_square_x*$ns)+floor(out_square_y*$ns)' " . | 
| 254 | "-o $td/%s_" . sprintf("%03d", $pn) . ".flt $matargs $octree"; | 
| 255 | if ( $tensortree == 3 ) { | 
| 256 | # Isotropic BSDF | 
| 257 | $cmd = "cnt $plen $ny $nx " . | 
| 258 | "| rcalc -e 'r1=rand(($pn+.8681)*recno-.673892)' " . | 
| 259 | "-e 'r2=rand(($pn-5.37138)*recno+67.1737811)' " . | 
| 260 | "-e 'r3=rand(($pn+3.17603772)*recno+83.766771)' " . | 
| 261 | "-e 'Dx=1-2*($pbeg+\$1+r1)/$ns;Dy:0;Dz=sqrt(1-Dx*Dx)' " . | 
| 262 | "-e 'xp=(\$3+r2)*(($dim[1]-$dim[0])/$nx)+$dim[0]' " . | 
| 263 | "-e 'yp=(\$2+r3)*(($dim[3]-$dim[2])/$ny)+$dim[2]' " . | 
| 264 | "-e 'zp=$dim[5-$forw]' -e 'myDz=Dz*($forw*2-1)' " . | 
| 265 | "-e '\$1=xp-Dx;\$2=yp-Dy;\$3=zp-myDz' " . | 
| 266 | "-e '\$4=Dx;\$5=Dy;\$6=myDz' -of " . | 
| 267 | "| $cmd"; | 
| 268 | } else { | 
| 269 | # Anisotropic BSDF | 
| 270 | # Sample area vertically to improve load balance, since | 
| 271 | # shading systems usually have bilateral symmetry (L-R) | 
| 272 | $cmd = "cnt $plen $ns $ny $nx " . | 
| 273 | "| rcalc -e 'r1=rand(($pn+.8681)*recno-.673892)' " . | 
| 274 | "-e 'r2=rand(($pn-5.37138)*recno+67.1737811)' " . | 
| 275 | "-e 'r3=rand(($pn+3.17603772)*recno+83.766771)' " . | 
| 276 | "-e 'r4=rand(($pn-2.3857833)*recno-964.72738)' " . | 
| 277 | "-e 'in_square_x=($pbeg+\$1+r1)/$ns' " . | 
| 278 | "-e 'in_square_y=(\$2+r2)/$ns' -e '$sq2disk' " . | 
| 279 | "-e 'xp=(\$4+r3)*(($dim[1]-$dim[0])/$nx)+$dim[0]' " . | 
| 280 | "-e 'yp=(\$3+r4)*(($dim[3]-$dim[2])/$ny)+$dim[2]' " . | 
| 281 | "-e 'zp=$dim[5-$forw]' -e 'myDz=Dz*($forw*2-1)' " . | 
| 282 | "-e '\$1=xp-Dx;\$2=yp-Dy;\$3=zp-myDz' " . | 
| 283 | "-e '\$4=Dx;\$5=Dy;\$6=myDz' -of " . | 
| 284 | "| $cmd"; | 
| 285 | } | 
| 286 | # print STDERR "Starting: $cmd\n"; | 
| 287 | exec($cmd);             # no return; status report to parent via wait | 
| 288 | die "Cannot exec: $cmd\n"; | 
| 289 | }       # end of bg_tree_rtcontrib() | 
| 290 |  | 
| 291 | # Simplify and output tensor tree results | 
| 292 | sub ttree_out { | 
| 293 | my $forw = shift; | 
| 294 | my $side = ("Back","Front")[$forw]; | 
| 295 | # Only output one transmitted distribution, preferring backwards | 
| 296 | if ( !$forw || !$doback ) { | 
| 297 | print | 
| 298 | '       <WavelengthData> | 
| 299 | <LayerNumber>System</LayerNumber> | 
| 300 | <Wavelength unit="Integral">Visible</Wavelength> | 
| 301 | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 302 | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 303 | <WavelengthDataBlock> | 
| 304 | <WavelengthDataDirection>Transmission</WavelengthDataDirection> | 
| 305 | <AngleBasis>LBNL/Shirley-Chiu</AngleBasis> | 
| 306 | <ScatteringDataType>BTDF</ScatteringDataType> | 
| 307 | <ScatteringData> | 
| 308 | '; | 
| 309 | system "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . | 
| 310 | q{-e '$1=(0.265*$1+0.670*$2+0.065*$3)/Omega' -of } . | 
| 311 | "$td/" . ($bmodnm,$fmodnm)[$forw] . "_???.flt " . | 
| 312 | "| rttree_reduce -h -ff -r $tensortree -g $ttlog2"; | 
| 313 | die "Failure running rttree_reduce" if ( $? ); | 
| 314 | print | 
| 315 | '                       </ScatteringData> | 
| 316 | </WavelengthDataBlock> | 
| 317 | </WavelengthData> | 
| 318 | '; | 
| 319 | } | 
| 320 | # Output reflection | 
| 321 | print | 
| 322 | '       <WavelengthData> | 
| 323 | <LayerNumber>System</LayerNumber> | 
| 324 | <Wavelength unit="Integral">Visible</Wavelength> | 
| 325 | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 326 | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 327 | <WavelengthDataBlock> | 
| 328 | '; | 
| 329 | print "\t\t\t<WavelengthDataDirection>Reflection $side</WavelengthDataDirection>\n"; | 
| 330 | print | 
| 331 | '                       <AngleBasis>LBNL/Shirley-Chiu</AngleBasis> | 
| 332 | <ScatteringDataType>BRDF</ScatteringDataType> | 
| 333 | <ScatteringData> | 
| 334 | '; | 
| 335 | system "rcalc -if3 -e 'Omega:PI/($ns*$ns)' " . | 
| 336 | q{-e '$1=(0.265*$1+0.670*$2+0.065*$3)/Omega' -of } . | 
| 337 | "$td/" . ($fmodnm,$bmodnm)[$forw] . "_???.flt " . | 
| 338 | "| rttree_reduce -h -ff -r $tensortree -g $ttlog2"; | 
| 339 | die "Failure running rttree_reduce" if ( $? ); | 
| 340 | print | 
| 341 | '                       </ScatteringData> | 
| 342 | </WavelengthDataBlock> | 
| 343 | </WavelengthData> | 
| 344 | '; | 
| 345 | }       # end of ttree_out() | 
| 346 |  | 
| 347 | #------------- End of do_tree_bsdf() & subroutines -------------# | 
| 348 |  | 
| 349 | #+++++++++++++++ Klems matrix BSDF generation +++++++++++++++# | 
| 350 | sub do_matrix_bsdf { | 
| 351 | # Set up sampling of portal | 
| 352 | # Kbin to produce incident direction in full Klems basis with (x1,x2) randoms | 
| 353 | $tcal = ' | 
| 354 | DEGREE : PI/180; | 
| 355 | sq(x) : x*x; | 
| 356 | Kpola(r) : select(r+1, -5, 5, 15, 25, 35, 45, 55, 65, 75, 90); | 
| 357 | Knaz(r) : select(r, 1, 8, 16, 20, 24, 24, 24, 16, 12); | 
| 358 | Kaccum(r) : if(r-.5, Knaz(r) + Kaccum(r-1), 0); | 
| 359 | Kmax : Kaccum(Knaz(0)); | 
| 360 | Kfindrow(r, rem) : if(rem-Knaz(r)+.5, Kfindrow(r+1, rem-Knaz(r)), r); | 
| 361 | Krow = if(Kbin-(Kmax-.5), 0, Kfindrow(1, Kbin)); | 
| 362 | Kcol = Kbin - Kaccum(Krow-1); | 
| 363 | Kazi = 360*DEGREE * (Kcol + (.5 - x2)) / Knaz(Krow); | 
| 364 | Kpol = DEGREE * (x1*Kpola(Krow) + (1-x1)*Kpola(Krow-1)); | 
| 365 | sin_kpol = sin(Kpol); | 
| 366 | Dx = cos(Kazi)*sin_kpol; | 
| 367 | Dy = sin(Kazi)*sin_kpol; | 
| 368 | Dz = sqrt(1 - sin_kpol*sin_kpol); | 
| 369 | KprojOmega = PI * if(Kbin-.5, | 
| 370 | (sq(cos(Kpola(Krow-1)*DEGREE)) - sq(cos(Kpola(Krow)*DEGREE)))/Knaz(Krow), | 
| 371 | 1 - sq(cos(Kpola(1)*DEGREE))); | 
| 372 | '; | 
| 373 | # Compute Klems bin from exiting ray direction (forward or backward) | 
| 374 | $kcal = ' | 
| 375 | DEGREE : PI/180; | 
| 376 | abs(x) : if(x, x, -x); | 
| 377 | Acos(x) : 1/DEGREE * if(x-1, 0, if(-1-x, 0, acos(x))); | 
| 378 | posangle(a) : if(-a, a + 2*PI, a); | 
| 379 | Atan2(y,x) : 1/DEGREE * posangle(atan2(y,x)); | 
| 380 | kpola(r) : select(r, 5, 15, 25, 35, 45, 55, 65, 75, 90); | 
| 381 | knaz(r) : select(r, 1, 8, 16, 20, 24, 24, 24, 16, 12); | 
| 382 | kaccum(r) : if(r-.5, knaz(r) + kaccum(r-1), 0); | 
| 383 | kfindrow(r, pol) : if(r-kpola(0)+.5, r, | 
| 384 | if(pol-kpola(r), kfindrow(r+1, pol), r) ); | 
| 385 | kazn(azi,inc) : if((360-.5*inc)-azi, floor((azi+.5*inc)/inc), 0); | 
| 386 | kbin2(pol,azi) = select(kfindrow(1, pol), | 
| 387 | kazn(azi,360/knaz(1)), | 
| 388 | kaccum(1) + kazn(azi,360/knaz(2)), | 
| 389 | kaccum(2) + kazn(azi,360/knaz(3)), | 
| 390 | kaccum(3) + kazn(azi,360/knaz(4)), | 
| 391 | kaccum(4) + kazn(azi,360/knaz(5)), | 
| 392 | kaccum(5) + kazn(azi,360/knaz(6)), | 
| 393 | kaccum(6) + kazn(azi,360/knaz(7)), | 
| 394 | kaccum(7) + kazn(azi,360/knaz(8)), | 
| 395 | kaccum(8) + kazn(azi,360/knaz(9)) | 
| 396 | ); | 
| 397 | kbin = kbin2(Acos(abs(Dz)),Atan2(Dy,Dx)); | 
| 398 | '; | 
| 399 | my $ndiv = 145; | 
| 400 | # Compute scattering data using rtcontrib | 
| 401 | my @tfarr; | 
| 402 | my @rfarr; | 
| 403 | my @tbarr; | 
| 404 | my @rbarr; | 
| 405 | my $cmd; | 
| 406 | my $rtcmd = "rtcontrib $rtargs -h -ff -fo -n $nproc -c $nsamp " . | 
| 407 | "-e '$kcal' -b kbin -bn $ndiv " . | 
| 408 | "-o '$td/%s.flt' -m $fmodnm -m $bmodnm $octree"; | 
| 409 | my $rccmd = "rcalc -e '$tcal' " . | 
| 410 | "-e 'mod(n,d):n-floor(n/d)*d' -e 'Kbin=mod(recno-.999,$ndiv)' " . | 
| 411 | q{-if3 -e 'oval=(0.265*$1+0.670*$2+0.065*$3)/KprojOmega' } . | 
| 412 | q[-o '${  oval  },']; | 
| 413 | if ( $doforw ) { | 
| 414 | $cmd = "cnt $ndiv $ny $nx | rcalc -of -e '$tcal' " . | 
| 415 | "-e 'xp=(\$3+rand(.12*recno+288))*(($dim[1]-$dim[0])/$nx)+$dim[0]' " . | 
| 416 | "-e 'yp=(\$2+rand(.37*recno-44))*(($dim[3]-$dim[2])/$ny)+$dim[2]' " . | 
| 417 | "-e 'zp:$dim[4]' " . | 
| 418 | q{-e 'Kbin=$1;x1=rand(2.75*recno+3.1);x2=rand(-2.01*recno-3.37)' } . | 
| 419 | q{-e '$1=xp-Dx;$2=yp-Dy;$3=zp-Dz;$4=Dx;$5=Dy;$6=Dz' } . | 
| 420 | "| $rtcmd"; | 
| 421 | system "$cmd" || die "Failure running: $cmd\n"; | 
| 422 | @tfarr = `$rccmd $td/$fmodnm.flt`; | 
| 423 | die "Failure running: $rccmd $td/$fmodnm.flt\n" if ( $? ); | 
| 424 | @rfarr = `$rccmd $td/$bmodnm.flt`; | 
| 425 | die "Failure running: $rccmd $td/$bmodnm.flt\n" if ( $? ); | 
| 426 | } | 
| 427 | if ( $doback ) { | 
| 428 | $cmd = "cnt $ndiv $ny $nx | rcalc -of -e '$tcal' " . | 
| 429 | "-e 'xp=(\$3+rand(.35*recno-15))*(($dim[1]-$dim[0])/$nx)+$dim[0]' " . | 
| 430 | "-e 'yp=(\$2+rand(.86*recno+11))*(($dim[3]-$dim[2])/$ny)+$dim[2]' " . | 
| 431 | "-e 'zp:$dim[5]' " . | 
| 432 | q{-e 'Kbin=$1;x1=rand(1.21*recno+2.75);x2=rand(-3.55*recno-7.57)' } . | 
| 433 | q{-e '$1=xp-Dx;$2=yp-Dy;$3=zp+Dz;$4=Dx;$5=Dy;$6=-Dz' } . | 
| 434 | "| $rtcmd"; | 
| 435 | system "$cmd" || die "Failure running: $cmd\n"; | 
| 436 | @tbarr = `$rccmd $td/$bmodnm.flt`; | 
| 437 | die "Failure running: $rccmd $td/$bmodnm.flt\n" if ( $? ); | 
| 438 | @rbarr = `$rccmd $td/$fmodnm.flt`; | 
| 439 | die "Failure running: $rccmd $td/$fmodnm.flt\n" if ( $? ); | 
| 440 | } | 
| 441 | # Output angle basis | 
| 442 | print | 
| 443 | '       <DataDefinition> | 
| 444 | <IncidentDataStructure>Columns</IncidentDataStructure> | 
| 445 | <AngleBasis> | 
| 446 | <AngleBasisName>LBNL/Klems Full</AngleBasisName> | 
| 447 | <AngleBasisBlock> | 
| 448 | <Theta>0</Theta> | 
| 449 | <nPhis>1</nPhis> | 
| 450 | <ThetaBounds> | 
| 451 | <LowerTheta>0</LowerTheta> | 
| 452 | <UpperTheta>5</UpperTheta> | 
| 453 | </ThetaBounds> | 
| 454 | </AngleBasisBlock> | 
| 455 | <AngleBasisBlock> | 
| 456 | <Theta>10</Theta> | 
| 457 | <nPhis>8</nPhis> | 
| 458 | <ThetaBounds> | 
| 459 | <LowerTheta>5</LowerTheta> | 
| 460 | <UpperTheta>15</UpperTheta> | 
| 461 | </ThetaBounds> | 
| 462 | </AngleBasisBlock> | 
| 463 | <AngleBasisBlock> | 
| 464 | <Theta>20</Theta> | 
| 465 | <nPhis>16</nPhis> | 
| 466 | <ThetaBounds> | 
| 467 | <LowerTheta>15</LowerTheta> | 
| 468 | <UpperTheta>25</UpperTheta> | 
| 469 | </ThetaBounds> | 
| 470 | </AngleBasisBlock> | 
| 471 | <AngleBasisBlock> | 
| 472 | <Theta>30</Theta> | 
| 473 | <nPhis>20</nPhis> | 
| 474 | <ThetaBounds> | 
| 475 | <LowerTheta>25</LowerTheta> | 
| 476 | <UpperTheta>35</UpperTheta> | 
| 477 | </ThetaBounds> | 
| 478 | </AngleBasisBlock> | 
| 479 | <AngleBasisBlock> | 
| 480 | <Theta>40</Theta> | 
| 481 | <nPhis>24</nPhis> | 
| 482 | <ThetaBounds> | 
| 483 | <LowerTheta>35</LowerTheta> | 
| 484 | <UpperTheta>45</UpperTheta> | 
| 485 | </ThetaBounds> | 
| 486 | </AngleBasisBlock> | 
| 487 | <AngleBasisBlock> | 
| 488 | <Theta>50</Theta> | 
| 489 | <nPhis>24</nPhis> | 
| 490 | <ThetaBounds> | 
| 491 | <LowerTheta>45</LowerTheta> | 
| 492 | <UpperTheta>55</UpperTheta> | 
| 493 | </ThetaBounds> | 
| 494 | </AngleBasisBlock> | 
| 495 | <AngleBasisBlock> | 
| 496 | <Theta>60</Theta> | 
| 497 | <nPhis>24</nPhis> | 
| 498 | <ThetaBounds> | 
| 499 | <LowerTheta>55</LowerTheta> | 
| 500 | <UpperTheta>65</UpperTheta> | 
| 501 | </ThetaBounds> | 
| 502 | </AngleBasisBlock> | 
| 503 | <AngleBasisBlock> | 
| 504 | <Theta>70</Theta> | 
| 505 | <nPhis>16</nPhis> | 
| 506 | <ThetaBounds> | 
| 507 | <LowerTheta>65</LowerTheta> | 
| 508 | <UpperTheta>75</UpperTheta> | 
| 509 | </ThetaBounds> | 
| 510 | </AngleBasisBlock> | 
| 511 | <AngleBasisBlock> | 
| 512 | <Theta>82.5</Theta> | 
| 513 | <nPhis>12</nPhis> | 
| 514 | <ThetaBounds> | 
| 515 | <LowerTheta>75</LowerTheta> | 
| 516 | <UpperTheta>90</UpperTheta> | 
| 517 | </ThetaBounds> | 
| 518 | </AngleBasisBlock> | 
| 519 | </AngleBasis> | 
| 520 | </DataDefinition> | 
| 521 | '; | 
| 522 | if ( $doforw ) { | 
| 523 | print | 
| 524 | '       <WavelengthData> | 
| 525 | <LayerNumber>System</LayerNumber> | 
| 526 | <Wavelength unit="Integral">Visible</Wavelength> | 
| 527 | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 528 | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 529 | <WavelengthDataBlock> | 
| 530 | <WavelengthDataDirection>Transmission Front</WavelengthDataDirection> | 
| 531 | <ColumnAngleBasis>LBNL/Klems Full</ColumnAngleBasis> | 
| 532 | <RowAngleBasis>LBNL/Klems Full</RowAngleBasis> | 
| 533 | <ScatteringDataType>BTDF</ScatteringDataType> | 
| 534 | <ScatteringData> | 
| 535 | '; | 
| 536 | # Output front transmission (transposed order) | 
| 537 | for (my $od = 0; $od < $ndiv; $od++) { | 
| 538 | for (my $id = 0; $id < $ndiv; $id++) { | 
| 539 | print $tfarr[$ndiv*$id + $od]; | 
| 540 | } | 
| 541 | print "\n"; | 
| 542 | } | 
| 543 | print | 
| 544 | '                       </ScatteringData> | 
| 545 | </WavelengthDataBlock> | 
| 546 | </WavelengthData> | 
| 547 | <WavelengthData> | 
| 548 | <LayerNumber>System</LayerNumber> | 
| 549 | <Wavelength unit="Integral">Visible</Wavelength> | 
| 550 | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 551 | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 552 | <WavelengthDataBlock> | 
| 553 | <WavelengthDataDirection>Reflection Front</WavelengthDataDirection> | 
| 554 | <ColumnAngleBasis>LBNL/Klems Full</ColumnAngleBasis> | 
| 555 | <RowAngleBasis>LBNL/Klems Full</RowAngleBasis> | 
| 556 | <ScatteringDataType>BRDF</ScatteringDataType> | 
| 557 | <ScatteringData> | 
| 558 | '; | 
| 559 | # Output front reflection (transposed order) | 
| 560 | for (my $od = 0; $od < $ndiv; $od++) { | 
| 561 | for (my $id = 0; $id < $ndiv; $id++) { | 
| 562 | print $rfarr[$ndiv*$id + $od]; | 
| 563 | } | 
| 564 | print "\n"; | 
| 565 | } | 
| 566 | print | 
| 567 | '                       </ScatteringData> | 
| 568 | </WavelengthDataBlock> | 
| 569 | </WavelengthData> | 
| 570 | '; | 
| 571 | } | 
| 572 | if ( $doback ) { | 
| 573 | print | 
| 574 | '       <WavelengthData> | 
| 575 | <LayerNumber>System</LayerNumber> | 
| 576 | <Wavelength unit="Integral">Visible</Wavelength> | 
| 577 | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 578 | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 579 | <WavelengthDataBlock> | 
| 580 | <WavelengthDataDirection>Transmission Back</WavelengthDataDirection> | 
| 581 | <ColumnAngleBasis>LBNL/Klems Full</ColumnAngleBasis> | 
| 582 | <RowAngleBasis>LBNL/Klems Full</RowAngleBasis> | 
| 583 | <ScatteringDataType>BTDF</ScatteringDataType> | 
| 584 | <ScatteringData> | 
| 585 | '; | 
| 586 | # Output back transmission (transposed order) | 
| 587 | for (my $od = 0; $od < $ndiv; $od++) { | 
| 588 | for (my $id = 0; $id < $ndiv; $id++) { | 
| 589 | print $tbarr[$ndiv*$id + $od]; | 
| 590 | } | 
| 591 | print "\n"; | 
| 592 | } | 
| 593 | print | 
| 594 | '                       </ScatteringData> | 
| 595 | </WavelengthDataBlock> | 
| 596 | </WavelengthData> | 
| 597 | <WavelengthData> | 
| 598 | <LayerNumber>System</LayerNumber> | 
| 599 | <Wavelength unit="Integral">Visible</Wavelength> | 
| 600 | <SourceSpectrum>CIE Illuminant D65 1nm.ssp</SourceSpectrum> | 
| 601 | <DetectorSpectrum>ASTM E308 1931 Y.dsp</DetectorSpectrum> | 
| 602 | <WavelengthDataBlock> | 
| 603 | <WavelengthDataDirection>Reflection Back</WavelengthDataDirection> | 
| 604 | <ColumnAngleBasis>LBNL/Klems Full</ColumnAngleBasis> | 
| 605 | <RowAngleBasis>LBNL/Klems Full</RowAngleBasis> | 
| 606 | <ScatteringDataType>BRDF</ScatteringDataType> | 
| 607 | <ScatteringData> | 
| 608 | '; | 
| 609 | # Output back reflection (transposed order) | 
| 610 | for (my $od = 0; $od < $ndiv; $od++) { | 
| 611 | for (my $id = 0; $id < $ndiv; $id++) { | 
| 612 | print $rbarr[$ndiv*$id + $od]; | 
| 613 | } | 
| 614 | print "\n"; | 
| 615 | } | 
| 616 | print | 
| 617 | '                       </ScatteringData> | 
| 618 | </WavelengthDataBlock> | 
| 619 | </WavelengthData> | 
| 620 | '; | 
| 621 | } | 
| 622 | } | 
| 623 | #------------- End of do_matrix_bsdf() --------------# |