source: ThirdParty/mpqc_open/src/bin/mpqc/validate/checkout.pl@ 482400e

Action_Thermostats Add_AtomRandomPerturbation Add_RotateAroundBondAction Add_SelectAtomByNameAction Adding_Graph_to_ChangeBondActions Adding_MD_integration_tests Adding_StructOpt_integration_tests Automaking_mpqc_open AutomationFragmentation_failures Candidate_v1.6.0 Candidate_v1.6.1 ChangeBugEmailaddress ChangingTestPorts ChemicalSpaceEvaluator Combining_Subpackages Debian_Package_split Debian_package_split_molecuildergui_only Disabling_MemDebug Docu_Python_wait EmpiricalPotential_contain_HomologyGraph_documentation Enable_parallel_make_install Enhance_userguide Enhanced_StructuralOptimization Enhanced_StructuralOptimization_continued Example_ManyWaysToTranslateAtom Exclude_Hydrogens_annealWithBondGraph FitPartialCharges_GlobalError Fix_ChronosMutex Fix_StatusMsg Fix_StepWorldTime_single_argument Fix_Verbose_Codepatterns ForceAnnealing_goodresults ForceAnnealing_oldresults ForceAnnealing_tocheck ForceAnnealing_with_BondGraph ForceAnnealing_with_BondGraph_continued ForceAnnealing_with_BondGraph_continued_betteresults ForceAnnealing_with_BondGraph_contraction-expansion GeometryObjects Gui_displays_atomic_force_velocity IndependentFragmentGrids_IntegrationTest JobMarket_RobustOnKillsSegFaults JobMarket_StableWorkerPool JobMarket_unresolvable_hostname_fix ODR_violation_mpqc_open PartialCharges_OrthogonalSummation PythonUI_with_named_parameters QtGui_reactivate_TimeChanged_changes Recreated_GuiChecks RotateToPrincipalAxisSystem_UndoRedo StoppableMakroAction Subpackage_levmar Subpackage_vmg ThirdParty_MPQC_rebuilt_buildsystem TremoloParser_IncreasedPrecision TremoloParser_MultipleTimesteps Ubuntu_1604_changes stable
Last change on this file since 482400e was 860145, checked in by Frederik Heber <heber@…>, 8 years ago

Merge commit '0b990dfaa8c6007a996d030163a25f7f5fc8a7e7' as 'ThirdParty/mpqc_open'

  • Property mode set to 100644
File size: 14.7 KB
Line 
1#
2eval 'exec perl $0 $*'
3 if 0;
4
5require QCResult;
6
7my $log10 = log(10.0);
8
9$error = 0;
10$refmissing = 0;
11$testmissing = 0;
12$reffailed = 0;
13$testfailed = 0;
14$ntest = 0;
15
16if ($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}
25elsif ($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}
40else {
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
54print "*************************************************\n";
55printf "* %6d test cases total\n", $ntest;
56printf "* %6d numerical discrepancies\n", $error;
57printf "* %6d failed reference cases\n", $reffailed;
58printf "* %6d missing reference cases\n", $refmissing;
59printf "* %6d failed test cases\n", $testfailed;
60printf "* %6d missing test cases\n", $testmissing;
61print "*************************************************\n";
62
63if ($error + $testfailed + $testmissing + $reffailed + $refmissing > 0) {
64 print "CHECK FAILED\n";
65 exit 1;
66}
67else {
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.
77sub 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
289sub flagerror {
290 print "*";
291 $error++;
292}
293
294sub 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
302sub 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
318sub 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
330sub 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
358sub 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
386sub 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
410sub 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
432sub 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
441sub 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
455sub 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}
Note: See TracBrowser for help on using the repository browser.