[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 | }
|
---|