| [0b990d] | 1 | # | 
|---|
|  | 2 | eval 'exec perl $0 $*' | 
|---|
|  | 3 | if 0; | 
|---|
|  | 4 |  | 
|---|
|  | 5 | require QCResult; | 
|---|
|  | 6 |  | 
|---|
|  | 7 | my $log10 = log(10.0); | 
|---|
|  | 8 |  | 
|---|
|  | 9 | $error = 0; | 
|---|
|  | 10 | $refmissing = 0; | 
|---|
|  | 11 | $testmissing = 0; | 
|---|
|  | 12 | $reffailed = 0; | 
|---|
|  | 13 | $testfailed = 0; | 
|---|
|  | 14 | $ntest = 0; | 
|---|
|  | 15 |  | 
|---|
|  | 16 | if ($ARGV[0] eq "-r") { | 
|---|
|  | 17 | shift; | 
|---|
|  | 18 | $refdir = shift; | 
|---|
|  | 19 | foreach $file1 (@ARGV) { | 
|---|
|  | 20 | $file2 = $file1; | 
|---|
|  | 21 | $file1 =~ s+run+$refdir+; | 
|---|
|  | 22 | check($file1, $file2); | 
|---|
|  | 23 | } | 
|---|
|  | 24 | } | 
|---|
|  | 25 | elsif ($ARGV[0] eq "-d") { | 
|---|
|  | 26 | shift; | 
|---|
|  | 27 | my $dir = $ARGV[0]; | 
|---|
|  | 28 | shift; | 
|---|
|  | 29 | my $rundir = $ARGV[0]; | 
|---|
|  | 30 | shift; | 
|---|
|  | 31 | opendir(DIR,"$dir"); | 
|---|
|  | 32 | my @files = sort(readdir(DIR)); | 
|---|
|  | 33 | closedir(DIR); | 
|---|
|  | 34 | foreach $file (@files) { | 
|---|
|  | 35 | if ($file =~ /.out$/) { | 
|---|
|  | 36 | check("$dir/$file", "$rundir/$file"); | 
|---|
|  | 37 | } | 
|---|
|  | 38 | } | 
|---|
|  | 39 | } | 
|---|
|  | 40 | else { | 
|---|
|  | 41 | my $file1 = shift; | 
|---|
|  | 42 | my $file2 = shift; | 
|---|
|  | 43 |  | 
|---|
|  | 44 |  | 
|---|
|  | 45 | # for AIX, which isn't processing the {,} in the argument | 
|---|
|  | 46 | if ($file1 =~ /(.*){(.*),(.*)}(.*)/) { | 
|---|
|  | 47 | $file1 = "$1$2$4"; | 
|---|
|  | 48 | $file2 = "$1$3$4"; | 
|---|
|  | 49 | } | 
|---|
|  | 50 |  | 
|---|
|  | 51 | check($file1, $file2); | 
|---|
|  | 52 | } | 
|---|
|  | 53 |  | 
|---|
|  | 54 | print  "*************************************************\n"; | 
|---|
|  | 55 | printf "* %6d test cases total\n", $ntest; | 
|---|
|  | 56 | printf "* %6d numerical discrepancies\n", $error; | 
|---|
|  | 57 | printf "* %6d failed reference cases\n", $reffailed; | 
|---|
|  | 58 | printf "* %6d missing reference cases\n", $refmissing; | 
|---|
|  | 59 | printf "* %6d failed test cases\n", $testfailed; | 
|---|
|  | 60 | printf "* %6d missing test cases\n", $testmissing; | 
|---|
|  | 61 | print  "*************************************************\n"; | 
|---|
|  | 62 |  | 
|---|
|  | 63 | if ($error + $testfailed + $testmissing + $reffailed + $refmissing > 0) { | 
|---|
|  | 64 | print "CHECK FAILED\n"; | 
|---|
|  | 65 | exit 1; | 
|---|
|  | 66 | } | 
|---|
|  | 67 | else { | 
|---|
|  | 68 | print "CHECK OK\n"; | 
|---|
|  | 69 | exit 0; | 
|---|
|  | 70 | } | 
|---|
|  | 71 |  | 
|---|
|  | 72 |  | 
|---|
|  | 73 | # Takes the name of the output file as the first argument.  It must end in | 
|---|
|  | 74 | # a .out. The QCInput file must be in the same directory and must end in a | 
|---|
|  | 75 | # .qci.  The optional second argument is the path to an output file that are | 
|---|
|  | 76 | # to be compared to the file given by the first argument. | 
|---|
|  | 77 | sub check { | 
|---|
|  | 78 | my $fileout = shift; | 
|---|
|  | 79 | my $comparefileout = shift; | 
|---|
|  | 80 | my $file = $fileout; | 
|---|
|  | 81 | $file =~ s/\.out$//; | 
|---|
|  | 82 | my $filein = "$file.qci"; | 
|---|
|  | 83 |  | 
|---|
|  | 84 | my $result = new QCResult("$filein","$fileout"); | 
|---|
|  | 85 | my $ok = "failed"; | 
|---|
|  | 86 | if ($result->ok()) { | 
|---|
|  | 87 | if ($result->inputok()) { | 
|---|
|  | 88 | $ok = "ok"; | 
|---|
|  | 89 | } | 
|---|
|  | 90 | else { | 
|---|
|  | 91 | $ok = "(ok)"; | 
|---|
|  | 92 | } | 
|---|
|  | 93 | } | 
|---|
|  | 94 | else { | 
|---|
|  | 95 | if (! $result->inputok()) { | 
|---|
|  | 96 | $ok = "(failed)"; | 
|---|
|  | 97 | } | 
|---|
|  | 98 | } | 
|---|
|  | 99 | $ok = "missing" if (! $result->exists()); | 
|---|
|  | 100 | my $basename = $file; | 
|---|
|  | 101 | $basename =~ s=^.*/([^/]*)$=\1=; | 
|---|
|  | 102 |  | 
|---|
|  | 103 | if ($comparefileout eq "") { | 
|---|
|  | 104 | $basename = "$basename:"; | 
|---|
|  | 105 | printf "%-28s %s", $basename, $ok; | 
|---|
|  | 106 | if ($result->ok()) { | 
|---|
|  | 107 | printf " %14.8f", $result->energy(); | 
|---|
|  | 108 | } | 
|---|
|  | 109 | } | 
|---|
|  | 110 | else { | 
|---|
|  | 111 | my $comparefile = "$comparefileout"; | 
|---|
|  | 112 | $comparefile =~ s/\.out$//; | 
|---|
|  | 113 | my $comparebasename = $comparefile; | 
|---|
|  | 114 | $comparebasename =~ s=^.*/([^/]*)$=\1=; | 
|---|
|  | 115 | if ($basename eq $comparebasename) { | 
|---|
|  | 116 | $basename = "$basename:"; | 
|---|
|  | 117 | printf "%-28s %s", $basename, $ok; | 
|---|
|  | 118 | } | 
|---|
|  | 119 | else { | 
|---|
|  | 120 | my $files = "$basename/$comparebasename:"; | 
|---|
|  | 121 | printf "%-35s %s", $files, $ok; | 
|---|
|  | 122 | } | 
|---|
|  | 123 | if (-f "$comparefile.out") { | 
|---|
|  | 124 | my $comparefileout = "$comparefile.out"; | 
|---|
|  | 125 | my $comparefilein = "$comparefile.qci"; | 
|---|
|  | 126 | # use the input file for the reference calculation | 
|---|
|  | 127 | # so it doesn't need to exist in both directories | 
|---|
|  | 128 | my $cresult = new QCResult($filein,$comparefileout); | 
|---|
|  | 129 | my $compareok = "failed"; | 
|---|
|  | 130 | $compareok = "ok" if ($cresult->ok()); | 
|---|
|  | 131 | printf " %s", $compareok; | 
|---|
|  | 132 | if ($cresult->ok() && $result->ok()) { | 
|---|
|  | 133 | #printf " %14.8f %14.8f", $result->energy(),$cresult->energy(); | 
|---|
|  | 134 | my $ldiff = compare_numbers($result->energy(),$cresult->energy()); | 
|---|
|  | 135 | printf " E:%2d", $ldiff; | 
|---|
|  | 136 | flagerror() if ($ldiff <= 6); | 
|---|
|  | 137 | if ($result->input()->gradient() | 
|---|
|  | 138 | && ! $result->input()->optimize()) { | 
|---|
|  | 139 | my $maxerror = compare_vecs($result->gradient(), | 
|---|
|  | 140 | $cresult->gradient()); | 
|---|
|  | 141 | printf " Grad:%2d", $maxerror; | 
|---|
|  | 142 | flagerror() if ($maxerror <= 6); | 
|---|
|  | 143 | } | 
|---|
|  | 144 | if ($result->input()->optimize()) { | 
|---|
|  | 145 | my $maxerror = compare_vecs( | 
|---|
|  | 146 | $result->optmolecule()->geometry(), | 
|---|
|  | 147 | $cresult->optmolecule()->geometry()); | 
|---|
|  | 148 | printf " Geom:%2d", $maxerror; | 
|---|
|  | 149 | flagerror() if ($maxerror <= 4); | 
|---|
|  | 150 | } | 
|---|
|  | 151 | if ($result->input()->frequencies()) { | 
|---|
|  | 152 | my $maxerror = compare_vecs($result->frequencies(), | 
|---|
|  | 153 | $cresult->frequencies()); | 
|---|
|  | 154 | printf " Freq:% 2d", $maxerror; | 
|---|
|  | 155 | flagerror() if ($maxerror <= -2); | 
|---|
|  | 156 | } | 
|---|
|  | 157 | if ($result->s2norm() && $cresult->s2norm()) { | 
|---|
|  | 158 | my $maxerror = compare_numbers($result->s2norm(), | 
|---|
|  | 159 | $cresult->s2norm()); | 
|---|
|  | 160 | printf " S2N:%d", $maxerror; | 
|---|
|  | 161 | flagerror() if ($maxerror <= 8); | 
|---|
|  | 162 | } | 
|---|
|  | 163 | if (!$cresult->degenerate() && | 
|---|
|  | 164 | $result->s2matrix1norm() && $cresult->s2matrix1norm()) { | 
|---|
|  | 165 | my $maxerror = compare_numbers($result->s2matrix1norm(), | 
|---|
|  | 166 | $cresult->s2matrix1norm()); | 
|---|
|  | 167 | printf " |S2|1:%d", $maxerror; | 
|---|
|  | 168 | flagerror() if ($maxerror <= 8); | 
|---|
|  | 169 | } | 
|---|
|  | 170 | if ($result->d1mp2() && $cresult->d1mp2()) { | 
|---|
|  | 171 | my $maxerror = compare_numbers($result->d1mp2(), | 
|---|
|  | 172 | $cresult->d1mp2()); | 
|---|
|  | 173 | printf " D1:%d", $maxerror; | 
|---|
|  | 174 | flagerror() if ($maxerror <= 8); | 
|---|
|  | 175 | } | 
|---|
|  | 176 | if ($result->d2mp1() && $cresult->d2mp1()) { | 
|---|
|  | 177 | my $maxerror = compare_numbers($result->d2mp1(), | 
|---|
|  | 178 | $cresult->d2mp1()); | 
|---|
|  | 179 | printf " D2:%d", $maxerror; | 
|---|
|  | 180 | flagerror() if ($maxerror <= 8); | 
|---|
|  | 181 | } | 
|---|
|  | 182 | if (!$cresult->degenerate() && | 
|---|
|  | 183 | $result->s2matrixinfnorm() && $cresult->s2matrixinfnorm()){ | 
|---|
|  | 184 | my $maxerror = compare_numbers($result->s2matrixinfnorm(), | 
|---|
|  | 185 | $cresult->s2matrixinfnorm()); | 
|---|
|  | 186 | printf " |S2|i:%d", $maxerror; | 
|---|
|  | 187 | flagerror() if ($maxerror <= 8); | 
|---|
|  | 188 | } | 
|---|
|  | 189 | if ($result->npacharge() && $cresult->npacharge()) { | 
|---|
|  | 190 | my $maxerror = compare_vecs($result->npacharge(), | 
|---|
|  | 191 | $cresult->npacharge()); | 
|---|
|  | 192 | printf " NPAq:%d", $maxerror; | 
|---|
|  | 193 | flagerror() if ($maxerror <= 5); | 
|---|
|  | 194 | #printf "npacharge\n"; | 
|---|
|  | 195 | #print_vec($result->npacharge()); | 
|---|
|  | 196 | } | 
|---|
|  | 197 | if ($result->npashellpop() && $cresult->npashellpop()) { | 
|---|
|  | 198 | my $maxerror = compare_vecvecs($result->npashellpop(), | 
|---|
|  | 199 | $cresult->npashellpop()); | 
|---|
|  | 200 | printf " NPAp:%d", $maxerror; | 
|---|
|  | 201 | flagerror() if ($maxerror <= 5); | 
|---|
|  | 202 | #printf "npashellpop\n"; | 
|---|
|  | 203 | #print_vecvec($result->npashellpop()); | 
|---|
|  | 204 | } | 
|---|
|  | 205 | if (!$cresult->degenerate() && | 
|---|
|  | 206 | $result->s2large_coef() && $cresult->s2large_coef()) { | 
|---|
|  | 207 | my $maxerror | 
|---|
|  | 208 | = compare_vecs_magnitude($result->s2large_coef(), | 
|---|
|  | 209 | $cresult->s2large_coef()); | 
|---|
|  | 210 | printf " S2L:%d", $maxerror; | 
|---|
|  | 211 | flagerror() if ($maxerror <= 8); | 
|---|
|  | 212 | my $n = n_nonzero_in_vec($result->s2large_coef()); | 
|---|
|  | 213 | my $xok = compare_string_vecs($result->s2large_i(), | 
|---|
|  | 214 | $cresult->s2large_i(),$n) | 
|---|
|  | 215 | && compare_string_vecs($result->s2large_a(), | 
|---|
|  | 216 | $cresult->s2large_a(),$n); | 
|---|
|  | 217 | #printf "coef\n"; | 
|---|
|  | 218 | #print_vec($result->s2large_coef()); | 
|---|
|  | 219 | #printf "i\n"; | 
|---|
|  | 220 | #print_string_vec($result->s2large_i()); | 
|---|
|  | 221 | #printf "a\n"; | 
|---|
|  | 222 | #print_string_vec($result->s2large_a()); | 
|---|
|  | 223 | if ($xok) { print " X:OK" } | 
|---|
|  | 224 | else { print " X:*"; $error++; } | 
|---|
|  | 225 | } | 
|---|
|  | 226 | if (!$cresult->degenerate() && | 
|---|
|  | 227 | $result->d1large_coef() && $cresult->d1large_coef()) { | 
|---|
|  | 228 | my $maxerror | 
|---|
|  | 229 | = compare_vecs_magnitude($result->d1large_coef(), | 
|---|
|  | 230 | $cresult->d1large_coef()); | 
|---|
|  | 231 | printf " D1L:%d", $maxerror; | 
|---|
|  | 232 | flagerror() if ($maxerror <= 7); | 
|---|
|  | 233 | my $n = n_nonzero_in_vec($result->d1large_coef()); | 
|---|
|  | 234 | my $xok = compare_string_vecs($result->d1large_i(), | 
|---|
|  | 235 | $cresult->d1large_i(),$n) | 
|---|
|  | 236 | && compare_string_vecs($result->d1large_j(), | 
|---|
|  | 237 | $cresult->d1large_j(),$n) | 
|---|
|  | 238 | && compare_string_vecs($result->d1large_a(), | 
|---|
|  | 239 | $cresult->d1large_a(),$n) | 
|---|
|  | 240 | && compare_string_vecs($result->d1large_b(), | 
|---|
|  | 241 | $cresult->d1large_b(),$n) | 
|---|
|  | 242 | && compare_string_vecs($result->d1large_spin(), | 
|---|
|  | 243 | $cresult->d1large_spin(),$n); | 
|---|
|  | 244 | if ($xok) { print " X:OK" } | 
|---|
|  | 245 | else { print " X:*"; $error++; } | 
|---|
|  | 246 | #printf "coef\n"; | 
|---|
|  | 247 | #print_vec($result->d1large_coef()); | 
|---|
|  | 248 | #printf "i\n"; | 
|---|
|  | 249 | #print_string_vec($result->d1large_i()); | 
|---|
|  | 250 | #printf "j\n"; | 
|---|
|  | 251 | #print_string_vec($result->d1large_j()); | 
|---|
|  | 252 | #printf "a\n"; | 
|---|
|  | 253 | #print_string_vec($result->d1large_a()); | 
|---|
|  | 254 | #printf "b\n"; | 
|---|
|  | 255 | #print_string_vec($result->d1large_b()); | 
|---|
|  | 256 | #printf "spin\n"; | 
|---|
|  | 257 | #print_string_vec($result->d1large_spin()); | 
|---|
|  | 258 | } | 
|---|
|  | 259 | } | 
|---|
|  | 260 | else { | 
|---|
|  | 261 | if (($result->exists() && $cresult->exists()) | 
|---|
|  | 262 | ||($result->exists() && !$result->ok()) | 
|---|
|  | 263 | ||($cresult->exists() && !$cresult->ok())) { | 
|---|
|  | 264 | printf " cannot compare since one calc failed"; | 
|---|
|  | 265 | } | 
|---|
|  | 266 | if (!$result->exists()) { | 
|---|
|  | 267 | $refmissing++; | 
|---|
|  | 268 | } | 
|---|
|  | 269 | elsif (!$result->ok()) { | 
|---|
|  | 270 | $reffailed++; | 
|---|
|  | 271 | } | 
|---|
|  | 272 | if (!$cresult->exists()) { | 
|---|
|  | 273 | $testmissing++; | 
|---|
|  | 274 | } | 
|---|
|  | 275 | elsif (!$cresult->ok()) { | 
|---|
|  | 276 | $testfailed++; | 
|---|
|  | 277 | } | 
|---|
|  | 278 | } | 
|---|
|  | 279 | } | 
|---|
|  | 280 | else { | 
|---|
|  | 281 | printf " missing"; | 
|---|
|  | 282 | $testmissing++; | 
|---|
|  | 283 | } | 
|---|
|  | 284 | } | 
|---|
|  | 285 | $ntest++; | 
|---|
|  | 286 | printf "\n"; | 
|---|
|  | 287 | } | 
|---|
|  | 288 |  | 
|---|
|  | 289 | sub flagerror { | 
|---|
|  | 290 | print "*"; | 
|---|
|  | 291 | $error++; | 
|---|
|  | 292 | } | 
|---|
|  | 293 |  | 
|---|
|  | 294 | sub tofilename { | 
|---|
|  | 295 | my $raw = shift; | 
|---|
|  | 296 | $raw =~ tr/A-Z/a-z/; | 
|---|
|  | 297 | $raw =~ s/-//g; | 
|---|
|  | 298 | $raw =~ s/\*/s/g; | 
|---|
|  | 299 | $raw; | 
|---|
|  | 300 | } | 
|---|
|  | 301 |  | 
|---|
|  | 302 | sub compare_numbers { | 
|---|
|  | 303 | my $num1 = shift; | 
|---|
|  | 304 | my $num2 = shift; | 
|---|
|  | 305 | my $diff = abs($num1-$num2); | 
|---|
|  | 306 | my $ldiff; | 
|---|
|  | 307 | if ($diff == 0) { | 
|---|
|  | 308 | $ldiff = 99; | 
|---|
|  | 309 | } | 
|---|
|  | 310 | else { | 
|---|
|  | 311 | $ldiff = -log($diff)/$log10; | 
|---|
|  | 312 | } | 
|---|
|  | 313 | $ldiff; | 
|---|
|  | 314 | } | 
|---|
|  | 315 |  | 
|---|
|  | 316 | # counts how many elements until we get to the first | 
|---|
|  | 317 | # element equal to zero | 
|---|
|  | 318 | sub n_nonzero_in_vec { | 
|---|
|  | 319 | my $vref = shift; | 
|---|
|  | 320 | my @v = @{$vref}; | 
|---|
|  | 321 | my $n = 0; | 
|---|
|  | 322 | my $e1; | 
|---|
|  | 323 | while (($e1 = shift @v1)) { | 
|---|
|  | 324 | last if (abs($e1) < 1.0e-6); | 
|---|
|  | 325 | $n = $n + 1; | 
|---|
|  | 326 | } | 
|---|
|  | 327 | $n; | 
|---|
|  | 328 | } | 
|---|
|  | 329 |  | 
|---|
|  | 330 | sub compare_vecs { | 
|---|
|  | 331 | my $v1ref = shift; | 
|---|
|  | 332 | my $v2ref = shift; | 
|---|
|  | 333 | my @v1 = @{$v1ref}; | 
|---|
|  | 334 | my @v2 = @{$v2ref}; | 
|---|
|  | 335 | my $e1, $e2; | 
|---|
|  | 336 | my $maxerror = 99; | 
|---|
|  | 337 | my $nv1 = @v1; | 
|---|
|  | 338 | my $nv2 = @v2; | 
|---|
|  | 339 | if ($nv1 != $nv2) { | 
|---|
|  | 340 | printf "<compare_vecs: vecs not of equal length>"; | 
|---|
|  | 341 | return -$maxerror; | 
|---|
|  | 342 | } | 
|---|
|  | 343 | while (($e1 = shift @v1) | 
|---|
|  | 344 | &&($e2 = shift @v2)) { | 
|---|
|  | 345 | my $diff = abs($e2-$e1); | 
|---|
|  | 346 | my $ldiff; | 
|---|
|  | 347 | if ($diff == 0) { | 
|---|
|  | 348 | $ldiff = 99; | 
|---|
|  | 349 | } | 
|---|
|  | 350 | else { | 
|---|
|  | 351 | $ldiff = -log($diff)/$log10; | 
|---|
|  | 352 | } | 
|---|
|  | 353 | if ($ldiff < $maxerror) { $maxerror = $ldiff; } | 
|---|
|  | 354 | } | 
|---|
|  | 355 | $maxerror; | 
|---|
|  | 356 | } | 
|---|
|  | 357 |  | 
|---|
|  | 358 | sub compare_vecs_magnitude { | 
|---|
|  | 359 | my $v1ref = shift; | 
|---|
|  | 360 | my $v2ref = shift; | 
|---|
|  | 361 | my @v1 = @{$v1ref}; | 
|---|
|  | 362 | my @v2 = @{$v2ref}; | 
|---|
|  | 363 | my $e1, $e2; | 
|---|
|  | 364 | my $maxerror = 99; | 
|---|
|  | 365 | my $nv1 = @v1; | 
|---|
|  | 366 | my $nv2 = @v2; | 
|---|
|  | 367 | if ($nv1 != $nv2) { | 
|---|
|  | 368 | printf "<compare_vecs_magnitude: vecs not of equal length>"; | 
|---|
|  | 369 | return -$maxerror; | 
|---|
|  | 370 | } | 
|---|
|  | 371 | while (($e1 = shift @v1) | 
|---|
|  | 372 | &&($e2 = shift @v2)) { | 
|---|
|  | 373 | my $diff = abs(abs($e2)-abs($e1)); | 
|---|
|  | 374 | my $ldiff; | 
|---|
|  | 375 | if ($diff == 0) { | 
|---|
|  | 376 | $ldiff = 99; | 
|---|
|  | 377 | } | 
|---|
|  | 378 | else { | 
|---|
|  | 379 | $ldiff = -log($diff)/$log10; | 
|---|
|  | 380 | } | 
|---|
|  | 381 | if ($ldiff < $maxerror) { $maxerror = $ldiff; } | 
|---|
|  | 382 | } | 
|---|
|  | 383 | $maxerror; | 
|---|
|  | 384 | } | 
|---|
|  | 385 |  | 
|---|
|  | 386 | sub compare_vecvecs { | 
|---|
|  | 387 | my $v1ref = shift; | 
|---|
|  | 388 | my $v2ref = shift; | 
|---|
|  | 389 | my @v1 = @{$v1ref}; | 
|---|
|  | 390 | my @v2 = @{$v2ref}; | 
|---|
|  | 391 | my $e1, $e2; | 
|---|
|  | 392 | my $maxerror = 99; | 
|---|
|  | 393 | my $nv1 = @v1; | 
|---|
|  | 394 | my $nv2 = @v2; | 
|---|
|  | 395 | if ($nv1 != $nv2) { | 
|---|
|  | 396 | printf "<compare_vecvecs: vecs not of equal length>"; | 
|---|
|  | 397 | return -$maxerror; | 
|---|
|  | 398 | } | 
|---|
|  | 399 | while (($e1 = shift @v1) | 
|---|
|  | 400 | &&($e2 = shift @v2)) { | 
|---|
|  | 401 | my $diff = abs($e2-$e1); | 
|---|
|  | 402 | my $ldiff = compare_vecs($e1,$e2); | 
|---|
|  | 403 | if ($ldiff < $maxerror) { $maxerror = $ldiff; } | 
|---|
|  | 404 | } | 
|---|
|  | 405 | $maxerror; | 
|---|
|  | 406 | } | 
|---|
|  | 407 |  | 
|---|
|  | 408 | # returns 1 if the vecs are identical for as many elements | 
|---|
|  | 409 | # are given in the third argument | 
|---|
|  | 410 | sub compare_string_vecs { | 
|---|
|  | 411 | my $v1ref = shift; | 
|---|
|  | 412 | my $v2ref = shift; | 
|---|
|  | 413 | my $n = shift; | 
|---|
|  | 414 | my @v1 = @{$v1ref}; | 
|---|
|  | 415 | my @v2 = @{$v2ref}; | 
|---|
|  | 416 | my $nv1 = @v1; | 
|---|
|  | 417 | my $nv2 = @v2; | 
|---|
|  | 418 | if ($nv1 != $nv2) { | 
|---|
|  | 419 | printf "<compare_vecs: vecs not of equal length>"; | 
|---|
|  | 420 | return 0; | 
|---|
|  | 421 | } | 
|---|
|  | 422 | my $e1, $e2; | 
|---|
|  | 423 | my $i = 0; | 
|---|
|  | 424 | while (($e1 = shift @v1) | 
|---|
|  | 425 | &&($e2 = shift @v2) && $i < $n) { | 
|---|
|  | 426 | if ($e1 ne $e2) { return 0; } | 
|---|
|  | 427 | $i = $i + 1; | 
|---|
|  | 428 | } | 
|---|
|  | 429 | 1; | 
|---|
|  | 430 | } | 
|---|
|  | 431 |  | 
|---|
|  | 432 | sub print_vec { | 
|---|
|  | 433 | my $v1ref = shift; | 
|---|
|  | 434 | my @v1 = @{$v1ref}; | 
|---|
|  | 435 | my $e1; | 
|---|
|  | 436 | while ($e1 = shift @v1) { | 
|---|
|  | 437 | printf " %12.8f\n", $e1; | 
|---|
|  | 438 | } | 
|---|
|  | 439 | } | 
|---|
|  | 440 |  | 
|---|
|  | 441 | sub print_vecvec { | 
|---|
|  | 442 | my $v1ref = shift; | 
|---|
|  | 443 | my @v1 = @{$v1ref}; | 
|---|
|  | 444 | my $e1; | 
|---|
|  | 445 | while ($e1 = shift @v1) { | 
|---|
|  | 446 | my @v2 = @{$e1}; | 
|---|
|  | 447 | my $e2; | 
|---|
|  | 448 | while ($e2 = shift @v2) { | 
|---|
|  | 449 | printf " %12.8f", $e2; | 
|---|
|  | 450 | } | 
|---|
|  | 451 | printf "\n"; | 
|---|
|  | 452 | } | 
|---|
|  | 453 | } | 
|---|
|  | 454 |  | 
|---|
|  | 455 | sub print_string_vec { | 
|---|
|  | 456 | my $v1ref = shift; | 
|---|
|  | 457 | my @v1 = @{$v1ref}; | 
|---|
|  | 458 | my $e1; | 
|---|
|  | 459 | while ($e1 = shift @v1) { | 
|---|
|  | 460 | printf " %s\n", $e1; | 
|---|
|  | 461 | } | 
|---|
|  | 462 | } | 
|---|