← Back to branch summary

~ubuntu-branches/ubuntu/quantal/psicode/quantal

« back to all changes in this revision

Viewing changes to tests/psitest.pl

  • Committer: Bazaar Package Importer
  • Author(s): Michael Banck
  • Date: 2006-09-10 14:01:33 UTC
  • Revision ID: james.westby@ubuntu.com-20060910140133-ib2j86trekykfsfv
Tags: upstream-3.2.3
Import upstream version 3.2.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/psitest.pl
 
1
#!/usr/bin/perl 
 
2
 
 
3
# Some general functions useful for parsing PSI3 output files.
 
4
# TDC, 5/03
 
5
 
 
6
#
 
7
# Rules of use:
 
8
# 1) environment must define variable $SRCDIR which points to the source directory where
 
9
#    the input and reference output files are located
 
10
# 2) variable $EXECDIR can be used to specify location of Psi3 executables relative to the directory
 
11
#    where testing is performed
 
12
#
 
13
 
 
14
#
 
15
# Global definitions
 
16
#
 
17
use Env;
 
18
$SRC_PATH = $SRCDIR;
 
19
if ($SRC_PATH eq "") {
 
20
  $SRC_PATH = ".";
 
21
}
 
22
if ($EXECDIR eq "") {
 
23
  $PSITEST_EXEC_PATH = "../../bin";
 
24
}
 
25
else {
 
26
  $PSITEST_EXEC_PATH = $EXECDIR;
 
27
}
 
28
$PSITEST_DEFAULT_INPUT = "input.dat";
 
29
$PSITEST_DEFAULT_PREFIX = "psi";
 
30
if ($PSITEST_INPUT eq "") {
 
31
  $PSITEST_INPUT = $PSITEST_DEFAULT_INPUT;
 
32
}
 
33
if ($PSITEST_PREFIX eq "") {
 
34
  $PSITEST_PREFIX = $PSITEST_DEFAULT_PREFIX;
 
35
}
 
36
$PSITEST_TARGET_SUFFIX = "test";
 
37
$PSITEST_TEST_SCRIPT = "runtest.pl";
 
38
 
 
39
# These are definitions that default tester knows about -- should match Psi driver!
 
40
@PSITEST_JOBTYPES = ("SP", "OPT", "DISP", "FREQ", "SYMM_FREQ", "OEPROP", "DBOC");
 
41
@PSITEST_WFNS = ("SCF", "MP2", "MP2R12", "DETCI", "DETCAS", "BCCD", "BCCD_T", "CCSD", "CCSD_T",
 
42
"EOM_CCSD", "LEOM_CCSD", "OOCCD", "CIS");
 
43
@PSITEST_REFTYPES = ("RHF", "ROHF", "UHF", "TWOCON");
 
44
@PSITEST_DERTYPES = ("NONE", "FIRST", "SECOND", "RESPONSE");
 
45
 
 
46
$PSITEST_DEFAULT_NSTAB = 5;       # number of eigenvalues STABLE prints out
 
47
 
 
48
$PSITEST_ETOL = 10**-8;           # Default test criterion for energies
 
49
$PSITEST_ENUCTOL = 10**-13;       # Check nuclear repulsion energy tighter than other energies
 
50
$PSITEST_EEOMTOL = 10**-5;        # Less stringent test for EOM-CC energies
 
51
$PSITEST_GEOMTOL = 10**-6;        # Default test criterion for Cartesian geometries
 
52
$PSITEST_GTOL = 10**-6;           # Default test criterion for gradients
 
53
$PSITEST_HTOL = 10**-2;           # Default test criterion for Hessians
 
54
$PSITEST_POLARTOL = 10**-4;       # Default test criterion for polarizabilities
 
55
$PSITEST_STABTOL = 10**-4;        # Default test criterion for Hessian eigenvalues
 
56
$PSITEST_MPOPTOL = 10**-5;        # Default test criterion for Mulliken populations
 
57
 
 
58
##################################################################
 
59
#
 
60
# This is a "smart" tester -- it parses the input and figures out
 
61
# what kinds of tests to run
 
62
#
 
63
##################################################################
 
64
sub do_tests
 
65
{
 
66
  test_started();
 
67
  my $interrupted;
 
68
  ($interrupted) = run_psi_command(@_);
 
69
 
 
70
  # Figure out what calculation has been run -- run "psi3 -c" and get the calculation type string
 
71
  my $calctype;
 
72
  my $wfn;
 
73
  my $direct;
 
74
  my $ref;
 
75
  my $dertype;
 
76
  my $jobtype;
 
77
  ($calctype, $wfn, $ref, $jobtype, $dertype, $direct) = get_calctype_string();
 
78
 
 
79
  my $item;
 
80
  my $ok = 0;
 
81
  foreach $item (@PSITEST_JOBTYPES) {
 
82
    if ($item eq $jobtype) {$ok = 1;}
 
83
  }
 
84
  if ($ok != 1) {
 
85
    fail_test("Default Psi tester do_tests does not recognize jobtype $jobtype");
 
86
    test_finished(1,$interrupted);
 
87
  }
 
88
 
 
89
  $ok = 0;
 
90
  foreach $item (@PSITEST_DERTYPES) {
 
91
    if ($item eq $dertype) {$ok = 1;}
 
92
  }
 
93
  if ($ok != 1) {
 
94
    fail_test("Default Psi tester do_tests does not recognize dertype $dertype");
 
95
    test_finished(1,$interrupted);
 
96
  }
 
97
 
 
98
  $ok = 0;
 
99
  foreach $item (@PSITEST_WFNS) {
 
100
    if ($item eq $wfn) {$ok = 1;}
 
101
  }
 
102
  if ($ok != 1) {
 
103
    fail_test("Default Psi tester do_tests does not recognize wfn $wfn");
 
104
    test_finished(1,$interrupted);
 
105
  }
 
106
 
 
107
  $ok = 0;
 
108
  foreach $item (@PSITEST_REFTYPES) {
 
109
    if ($item eq $ref) {$ok = 1;}
 
110
  }
 
111
  if ($ok != 1) {
 
112
    fail_test("Default Psi tester do_tests does not recognize reference $ref");
 
113
    test_finished(1,$interrupted);
 
114
  }
 
115
 
 
116
 
 
117
  my $fail = 0;
 
118
    
 
119
  SWITCH1: {
 
120
 
 
121
    if ($jobtype eq "OPT") {
 
122
      
 
123
      if ($dertype eq "NONE" || $dertype eq "FIRST") {
 
124
        $fail |= compare_energy_file11($wfn);
 
125
        $fail |= compare_geom_file11($wfn);
 
126
        $fail |= compare_grad_file11($wfn);
 
127
      }
 
128
 
 
129
      last SWITCH1;
 
130
    }
 
131
 
 
132
    # I'll lump all single-point computations together
 
133
    if ( $jobtype eq "SP" || $jobtype eq "FREQ" || $jobtype eq "SYMM_FREQ" || $jobtype eq "OEPROP" ||
 
134
         $jobtype eq "DBOC" || $jobtype eq "RESPONSE" ) {
 
135
      
 
136
      $fail |= compare_nuc();
 
137
      # All computations in Psi3 start with an SCF run
 
138
      $fail |= compare_scf_energy();
 
139
        
 
140
      SWITCH2: {
 
141
        
 
142
          if ($wfn eq "CCSD")     { $fail |= compare_ccsd_energy(); last SWITCH2; }
 
143
          if ($wfn eq "CCSD_T")   { $fail |= compare_ccsd_t_energy(); last SWITCH2; }
 
144
          if ($wfn eq "EOM_CCSD") { $fail |= compare_eomccsd_energy(); last SWITCH2; }
 
145
          if ($wfn eq "BCCD")     { $fail |= compare_bccd_energy(); last SWITCH2; }
 
146
          if ($wfn eq "BCCD_T")   { $fail |= compare_bccd_t_energy(); last SWITCH2; }
 
147
          if ($wfn eq "CASSCF")   { $fail |= compare_casscf_energy(); last SWITCH2; }
 
148
          if ($wfn eq "DETCI")    { $fail |= compare_ci_energy(); last SWITCH2; }
 
149
          if ($wfn eq "CIS")      { $fail |= compare_cis_energy(); last SWITCH2; }
 
150
          if ($wfn eq "MP2" && $direct == 1)
 
151
                                  { $fail |= compare_direct_mp2_energy(); last SWITCH2; }
 
152
          if ($wfn eq "MP2" && $direct == 0)
 
153
                                  { $fail |= compare_mp2_energy(); last SWITCH2; }
 
154
          if ($wfn eq "MP2R12")   { $fail |= compare_mp2r12_energy(); last SWITCH2; }
 
155
 
 
156
      }
 
157
      
 
158
      if ($jobtype eq "SP" && $dertype eq "FIRST") {
 
159
        $fail |= compare_energy_file11($wfn);
 
160
        $fail |= compare_geom_file11($wfn);
 
161
        $fail |= compare_grad_file11($wfn);
 
162
      }
 
163
      
 
164
      if ( ($jobtype eq "FREQ" || $dertype eq "SP") && $dertype eq "SECOND") {
 
165
        $fail |= compare_harm_freq($wfn);
 
166
        $fail |= compare_harm_intensities($wfn);
 
167
      }
 
168
 
 
169
      if ($jobtype eq "FREQ" && $dertype eq "FIRST") {
 
170
        $fail |= compare_findif_freq($wfn);
 
171
      }
 
172
 
 
173
      if ($jobtype eq "SYMM_FREQ" && $dertype eq "FIRST") {
 
174
        $fail |= compare_findif_symm_freq($wfn);
 
175
      }
 
176
      if ($jobtype eq "DBOC") {
 
177
        $fail |= compare_dboc()
 
178
      }
 
179
 
 
180
      if ($jobtype eq "OEPROP") {
 
181
        $fail |= compare_mulliken_orb_pops();
 
182
        $fail |= compare_mulliken_ab_pops();
 
183
        $fail |= compare_mulliken_ga_pops();
 
184
        $fail |= compare_electric_dipole();
 
185
        $fail |= compare_elec_angmom();
 
186
        $fail |= compare_epef();
 
187
        $fail |= compare_edens();
 
188
        $fail |= compare_mvd();
 
189
      }
 
190
     
 
191
      if ($jobtype eq "SP" && $dertype eq "RESPONSE") {
 
192
        if ($wfn =~ "CC") {
 
193
          $fail |= compare_cclambda_overlap($wfn);
 
194
          $fail |= compare_ccsd_polar($wfn);
 
195
        }
 
196
        if ($wfn eq "SCF") {
 
197
          $fail |= compare_scf_polar();
 
198
        }
 
199
      }
 
200
 
 
201
      last SWITCH1;
 
202
    }
 
203
 
 
204
  }
 
205
  
 
206
  test_finished($fail,$interrupted);
 
207
}
 
208
 
 
209
##################################################################
 
210
#
 
211
# Following are utility functions
 
212
#
 
213
##################################################################
 
214
sub usage_notice
 
215
{
 
216
  printf "USAGE: $_[0] [options]\n";
 
217
  printf "       where options are:\n";
 
218
  printf "       -h    help\n";
 
219
  printf "       -c    do cleanup instead of testing\n";
 
220
  printf "       -u    exit cleanly even if execution fails\n";
 
221
  printf "       -q    run quietly, print out only the summary at the end\n";
 
222
}
 
223
 
 
224
sub test_started
 
225
{
 
226
  $test_name = get_test_name();
 
227
  $target = "$test_name.$PSITEST_TARGET_SUFFIX";
 
228
  open(RE, ">$target") || die "cannot open $target $!";
 
229
  close (RE);
 
230
  print_test_header();
 
231
}
 
232
 
 
233
sub pass_test
 
234
{
 
235
  $test_name = get_test_name();
 
236
  $target = "$test_name.$PSITEST_TARGET_SUFFIX";
 
237
  open(RE, ">>$target") || die "cannot open $target $!"; 
 
238
  printf RE "%-70s...PASSED\n", $_[0];
 
239
  close (RE);
 
240
}
 
241
 
 
242
sub fail_test
 
243
{
 
244
  $test_name = get_test_name();
 
245
  $target = "$test_name.$PSITEST_TARGET_SUFFIX";
 
246
  open(RE, ">>$target") || die "cannot open $target $!"; 
 
247
  printf RE "%-70s...FAILED\n", $_[0];
 
248
  close (RE);
 
249
}
 
250
 
 
251
sub print_test_header
 
252
{
 
253
  $test_name = get_test_name();
 
254
  $target = "$test_name.$PSITEST_TARGET_SUFFIX";
 
255
  open(RE, ">>$target") || die "cannot open $target $!"; 
 
256
  printf RE "$test_name:\n";
 
257
  close (RE);
 
258
}
 
259
 
 
260
sub test_finished
 
261
{
 
262
  my $fail = $_[0];
 
263
  my $interrupted = $_[1];
 
264
 
 
265
  $test_name = get_test_name();
 
266
  $target = "$test_name.$PSITEST_TARGET_SUFFIX";
 
267
 
 
268
  system("cat $target");
 
269
 
 
270
  if ($interrupted) {
 
271
    exit($fail);
 
272
  }
 
273
  else {
 
274
    exit(0);
 
275
  }
 
276
}
 
277
 
 
278
sub get_test_name
 
279
{
 
280
  use File::Basename;
 
281
  use Cwd;
 
282
  my $test_name = basename("$SRC_PATH");
 
283
  if ($test_name eq ".") {
 
284
    my $pwd = getcwd();
 
285
    $test_name = basename($pwd);
 
286
  }
 
287
  
 
288
  return $test_name;
 
289
}
 
290
 
 
291
sub compare_nuc
 
292
{
 
293
  my $fail = 0;
 
294
  my $REF_FILE = "$SRC_PATH/output.ref";
 
295
  my $TEST_FILE = "output.dat";
 
296
 
 
297
  if(abs(seek_nuc($REF_FILE) - seek_nuc($TEST_FILE)) > $PSITEST_ENUCTOL) {
 
298
    fail_test("Nuclear repulsion energy"); $fail = 1;
 
299
  }
 
300
  else {
 
301
    pass_test("Nuclear repulsion energy");
 
302
  }
 
303
  
 
304
  return $fail;
 
305
}
 
306
 
 
307
sub compare_scf_energy
 
308
{
 
309
  my $fail = 0;
 
310
  my $REF_FILE = "$SRC_PATH/output.ref";
 
311
  my $TEST_FILE = "output.dat";
 
312
 
 
313
  if(abs(seek_scf($REF_FILE) - seek_scf($TEST_FILE)) > $PSITEST_ETOL) {
 
314
    fail_test("SCF energy"); $fail = 1;
 
315
  }
 
316
  else {
 
317
    pass_test("SCF energy");
 
318
  }
 
319
  
 
320
  return $fail;
 
321
}
 
322
 
 
323
sub compare_ccsd_energy
 
324
{
 
325
  my $fail = 0;
 
326
  my $REF_FILE = "$SRC_PATH/output.ref";
 
327
  my $TEST_FILE = "output.dat";
 
328
 
 
329
  if(abs(seek_ccsd($REF_FILE) - seek_ccsd($TEST_FILE)) > $PSITEST_ETOL) {
 
330
    fail_test("CCSD energy"); $fail = 1;
 
331
  }
 
332
  else {
 
333
    pass_test("CCSD energy");
 
334
  }
 
335
  
 
336
  return $fail;
 
337
}
 
338
 
 
339
sub compare_ccsd_t_energy
 
340
{
 
341
  my $fail = 0;
 
342
  my $REF_FILE = "$SRC_PATH/output.ref";
 
343
  my $TEST_FILE = "output.dat";
 
344
 
 
345
  if(abs(seek_ccsd_t($REF_FILE) - seek_ccsd_t($TEST_FILE)) > $PSITEST_ETOL) {
 
346
    fail_test("CCSD(T) energy"); $fail = 1;
 
347
  }
 
348
  else {
 
349
    pass_test("CCSD(T) energy");
 
350
  }
 
351
  
 
352
  return $fail;
 
353
}
 
354
 
 
355
sub compare_eomccsd_energy
 
356
{
 
357
  my $fail = 0;
 
358
  my $REF_FILE = "$SRC_PATH/output.ref";
 
359
  my $TEST_FILE = "output.dat";
 
360
 
 
361
  @eom_ref = seek_eomcc($REF_FILE);
 
362
  @eom_test = seek_eomcc($TEST_FILE);
 
363
 
 
364
  if(!compare_arrays(\@eom_ref,\@eom_test,($#eom_ref+1),$PSITEST_EEOMTOL)) {
 
365
    fail_test("EOM-CCSD energy"); $fail = 1;
 
366
  }
 
367
  else {
 
368
    pass_test("EOM-CCSD energy");
 
369
  }
 
370
  
 
371
  return $fail;
 
372
}
 
373
 
 
374
sub compare_bccd_energy
 
375
{
 
376
  my $fail = 0;
 
377
  my $REF_FILE = "$SRC_PATH/output.ref";
 
378
  my $TEST_FILE = "output.dat";
 
379
 
 
380
  if(abs(seek_bccd($REF_FILE) - seek_bccd($TEST_FILE)) > $PSITEST_ETOL) {
 
381
    fail_test("B-CCD energy"); $fail = 1;
 
382
  }
 
383
  else {
 
384
    pass_test("B-CCD energy");
 
385
  }
 
386
  
 
387
  return $fail;
 
388
}
 
389
 
 
390
sub compare_bccd_t_energy
 
391
{
 
392
  my $fail = 0;
 
393
  my $REF_FILE = "$SRC_PATH/output.ref";
 
394
  my $TEST_FILE = "output.dat";
 
395
 
 
396
  if(abs(seek_ccsd_t($REF_FILE) - seek_ccsd_t($TEST_FILE)) > $PSITEST_ETOL) {
 
397
    fail_test("CCSD(T) energy"); $fail = 1;
 
398
  }
 
399
  else {
 
400
    pass_test("CCSD(T) energy");
 
401
  }
 
402
  
 
403
  return $fail;
 
404
}
 
405
 
 
406
sub compare_cclambda_overlap
 
407
{
 
408
  my $wfn = $_[0];
 
409
  my $fail = 0;
 
410
  my $REF_FILE = "$SRC_PATH/output.ref";
 
411
  my $TEST_FILE = "output.dat";
 
412
 
 
413
  if(abs(seek_lambda($REF_FILE) - seek_lambda($TEST_FILE)) > $PSITEST_ETOL) {
 
414
    fail_test("$wfn Lambda Overlap"); $fail = 1;
 
415
  }
 
416
  else {
 
417
    pass_test("$wfn Lambda Overlap");
 
418
  }
 
419
  
 
420
  return $fail;
 
421
}
 
422
 
 
423
sub compare_scf_polar
 
424
{
 
425
  my $fail = 0;
 
426
  my $REF_FILE = "$SRC_PATH/output.ref";
 
427
  my $TEST_FILE = "output.dat";
 
428
 
 
429
  @polar_ref = seek_scf_polar($REF_FILE);
 
430
  @polar_test = seek_scf_polar($TEST_FILE);
 
431
 
 
432
  if(!compare_arrays(\@polar_ref,\@polar_test,($#polar_ref+1),$PSITEST_POLARTOL)) {
 
433
    fail_test("SCF Polarizability"); $fail = 1;
 
434
  }
 
435
  else {
 
436
    pass_test("SCF Polarizability");
 
437
  }
 
438
  
 
439
  return $fail;
 
440
}
 
441
 
 
442
sub compare_ccsd_polar
 
443
{
 
444
  my $wfn = $_[0];
 
445
  my $fail = 0;
 
446
  my $REF_FILE = "$SRC_PATH/output.ref";
 
447
  my $TEST_FILE = "output.dat";
 
448
 
 
449
  @polar_ref = seek_ccsd_polar($REF_FILE);
 
450
  @polar_test = seek_ccsd_polar($TEST_FILE);
 
451
 
 
452
  if(!compare_arrays(\@polar_ref,\@polar_test,($#polar_ref+1),$PSITEST_POLARTOL)) {
 
453
    fail_test("$wfn Polarizability"); $fail = 1;
 
454
  }
 
455
  else {
 
456
    pass_test("$wfn Polarizability");
 
457
  }
 
458
  
 
459
  return $fail;
 
460
}
 
461
 
 
462
sub compare_casscf_energy
 
463
{
 
464
  my $fail = 0;
 
465
  my $REF_FILE = "$SRC_PATH/output.ref";
 
466
  my $TEST_FILE = "output.dat";
 
467
 
 
468
  if(abs(seek_casscf($REF_FILE) - seek_casscf($TEST_FILE)) > $PSITEST_ETOL) {
 
469
    fail_test("CASSCF energy"); $fail = 1;
 
470
  }
 
471
  else {
 
472
    pass_test("CASSCF energy");
 
473
  }
 
474
  
 
475
  return $fail;
 
476
}
 
477
 
 
478
sub compare_cis_energy
 
479
{
 
480
  my $fail = 0;
 
481
  my $REF_FILE = "$SRC_PATH/output.ref";
 
482
  my $TEST_FILE = "output.dat";
 
483
 
 
484
  @cis_ref = seek_cis($REF_FILE);
 
485
  @cis_test = seek_cis($TEST_FILE);
 
486
 
 
487
  if(!compare_arrays(\@cis_ref,\@cis_test,($#cis_ref+1),$PSITEST_ETOL)) {
 
488
    fail_test("CIS Energies"); $fail = 1;
 
489
  }
 
490
  else {
 
491
    pass_test("CIS Energies");
 
492
  }
 
493
  
 
494
  return $fail;
 
495
}
 
496
 
 
497
sub compare_ci_energy
 
498
{
 
499
  my $fail = 0;
 
500
  my $REF_FILE = "$SRC_PATH/output.ref";
 
501
  my $TEST_FILE = "output.dat";
 
502
 
 
503
  if(abs(seek_ci($REF_FILE) - seek_ci($TEST_FILE)) > $PSITEST_ETOL) {
 
504
    fail_test("CI energy"); $fail = 1;
 
505
  }
 
506
  else {
 
507
    pass_test("CI energy");
 
508
  }
 
509
  
 
510
  return $fail;
 
511
}
 
512
 
 
513
sub compare_dboc
 
514
{
 
515
  my $fail = 0;
 
516
  my $REF_FILE = "$SRC_PATH/output.ref";
 
517
  my $TEST_FILE = "output.dat";
 
518
 
 
519
  if(abs(seek_dboc($REF_FILE) - seek_dboc($TEST_FILE)) > $PSITEST_ETOL) {
 
520
    fail_test("DBOC"); $fail = 1;
 
521
  }
 
522
  else {
 
523
    pass_test("DBOC");
 
524
  }
 
525
  
 
526
  return $fail;
 
527
}
 
528
 
 
529
sub compare_mp2_energy
 
530
{
 
531
  my $fail = 0;
 
532
  my $REF_FILE = "$SRC_PATH/output.ref";
 
533
  my $TEST_FILE = "output.dat";
 
534
 
 
535
  if(abs(seek_mp2($REF_FILE) - seek_mp2($TEST_FILE)) > $PSITEST_ETOL) {
 
536
    fail_test("MP2 Energy"); $fail = 1;
 
537
  }
 
538
  else {
 
539
    pass_test("MP2 Energy");
 
540
  }
 
541
  
 
542
  return $fail;
 
543
}
 
544
 
 
545
sub compare_direct_mp2_energy
 
546
{
 
547
  my $fail = 0;
 
548
  my $REF_FILE = "$SRC_PATH/output.ref";
 
549
  my $TEST_FILE = "output.dat";
 
550
 
 
551
  if(abs(seek_mp2_direct($REF_FILE) - seek_mp2_direct($TEST_FILE)) > $PSITEST_ETOL) {
 
552
    fail_test("Direct MP2 Energy"); $fail = 1;
 
553
  }
 
554
  else {
 
555
    pass_test("Direct MP2 Energy");
 
556
  }
 
557
  
 
558
  return $fail;
 
559
}
 
560
 
 
561
sub compare_mulliken_orb_pops
 
562
{
 
563
  my $fail = 0;
 
564
  my $REF_FILE = "$SRC_PATH/output.ref";
 
565
  my $TEST_FILE = "output.dat";
 
566
 
 
567
  @gop_ref = seek_mulliken_gop($REF_FILE);
 
568
  @gop_test = seek_mulliken_gop($TEST_FILE);
 
569
 
 
570
  if(!compare_arrays(\@gop_ref,\@gop_test,($#gop_ref+1),$PSITEST_MPOPTOL)) {
 
571
    fail_test("Gross Orbital Populations"); $fail = 1;
 
572
  }
 
573
  else {
 
574
    pass_test("Gross Orbital Populations");
 
575
  }
 
576
  
 
577
  return $fail;
 
578
}
 
579
 
 
580
sub compare_mulliken_ab_pops
 
581
{
 
582
  my $fail = 0;
 
583
  my $REF_FILE = "$SRC_PATH/output.ref";
 
584
  my $TEST_FILE = "output.dat";
 
585
 
 
586
  @abp_ref = seek_mulliken_abp($REF_FILE);
 
587
  @abp_test = seek_mulliken_abp($TEST_FILE);
 
588
 
 
589
  if(!compare_arrays(\@abp_ref,\@abp_test,($#abp_ref+1),$PSITEST_MPOPTOL)) {
 
590
    fail_test("Atomic Bond Populations"); $fail = 1;
 
591
  }
 
592
  else {
 
593
    pass_test("Atomic Bond Populations");
 
594
  }
 
595
  
 
596
  return $fail;
 
597
}
 
598
 
 
599
sub compare_mulliken_ga_pops
 
600
{
 
601
  my $fail = 0;
 
602
  my $REF_FILE = "$SRC_PATH/output.ref";
 
603
  my $TEST_FILE = "output.dat";
 
604
 
 
605
  @apnc_ref = seek_mulliken_apnc($REF_FILE);
 
606
  @apnc_test = seek_mulliken_apnc($TEST_FILE);
 
607
 
 
608
  if(!compare_arrays(\@apnc_ref,\@apnc_test,($#apnc_ref+1),$PSITEST_MPOPTOL)) {
 
609
    fail_test("Gross Atomic Populations and Net Charges"); $fail = 1;
 
610
  }
 
611
  else {
 
612
    pass_test("Gross Atomic Populations and Net Charges");
 
613
  }
 
614
  
 
615
  return $fail;
 
616
}
 
617
 
 
618
sub compare_electric_dipole
 
619
{
 
620
  my $fail = 0;
 
621
  my $REF_FILE = "$SRC_PATH/output.ref";
 
622
  my $TEST_FILE = "output.dat";
 
623
 
 
624
  @edipole_ref = seek_dipole($REF_FILE);
 
625
  @edipole_test = seek_dipole($TEST_FILE);
 
626
 
 
627
  if(!compare_arrays(\@edipole_ref,\@edipole_test,($#edipole_ref+1),$PSITEST_MPOPTOL)) {
 
628
    fail_test("Electric Dipole Moment"); $fail = 1;
 
629
  }
 
630
  else {
 
631
    pass_test("Electric Dipole Moment");
 
632
  }
 
633
  
 
634
  return $fail;
 
635
}
 
636
 
 
637
sub compare_elec_angmom
 
638
{
 
639
  my $fail = 0;
 
640
  my $REF_FILE = "$SRC_PATH/output.ref";
 
641
  my $TEST_FILE = "output.dat";
 
642
 
 
643
  @eangmom_ref = seek_angmom($REF_FILE);
 
644
  @eangmom_test = seek_angmom($TEST_FILE);
 
645
 
 
646
  if(!compare_arrays(\@eangmom_ref,\@eangmom_test,($#eangmom_ref+1),$PSITEST_MPOPTOL)) {
 
647
    fail_test("Electric Angular Momentum"); $fail = 1;
 
648
  }
 
649
  else {
 
650
    pass_test("Electric Angular Momentum");
 
651
  }
 
652
  
 
653
  return $fail;
 
654
}
 
655
 
 
656
sub compare_epef
 
657
{
 
658
  my $fail = 0;
 
659
  my $REF_FILE = "$SRC_PATH/output.ref";
 
660
  my $TEST_FILE = "output.dat";
 
661
 
 
662
  @epef_ref = seek_epef($REF_FILE);
 
663
  @epef_test = seek_epef($TEST_FILE);
 
664
 
 
665
  if(!compare_arrays(\@epef_ref,\@epef_test,($#epef_ref+1),$PSITEST_MPOPTOL)) {
 
666
    fail_test("Electrostatic Potential and Electric Field"); $fail = 1;
 
667
  }
 
668
  else {
 
669
    pass_test("Electrostatic Potential and Electric Field");
 
670
  }
 
671
  
 
672
  return $fail;
 
673
}
 
674
 
 
675
sub compare_edens
 
676
{
 
677
  my $fail = 0;
 
678
  my $REF_FILE = "$SRC_PATH/output.ref";
 
679
  my $TEST_FILE = "output.dat";
 
680
 
 
681
  @edensity_ref = seek_edensity($REF_FILE);
 
682
  @edensity_test = seek_edensity($TEST_FILE);
 
683
 
 
684
  if(!compare_arrays(\@edensity_ref,\@edensity_test,($#edensity_ref+1),$PSITEST_MPOPTOL)) {
 
685
    fail_test("Electron Density"); $fail = 1;
 
686
  }
 
687
  else {
 
688
    pass_test("Electron Density");
 
689
  }
 
690
  
 
691
  return $fail;
 
692
}
 
693
 
 
694
sub compare_mvd
 
695
{
 
696
  my $fail = 0;
 
697
  my $REF_FILE = "$SRC_PATH/output.ref";
 
698
  my $TEST_FILE = "output.dat";
 
699
 
 
700
  if(abs(seek_mvd($REF_FILE) - seek_mvd($TEST_FILE)) > $PSITEST_ETOL) {
 
701
    fail_test("One-Electron Relativistic Correction (MVD)"); $fail = 1;
 
702
  }
 
703
  else {
 
704
    pass_test("One-Electron Relativistic Correction (MVD)");
 
705
  }
 
706
  
 
707
  return $fail;
 
708
}
 
709
 
 
710
sub compare_mp2r12_energy
 
711
{
 
712
  my $fail = 0;
 
713
  my $REF_FILE = "$SRC_PATH/output.ref";
 
714
  my $TEST_FILE = "output.dat";
 
715
 
 
716
  if(abs(seek_mp2r12($REF_FILE) - seek_mp2r12($TEST_FILE)) > $PSITEST_ETOL) {
 
717
    fail_test("MP2-R12 Energy"); $fail = 1;
 
718
  }
 
719
  else {
 
720
    pass_test("MP2-R12 Energy");
 
721
  }
 
722
  
 
723
  return $fail;
 
724
}
 
725
 
 
726
sub compare_rhf_stability
 
727
{
 
728
  my $fail = 0;
 
729
  my $REF_FILE = "$SRC_PATH/output.ref";
 
730
  my $TEST_FILE = "output.dat";
 
731
 
 
732
  my $nirreps = seek_nirreps($REF_FILE);
 
733
  my $label = "RHF->RHF";
 
734
  @stab_ref = seek_stab($REF_FILE, $label, $PSITEST_DEFAULT_NSTAB, $nirreps);
 
735
  @stab_test = seek_stab($TEST_FILE, $label, $PSITEST_DEFAULT_NSTAB, $nirreps);
 
736
 
 
737
  if(!compare_arrays(\@stab_ref,\@stab_test,($#stab_ref+1),$PSITEST_STABTOL)) {
 
738
    fail_test("$label Stability"); $fail = 1;
 
739
  }
 
740
  else {
 
741
    pass_test("$label Stability");
 
742
  }
 
743
 
 
744
  my $label = "RHF->UHF";
 
745
  @stab_ref = seek_stab($REF_FILE, $label, $PSITEST_DEFAULT_NSTAB, $nirreps);
 
746
  @stab_test = seek_stab($TEST_FILE, $label, $PSITEST_DEFAULT_NSTAB, $nirreps);
 
747
 
 
748
  if(!compare_arrays(\@stab_ref,\@stab_test,($#stab_ref+1),$PSITEST_STABTOL)) {
 
749
    fail_test("$label Stability"); $fail = 1;
 
750
  }
 
751
  else {
 
752
    pass_test("$label Stability");
 
753
  }
 
754
 
 
755
  return $fail;
 
756
}
 
757
 
 
758
sub compare_rohf_stability
 
759
{
 
760
  my $fail = 0;
 
761
  my $REF_FILE = "$SRC_PATH/output.ref";
 
762
  my $TEST_FILE = "output.dat";
 
763
 
 
764
  my $nirreps = seek_nirreps($REF_FILE);
 
765
  my $label = "ROHF->ROHF";
 
766
  @stab_ref = seek_stab($REF_FILE, $label, $PSITEST_DEFAULT_NSTAB, $nirreps);
 
767
  @stab_test = seek_stab($TEST_FILE, $label, $PSITEST_DEFAULT_NSTAB, $nirreps);
 
768
 
 
769
  if(!compare_arrays(\@stab_ref,\@stab_test,($#stab_ref+1),$PSITEST_STABTOL)) {
 
770
    fail_test("$label Stability"); $fail = 1;
 
771
  }
 
772
  else {
 
773
    pass_test("$label Stability");
 
774
  }
 
775
 
 
776
  return $fail;
 
777
}
 
778
 
 
779
sub compare_uhf_stability
 
780
{
 
781
  my $fail = 0;
 
782
  my $REF_FILE = "$SRC_PATH/output.ref";
 
783
  my $TEST_FILE = "output.dat";
 
784
 
 
785
  my $nirreps = seek_nirreps($REF_FILE);
 
786
  my $label = "UHF->UHF";
 
787
  @stab_ref = seek_stab($REF_FILE, $label, $PSITEST_DEFAULT_NSTAB, $nirreps);
 
788
  @stab_test = seek_stab($TEST_FILE, $label, $PSITEST_DEFAULT_NSTAB, $nirreps);
 
789
 
 
790
  if(!compare_arrays(\@stab_ref,\@stab_test,($#stab_ref+1),$PSITEST_STABTOL)) {
 
791
    fail_test("$label Stability"); $fail = 1;
 
792
  }
 
793
  else {
 
794
    pass_test("$label Stability");
 
795
  }
 
796
 
 
797
  return $fail;
 
798
}
 
799
 
 
800
sub compare_harm_freq
 
801
{
 
802
  my $wfn = $_[0];
 
803
  my $fail = 0;
 
804
  my $REF_FILE = "$SRC_PATH/output.ref";
 
805
  my $TEST_FILE = "output.dat";
 
806
 
 
807
  my $ndof = seek_ndof($REF_FILE);
 
808
  @freq_ref = seek_anal_freq($REF_FILE,"Harmonic Frequency",$ndof);
 
809
  @freq_test = seek_anal_freq($TEST_FILE,"Harmonic Frequency",$ndof);
 
810
 
 
811
  if(!compare_arrays(\@freq_ref,\@freq_test,($#freq_ref+1),$PSITEST_HTOL)) {
 
812
    fail_test("$wfn Frequencies"); $fail = 1;
 
813
  }
 
814
  else {
 
815
    pass_test("$wfn Frequencies");
 
816
  }
 
817
 
 
818
  return $fail;
 
819
}
 
820
 
 
821
sub compare_harm_intensities
 
822
{
 
823
  my $wfn = $_[0];
 
824
  my $fail = 0;
 
825
  my $REF_FILE = "$SRC_PATH/output.ref";
 
826
  my $TEST_FILE = "output.dat";
 
827
 
 
828
  my $ndof = seek_ndof($REF_FILE);
 
829
  @int_ref = seek_int($REF_FILE,"Harmonic Frequency",$ndof);
 
830
  @int_test = seek_int($TEST_FILE,"Harmonic Frequency",$ndof);
 
831
 
 
832
  if(!compare_arrays(\@int_ref,\@int_test,($#int_ref+1),$PSITEST_HTOL)) {
 
833
    fail_test("$wfn Intensities"); $fail = 1;
 
834
  }
 
835
  else {
 
836
    pass_test("$wfn Intensities");
 
837
  }
 
838
 
 
839
  return $fail;
 
840
}
 
841
 
 
842
sub compare_energy_file11
 
843
{
 
844
  my $wfn = $_[0];
 
845
  my $fail = 0;
 
846
  my $REF_FILE = "$SRC_PATH/file11.ref";
 
847
  my $TEST_FILE = "$PSITEST_PREFIX.file11.dat";
 
848
 
 
849
  if(abs(seek_energy_file11($REF_FILE,$wfn) - seek_energy_file11($TEST_FILE,$wfn)) > $PSITEST_ETOL) {
 
850
    fail_test("$wfn energy"); $fail = 1;
 
851
  }
 
852
  else {
 
853
    pass_test("$wfn energy");
 
854
  }
 
855
  
 
856
  return $fail;
 
857
}
 
858
 
 
859
sub compare_geom_file11
 
860
{
 
861
  my $wfn = $_[0];
 
862
  my $fail = 0;
 
863
  my $REF_FILE = "$SRC_PATH/file11.ref";
 
864
  my $TEST_FILE = "$PSITEST_PREFIX.file11.dat";
 
865
 
 
866
  my @geom_ref = seek_geom_file11($REF_FILE, $wfn);
 
867
  my @geom_test = seek_geom_file11($TEST_FILE, $wfn);
 
868
  if(!compare_arrays(\@geom_ref, \@geom_test, ($#geom_ref+1), $PSITEST_GEOMTOL)) {
 
869
    fail_test("$wfn Geometry"); $fail = 1;
 
870
  }
 
871
  else {
 
872
    pass_test("$wfn Geometry");
 
873
  }
 
874
    
 
875
  return $fail;
 
876
}
 
877
 
 
878
sub compare_grad_file11
 
879
{
 
880
  my $wfn = $_[0];
 
881
  my $fail = 0;
 
882
  my $REF_FILE = "$SRC_PATH/file11.ref";
 
883
  my $TEST_FILE = "$PSITEST_PREFIX.file11.dat";
 
884
 
 
885
  my @grad_ref = seek_grad_file11($REF_FILE, $wfn);
 
886
  my @grad_test = seek_grad_file11($TEST_FILE, $wfn);  
 
887
  if(!compare_arrays(\@grad_ref, \@grad_test, ($#grad_ref+1), $PSITEST_GTOL)) {
 
888
    fail_test("$wfn Gradient"); $fail = 1;
 
889
  }
 
890
  else {
 
891
    pass_test("$wfn Gradient");
 
892
  }
 
893
    
 
894
  return $fail;
 
895
}
 
896
 
 
897
sub compare_findif_freq
 
898
{
 
899
  my $wfn = $_[0];
 
900
  my $fail = 0;
 
901
  my $REF_FILE = "$SRC_PATH/output.ref";
 
902
  my $TEST_FILE = "output.dat";
 
903
  my $ndof = seek_ndof($REF_FILE);
 
904
 
 
905
  my @freq_ref = seek_findif_freq($REF_FILE, "Harmonic Vibrational Frequencies", $ndof);
 
906
  my @freq_test = seek_findif_freq($TEST_FILE, "Harmonic Vibrational Frequencies", $ndof);  
 
907
  if(!compare_arrays(\@freq_ref, \@freq_test, ($#freq_ref+1), $PSITEST_HTOL)) {
 
908
    fail_test("$wfn Frequencies"); $fail = 1;
 
909
  }
 
910
  else {
 
911
    pass_test("$wfn Frequencies");
 
912
  }
 
913
    
 
914
  return $fail;
 
915
}
 
916
 
 
917
sub compare_findif_symm_freq
 
918
{
 
919
  my $wfn = $_[0];
 
920
  my $fail = 0;
 
921
  my $REF_FILE = "$SRC_PATH/output.ref";
 
922
  my $TEST_FILE = "output.dat";
 
923
  my $ndof = seek_ndof_symm($REF_FILE);
 
924
 
 
925
  my @freq_ref = seek_findif_freq($REF_FILE, "Harmonic Vibrational Frequencies", $ndof);
 
926
  my @freq_test = seek_findif_freq($TEST_FILE, "Harmonic Vibrational Frequencies", $ndof);  
 
927
  if(!compare_arrays(\@freq_ref, \@freq_test, ($#freq_ref+1), $PSITEST_HTOL)) {
 
928
    fail_test("$wfn Frequencies"); $fail = 1;
 
929
  }
 
930
  else {
 
931
    pass_test("$wfn Frequencies");
 
932
  }
 
933
    
 
934
  return $fail;
 
935
}
 
936
 
 
937
sub seek_nirreps
 
938
{
 
939
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
940
  seek(OUT,0,0);
 
941
  while(<OUT>) {
 
942
    if (/Number of irr. rep.      =/) {
 
943
      @data = split(/[ \t]+/, $_);
 
944
      my $nirreps = $data[6];
 
945
      return $nirreps;
 
946
    }
 
947
  }
 
948
  close(OUT);
 
949
 
 
950
  printf "Error: Could not find number of irreducible representations in $_[0].\n";
 
951
  exit 1;
 
952
}
 
953
 
 
954
sub seek_natoms
 
955
{
 
956
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
957
  seek(OUT,0,0);
 
958
  while(<OUT>) {
 
959
    if (/Number of atoms          =/) {
 
960
      @data = split(/[ \t]+/, $_);
 
961
      my $natoms = $data[5];
 
962
      return $natoms;
 
963
    }
 
964
  }
 
965
  close(OUT);
 
966
 
 
967
  printf "Error: Could not find number of atoms in $_[0].\n";
 
968
  exit 1;
 
969
}
 
970
 
 
971
sub seek_linear
 
972
{
 
973
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
974
  seek(OUT,0,0);
 
975
  while(<OUT>) {
 
976
    if (/    It is a linear molecule./) {
 
977
      return 1;
 
978
    }
 
979
  }
 
980
  close(OUT);
 
981
 
 
982
  return 0;
 
983
}
 
984
 
 
985
sub seek_ndof
 
986
{
 
987
  my $natoms = seek_natoms($_[0]);
 
988
  my $is_linear = seek_linear($_[0]);
 
989
  my $ndof = 3*$natoms - 6;
 
990
  if ($is_linear == 1) {
 
991
    $ndof += 1;
 
992
  }
 
993
  return $ndof;
 
994
}
 
995
 
 
996
sub seek_ndof_symm
 
997
{
 
998
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
999
  seek(OUT,0,0);
 
1000
  while(<OUT>) {
 
1001
    if (/ salcs of this irrep/) {
 
1002
      my @data = split(/ +/, $_);
 
1003
      my $ndof_symm = $data[1];
 
1004
      return $ndof_symm;
 
1005
    }
 
1006
  }
 
1007
  close(OUT);
 
1008
 
 
1009
  printf "Error: Could not find the number of symmetric degrees of freedom in $_[0].\n";
 
1010
  exit 1;
 
1011
}
 
1012
 
 
1013
sub seek_nuc
 
1014
{
 
1015
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1016
  seek(OUT,0,0);
 
1017
  while(<OUT>) {
 
1018
    if (/Nuclear Repulsion Energy \(a.u.\) =/) {
 
1019
      @data = split(/ +/, $_);
 
1020
      $nuc = $data[6];
 
1021
      return $nuc;
 
1022
    }
 
1023
  }
 
1024
  close(OUT);
 
1025
 
 
1026
  printf "Error: Could not find nuclear repulsion energy in $_[0].\n";
 
1027
  exit 1;
 
1028
}
 
1029
 
 
1030
sub seek_scf
 
1031
{
 
1032
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1033
  seek(OUT,0,0);
 
1034
  while(<OUT>) {
 
1035
    if (/SCF total energy/) {
 
1036
      @data = split(/ +/, $_);
 
1037
      $scf = $data[5];
 
1038
      return $scf;
 
1039
    }
 
1040
  }
 
1041
  close(OUT);
 
1042
 
 
1043
  printf "Error: Could not find SCF energy in $_[0].\n";
 
1044
  exit 1;
 
1045
}
 
1046
 
 
1047
sub seek_mp2
 
1048
{
 
1049
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1050
  seek(OUT,0,0);
 
1051
  while(<OUT>) {
 
1052
    if (/MP2 total energy/) {
 
1053
      @data = split(/ +/, $_);
 
1054
      $mp2 = $data[4];
 
1055
      return $mp2;
 
1056
    }
 
1057
  }
 
1058
  close(OUT);
 
1059
 
 
1060
  printf "Error: Could not find MP2 energy in $_[0].\n";
 
1061
  exit 1;
 
1062
}
 
1063
 
 
1064
sub seek_mp2_direct
 
1065
{
 
1066
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1067
  seek(OUT,0,0);
 
1068
  while(<OUT>) {
 
1069
    if (/Total MBPT/) {
 
1070
      @data = split(/ +/, $_);
 
1071
      $mp2 = $data[5];
 
1072
      return $mp2;
 
1073
    }
 
1074
  }
 
1075
  close(OUT);
 
1076
 
 
1077
  printf "Error: Could not find MP2 energy in $_[0].\n";
 
1078
  exit 1;
 
1079
}
 
1080
 
 
1081
sub seek_mp2r12
 
1082
{
 
1083
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1084
  seek(OUT,0,0);
 
1085
  while(<OUT>) {
 
1086
    if (/MBPT\(2\)-R12/) {
 
1087
      @data = split(/ +/, $_);
 
1088
      $mp2r12 = $data[3];
 
1089
      return $mp2r12;
 
1090
    }
 
1091
  }
 
1092
  close(OUT);
 
1093
 
 
1094
  printf "Error: Could not find MBPT(2)-R12 energy in $_[0].\n";
 
1095
  exit 1;
 
1096
}
 
1097
 
 
1098
# find the MP2 energy in the MP2-R12 output
 
1099
sub seek_mp2r12_mp2
 
1100
{
 
1101
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1102
  seek(OUT,0,0);
 
1103
  while(<OUT>) {
 
1104
    if (/MBPT\(2\) Energy/) {
 
1105
      @data = split(/ +/, $_);
 
1106
      $mp2 = $data[3];
 
1107
      return $mp2;
 
1108
    }
 
1109
  }
 
1110
  close(OUT);
 
1111
 
 
1112
  printf "Error: Could not find MBPT(2) energy in $_[0].\n";
 
1113
  exit 1;
 
1114
}
 
1115
 
 
1116
sub seek_ccsd
 
1117
{
 
1118
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1119
  seek(OUT,0,0);
 
1120
  while(<OUT>) {
 
1121
    if (/Total CCSD energy/) {
 
1122
      @data = split(/ +/, $_);
 
1123
      $ccsd = $data[4];
 
1124
      return $ccsd;
 
1125
    }
 
1126
  }
 
1127
  close(OUT);
 
1128
 
 
1129
  printf "Error: Could not find CCSD energy in $_[0].\n";
 
1130
  exit 1;
 
1131
}
 
1132
 
 
1133
sub seek_ccsd_t
 
1134
{
 
1135
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1136
  seek(OUT,0,0);
 
1137
  while(<OUT>) {
 
1138
    if (/Total CCSD\(T\) energy/) {
 
1139
      @data = split(/ +/, $_);
 
1140
      $ccsd_t = $data[4];
 
1141
      return $ccsd_t;
 
1142
    }
 
1143
  }
 
1144
  close(OUT);
 
1145
 
 
1146
  printf "Error: Could not find CCSD(T) energy in $_[0].\n";
 
1147
  exit 1;
 
1148
}
 
1149
 
 
1150
sub seek_bccd
 
1151
{
 
1152
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1153
  @datafile = <OUT>;
 
1154
  close(OUT);
 
1155
 
 
1156
  $match = "Total CCSD energy";
 
1157
  $linenum = 0;
 
1158
  $lastiter = 0;
 
1159
 
 
1160
  foreach $line (@datafile) {
 
1161
    if ($line =~ m/$match/) {
 
1162
      $lastiter = $linenum;
 
1163
    }
 
1164
    $linenum++;
 
1165
  }
 
1166
 
 
1167
  @line = split (/ +/, $datafile[$lastiter]);
 
1168
  $bccd = $line[5];
 
1169
 
 
1170
  if($bccd != 0.0) {
 
1171
    return $bccd;
 
1172
  }
 
1173
 
 
1174
  printf "Error: Could not find B-CCD energy in $_[0].\n";
 
1175
  exit 1;
 
1176
}
 
1177
 
 
1178
sub seek_lambda
 
1179
{
 
1180
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1181
  seek(OUT,0,0);
 
1182
  while(<OUT>) {
 
1183
    if (/Overlap <L|e^T> =/) {
 
1184
      @data = split(/ +/, $_);
 
1185
      $lambda = $data[3];
 
1186
      return $lambda;
 
1187
    }
 
1188
  }
 
1189
  close(OUT);
 
1190
 
 
1191
  printf "Error: Could not find CCSD Lambda Overlap in $_[0].\n";
 
1192
  exit 1;
 
1193
}
 
1194
 
 
1195
sub seek_casscf
 
1196
{
 
1197
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1198
  @datafile = <OUT>;
 
1199
  close(OUT);
 
1200
 
 
1201
  @line1 = split(/ +/, $datafile[0]);
 
1202
  $niter = $line1[1];
 
1203
  @line2 = split(/ +/, $datafile[$niter]);
 
1204
  $casscf = $line2[5];
 
1205
 
 
1206
  if($casscf != 0.0) {
 
1207
    return $casscf;
 
1208
  }
 
1209
 
 
1210
  printf "Error: Could not find CASSCF energy in $_[0].\n";
 
1211
  exit 1;
 
1212
}
 
1213
  
 
1214
sub seek_ci
 
1215
{
 
1216
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1217
  seek(OUT,0,0);
 
1218
  while (<OUT>) {
 
1219
    if (/ROOT 1/) {
 
1220
    @data = split(/ +/, $_);
 
1221
    $ci = $data[4];
 
1222
    }
 
1223
  }
 
1224
 
 
1225
  if($ci != 0.0) {
 
1226
    return $ci;
 
1227
  }
 
1228
 
 
1229
  printf "Error: Could not find CI energy in $_[0].\n";
 
1230
  exit 1;
 
1231
}
 
1232
                          
 
1233
sub seek_energy_file11
 
1234
{
 
1235
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1236
  @datafile = <OUT>;
 
1237
  close(OUT);
 
1238
 
 
1239
  $match = "$_[1]";
 
1240
  $linenum = 0;
 
1241
  $lasiter = 0;
 
1242
 
 
1243
  foreach $line (@datafile) {
 
1244
    if($line =~ m/$match/) {
 
1245
      $lastiter = $linenum;
 
1246
    }
 
1247
    $linenum++;
 
1248
  }
 
1249
 
 
1250
  @line = split(/ +/, $datafile[$lastiter+1]);
 
1251
  $energy = $line[2];
 
1252
 
 
1253
  if($energy != 0.0) {
 
1254
    return $energy;
 
1255
  }
 
1256
 
 
1257
  printf "Error: Could not find $_[1] energy in $_[0].\n";
 
1258
  exit 1;
 
1259
}
 
1260
 
 
1261
sub seek_natom_file11
 
1262
{
 
1263
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1264
  @datafile = <OUT>;
 
1265
  close(OUT);
 
1266
 
 
1267
  $match = "$_[1]";
 
1268
  $linenum = 0;
 
1269
  $lasiter = 0;
 
1270
 
 
1271
  foreach $line (@datafile) {
 
1272
    if($line =~ m/$match/) {
 
1273
      $lastiter = $linenum;
 
1274
    }
 
1275
    $linenum++;
 
1276
  }
 
1277
 
 
1278
  @line = split(/ +/, $datafile[$lastiter+1]);
 
1279
  $natom = $line[1];
 
1280
 
 
1281
  if($natom != 0) {
 
1282
    return $natom;
 
1283
  }
 
1284
 
 
1285
  printf "Error: Could not find value of natom in $_[0].\n";
 
1286
  exit 1;
 
1287
}
 
1288
 
 
1289
sub seek_geom_file11
 
1290
{
 
1291
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1292
  @datafile = <OUT>;
 
1293
  close(OUT);
 
1294
 
 
1295
  $match = "$_[1]";
 
1296
  $linenum = 0;
 
1297
  $lasiter = 0;
 
1298
  $foundit = 0;
 
1299
 
 
1300
  foreach $line (@datafile) {
 
1301
    if($line =~ m/$match/) {
 
1302
      $lastiter = $linenum;
 
1303
      $foundit = 1;
 
1304
    }
 
1305
    $linenum++;
 
1306
  }
 
1307
 
 
1308
  @line = split(/ +/, $datafile[$lastiter+1]);
 
1309
  $natom = $line[1];
 
1310
 
 
1311
  for($i=0; $i < $natom; $i++) {
 
1312
    @line = split(/ +/, $datafile[$lastiter+2+$i]);
 
1313
    $geom[3*$i] = $line[2];
 
1314
    $geom[3*$i+1] = $line[3];
 
1315
    $geom[3*$i+2] = $line[4];
 
1316
  }
 
1317
 
 
1318
  if($foundit != 0) {
 
1319
    return @geom;
 
1320
  }
 
1321
 
 
1322
  printf "Error: Could not find $_[1] geom in $_[0].\n";
 
1323
  exit 1;
 
1324
}
 
1325
 
 
1326
sub seek_grad_file11
 
1327
{
 
1328
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1329
  @datafile = <OUT>;
 
1330
  close(OUT);
 
1331
 
 
1332
  $match = "$_[1]";
 
1333
  $linenum = 0;
 
1334
  $lasiter = 0;
 
1335
  $foundit = 0;
 
1336
 
 
1337
  foreach $line (@datafile) {
 
1338
    if($line =~ m/$match/) {
 
1339
      $lastiter = $linenum;
 
1340
      $foundit = 1;
 
1341
    }
 
1342
    $linenum++;
 
1343
  }
 
1344
 
 
1345
  @line = split(/ +/, $datafile[$lastiter+1]);
 
1346
  $natom = $line[1];
 
1347
 
 
1348
  for($i=0; $i < $natom; $i++) {
 
1349
    @line = split(/ +/, $datafile[$lastiter+2+$natom+$i]);
 
1350
    $grad[3*$i] = $line[1];
 
1351
    $grad[3*$i+1] = $line[2];
 
1352
    $grad[3*$i+2] = $line[3];
 
1353
  }
 
1354
 
 
1355
  if($foundit != 0) {
 
1356
    return @grad;
 
1357
  }
 
1358
 
 
1359
  printf "Error: Could not find $_[1] grad in $_[0].\n";
 
1360
  exit 1;
 
1361
}
 
1362
 
 
1363
sub seek_findif_freq
 
1364
{
 
1365
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1366
  @datafile = <OUT>;
 
1367
  close(OUT);
 
1368
 
 
1369
  $match = "$_[1]";
 
1370
  $ndof = "$_[2]";
 
1371
  $j=0;
 
1372
  $linenum=0;
 
1373
  foreach $line (@datafile) {
 
1374
    $linenum++;
 
1375
    if ($line =~ m/$match/) {
 
1376
      while ($j<$ndof) {
 
1377
        @test = split (/ +/,$datafile[$linenum+$j]);
 
1378
        $freq[$j] = $test[2];
 
1379
        $j++;
 
1380
      }
 
1381
    }
 
1382
  }
 
1383
 
 
1384
  $OK = 1;
 
1385
  for($i=0; $i < $ndof; $i++) {
 
1386
#    printf "%d %6.1f\n", $i, $freq[$i];
 
1387
    if($freq[$i] == 0.0 || $freq[$i] > 6000) {
 
1388
      $OK = 0; 
 
1389
    }
 
1390
  }
 
1391
  
 
1392
  if($OK && $ndof > 0) {
 
1393
    return @freq;
 
1394
  }
 
1395
 
 
1396
  printf "Error: Check $_[1] in $_[0].\n";
 
1397
  exit 1;
 
1398
}
 
1399
 
 
1400
sub seek_anal_freq
 
1401
{
 
1402
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1403
  @datafile = <OUT>;
 
1404
  close(OUT);
 
1405
 
 
1406
  $match = "$_[1]";
 
1407
  $ndof = "$_[2]";
 
1408
  $j=0;
 
1409
  $linenum=0;
 
1410
  foreach $line (@datafile) {
 
1411
    $linenum++;
 
1412
    if ($line =~ m/$match/) {
 
1413
      while ($j<$ndof) {
 
1414
        @test = split (/ +/,$datafile[$linenum+2+$j]);
 
1415
        $freq[$j] = $test[2];
 
1416
        $j++;
 
1417
      }
 
1418
    }
 
1419
  }
 
1420
 
 
1421
  $OK = 1;
 
1422
  for($i=0; $i < $ndof; $i++) {
 
1423
#    printf "%d %6.1f\n", $i, $freq[$i];
 
1424
    if($freq[$i] < 0.0 || $freq[$i] > 6000) {
 
1425
      $OK = 0; 
 
1426
    }
 
1427
  }
 
1428
  
 
1429
  if($OK && $ndof > 0) {
 
1430
    return @freq;
 
1431
  }
 
1432
 
 
1433
  printf "Error: Check $_[1] in $_[0].\n";
 
1434
  exit 1;
 
1435
}
 
1436
 
 
1437
sub seek_int
 
1438
{
 
1439
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1440
  @datafile = <OUT>;
 
1441
  close(OUT);
 
1442
 
 
1443
  # set up some initial values to be overwritten 
 
1444
  for($i=0; $i < $ndof; $i++) {
 
1445
    $int[$i] = -1.0;
 
1446
  }
 
1447
 
 
1448
  $match = "$_[1]";
 
1449
  $ndof = "$_[2]";
 
1450
  $j=0;
 
1451
  $linenum=0;
 
1452
  foreach $line (@datafile) {
 
1453
    $linenum++;
 
1454
    if ($line =~ m/$match/) {
 
1455
      while ($j<$ndof) {
 
1456
        @test = split (/ +/,$datafile[$linenum+2+$j]);
 
1457
        $int[$j] = $test[3];
 
1458
        $j++;
 
1459
      }
 
1460
    }
 
1461
  }
 
1462
 
 
1463
  $OK = 1;
 
1464
  for($i=0; $i < $ndof; $i++) {
 
1465
    if($int[$i] < 0.0) {
 
1466
      $OK = 0;
 
1467
    }
 
1468
  }
 
1469
 
 
1470
  if($OK && $ndof > 0) {
 
1471
    return @int;
 
1472
  }
 
1473
 
 
1474
  printf "Error: Check $_[1] in $_[0].\n";
 
1475
  exit 1;
 
1476
}
 
1477
 
 
1478
sub seek_eomcc
 
1479
{
 
1480
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1481
  @datafile = <OUT>;
 
1482
  close(OUT);
 
1483
 
 
1484
  $linenum=0;
 
1485
  $eval = 0;
 
1486
  foreach $line (@datafile) {
 
1487
    $linenum++;
 
1488
    if ($line =~ m/EOM State/) {
 
1489
      @test = split (/ +/,$datafile[$linenum-1]);
 
1490
      $evals[$eval] = $test[6];
 
1491
      $eval++;
 
1492
    }
 
1493
  }
 
1494
 
 
1495
  if($eval != 0) {
 
1496
    return @evals;
 
1497
  }
 
1498
 
 
1499
  printf "Error: Could not find EOM-CCSD energies in $_[0].\n";
 
1500
  exit 1;
 
1501
}
 
1502
 
 
1503
sub seek_cis
 
1504
{
 
1505
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1506
  @datafile = <OUT>;
 
1507
  close(OUT);
 
1508
  
 
1509
  $linenum=0;
 
1510
  $eval = 0;
 
1511
  foreach $line (@datafile) {
 
1512
    $linenum++;
 
1513
    if ($line =~ m/CIS State/) {
 
1514
      @test = split (/ +/,$datafile[$linenum-1]);
 
1515
      $evals[$eval] = $test[4];
 
1516
      $eval++;
 
1517
    }
 
1518
  }
 
1519
    
 
1520
  if($eval != 0) {
 
1521
    return @evals;
 
1522
  }
 
1523
    
 
1524
  printf "Error: Could not find CIS energies in $_[0].\n";
 
1525
  exit 1;
 
1526
}
 
1527
 
 
1528
 
 
1529
sub seek_stab
 
1530
{
 
1531
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1532
  @datafile = <OUT>;
 
1533
  close(OUT);
 
1534
 
 
1535
  $match = "$_[1]";
 
1536
  $num_evals = $_[2];
 
1537
  $num_symms = $_[3];
 
1538
  $linenum=0;
 
1539
  $start = 0;
 
1540
  foreach $line (@datafile) {
 
1541
    if ($line =~ m/$match/) {
 
1542
      $start = $linenum;
 
1543
    }
 
1544
    $linenum++;
 
1545
  }
 
1546
 
 
1547
  for($i=0; $i < $num_evals; $i++) {
 
1548
    @line = split(/ +/, $datafile[$start+4+$i]);
 
1549
    for($j=0; $j < $num_symms; $j++) {
 
1550
      $stab[$num_symms*$i+$j] = $line[$j+2];
 
1551
    }
 
1552
  }
 
1553
 
 
1554
  if($start != 0) {
 
1555
    return @stab;
 
1556
  }
 
1557
 
 
1558
  printf "Error: Could not find $_[1] stability eigenvalues in $_[0].\n";
 
1559
  exit 1;
 
1560
}
 
1561
 
 
1562
sub seek_scf_polar
 
1563
{
 
1564
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1565
  @datafile = <OUT>;
 
1566
  close(OUT);
 
1567
 
 
1568
  $linenum=0;
 
1569
  $start = 0;
 
1570
  foreach $line (@datafile) {
 
1571
    if ($line =~ m/Hartree-Fock Electric Polarizability Tensor/) {
 
1572
      $start = $linenum;
 
1573
    }
 
1574
    $linenum++;
 
1575
  }
 
1576
 
 
1577
  for($i=0; $i < 3; $i++) {
 
1578
    @line = split(/ +/, $datafile[$start+5+$i]);
 
1579
    for($j=0; $j < 3; $j++) {
 
1580
      $polar[3*$i+$j] = $line[$j+2];
 
1581
    }
 
1582
  }
 
1583
 
 
1584
  if($start != 0) {
 
1585
    return @polar;
 
1586
  }
 
1587
 
 
1588
  printf "Error: Could not find SCF polarizability tensor in $_[0].\n";
 
1589
  exit 1;
 
1590
}
 
1591
 
 
1592
sub seek_ccsd_polar
 
1593
{   
 
1594
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1595
  @datafile = <OUT>;
 
1596
  close(OUT);
 
1597
  
 
1598
  $linenum=0;
 
1599
  $start = 0;
 
1600
  foreach $line (@datafile) {
 
1601
    if ($line =~ m/CCSD Dipole Polarizability/) {
 
1602
      $start = $linenum;
 
1603
    }
 
1604
    $linenum++;
 
1605
  }
 
1606
 
 
1607
  for($i=0; $i < 3; $i++) {
 
1608
    @line = split(/ +/, $datafile[$start+7+$i]);
 
1609
    for($j=0; $j < 3; $j++) {
 
1610
      $polar[3*$i+$j] = $line[$j+2];
 
1611
    }
 
1612
  }
 
1613
    
 
1614
  if($start != 0) {
 
1615
    return @polar;
 
1616
  }
 
1617
  
 
1618
  printf "Error: Could not find SCF polarizability tensor in $_[0].\n";
 
1619
  exit 1;
 
1620
}
 
1621
 
 
1622
sub seek_dboc
 
1623
{
 
1624
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1625
  seek(OUT,0,0);
 
1626
  while(<OUT>) {
 
1627
    if (/E\(DBOC\)/) {
 
1628
      @data = split(/ +/, $_);
 
1629
      $Edboc = $data[3];
 
1630
      return $Edboc;
 
1631
    }
 
1632
  } 
 
1633
  close(OUT);
 
1634
  
 
1635
  printf "Error: Could not find DBOC in $_[0].\n";
 
1636
  exit 1;
 
1637
}   
 
1638
 
 
1639
sub seek_mulliken_gop
 
1640
{   
 
1641
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1642
  seek(OUT,0,0);
 
1643
  while(<OUT>) {
 
1644
    if (/# of atomic orbitals/) {
 
1645
      @data = split(/[ \t]+/, $_);
 
1646
      $nao = $data[6];
 
1647
    }
 
1648
  }
 
1649
  close (OUT);
 
1650
 
 
1651
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1652
  @datafile = <OUT>;
 
1653
  close (OUT);
 
1654
 
 
1655
  $linenum=0;
 
1656
  $start = 0;
 
1657
  foreach $line (@datafile) {
 
1658
    if ($line =~ m/-Gross orbital populations/) {
 
1659
      $start = $linenum;
 
1660
    }
 
1661
    $linenum++;
 
1662
  }
 
1663
 
 
1664
  my @mulliken;
 
1665
  for($i=0; $i<$nao; $i++) {
 
1666
    @line = split(/ +/, $datafile[$start+4+$i]);
 
1667
    $mulliken[$i] = $line[4];
 
1668
  }
 
1669
    
 
1670
  if($start != 0) {
 
1671
    return @mulliken;
 
1672
  }
 
1673
  
 
1674
  printf "Error: Could not find Gross orbital populations in $_[0].\n";
 
1675
  exit 1;
 
1676
}
 
1677
 
 
1678
sub seek_mulliken_abp
 
1679
{   
 
1680
  my $noa = seek_natoms($_[0]);
 
1681
 
 
1682
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1683
  @datafile = <OUT>;
 
1684
  close (OUT);
 
1685
 
 
1686
  $linenum=0;
 
1687
  $start = 0;
 
1688
  foreach $line (@datafile) {
 
1689
    if ($line =~ m/-Atomic bond populations/) {
 
1690
      $start = $linenum;
 
1691
    }
 
1692
    $linenum++;
 
1693
  }
 
1694
 
 
1695
  my @mulliken;
 
1696
  for($i=0; $i<$noa; $i++) {
 
1697
    @line = split(/ +/, $datafile[$start+4+$i]);
 
1698
    for($j=0; $j<$noa; $j++) {
 
1699
      $mulliken[$noa*$i+$j] = $line[$j+2];
 
1700
    }
 
1701
  }
 
1702
 
 
1703
  if($start != 0) {
 
1704
    return @mulliken;
 
1705
  }
 
1706
  
 
1707
  printf "Error: Could not find Gross orbital populations in $_[0].\n";
 
1708
  exit 1;
 
1709
}
 
1710
 
 
1711
sub seek_mulliken_apnc
 
1712
{   
 
1713
  my $noa = seek_natoms($_[0]);
 
1714
 
 
1715
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1716
  @datafile = <OUT>;
 
1717
  close (OUT);
 
1718
 
 
1719
  $linenum=0;
 
1720
  $start = 0;
 
1721
  foreach $line (@datafile) {
 
1722
    if ($line =~ m/-Gross atomic populations/) {
 
1723
      $start = $linenum;
 
1724
    }
 
1725
    $linenum++;
 
1726
  }
 
1727
 
 
1728
  my @mulliken;
 
1729
  for($i=0; $i<$noa; $i++) {
 
1730
    @line = split(/ +/, $datafile[$start+4+$i]);
 
1731
    for($j=0; $j<$noa; $j++) {
 
1732
      $mulliken[$noa*$i+$j] = $line[$j+2];
 
1733
    }
 
1734
  }
 
1735
  
 
1736
  if($start != 0) {
 
1737
    return @mulliken;
 
1738
  }
 
1739
  
 
1740
  printf "Error: Could not find Gross atomic populations in $_[0].\n";
 
1741
  exit 1;
 
1742
}
 
1743
 
 
1744
sub seek_dipole
 
1745
{
 
1746
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1747
  @datafile = <OUT>;
 
1748
  close (OUT);
 
1749
 
 
1750
  $linenum=0;
 
1751
  $start = 0;
 
1752
  foreach $line (@datafile) {
 
1753
    if ($line =~ m/-Electric dipole moment/) {
 
1754
      $start = $linenum;
 
1755
    }
 
1756
    $linenum++;
 
1757
  }
 
1758
 
 
1759
  my @dipole;
 
1760
  for($i=0; $i<4; $i++) {
 
1761
    @line = split(/ +/, $datafile[$start+2+$i]);
 
1762
    $dipole[$i] = $line[3];
 
1763
  }
 
1764
  
 
1765
  if($start != 0) {
 
1766
    return @dipole;
 
1767
  }
 
1768
  
 
1769
  printf "Error: Could not find Electronic dipole moment in $_[0].\n";
 
1770
  exit 1;
 
1771
}
 
1772
 
 
1773
sub seek_angmom
 
1774
{   
 
1775
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1776
  @datafile = <OUT>;
 
1777
  close (OUT);
 
1778
 
 
1779
  $linenum=0;
 
1780
  $start = 0;
 
1781
  foreach $line (@datafile) {
 
1782
    if ($line =~ m/-Electronic angular momentum/) {
 
1783
      $start = $linenum;
 
1784
    }
 
1785
    $linenum++;
 
1786
  }
 
1787
 
 
1788
  my @angmom;
 
1789
  for($i=0; $i<3; $i++) {
 
1790
    @line = split(/ +/, $datafile[$start+2+$i]);
 
1791
    $angmom[$i] = $line[3];
 
1792
  }
 
1793
  
 
1794
  if($start != 0) {
 
1795
    return @angmom;
 
1796
  }
 
1797
  
 
1798
  printf "Error: Could not find Electronic angular momentum in $_[0].\n";
 
1799
  exit 1;
 
1800
}
 
1801
 
 
1802
sub seek_epef
 
1803
{   
 
1804
  my $noa = seek_natoms($_[0]);
 
1805
 
 
1806
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1807
  @datafile = <OUT>;
 
1808
  close (OUT);
 
1809
 
 
1810
  $linenum=0;
 
1811
  $start = 0;
 
1812
  foreach $line (@datafile) {
 
1813
    if ($line =~ m/-Electrostatic potential/) {
 
1814
      $start = $linenum;
 
1815
    }
 
1816
    $linenum++;
 
1817
  }
 
1818
 
 
1819
  my @epef;
 
1820
  for($i=0; $i<$noa; $i++) {
 
1821
    @line = split(/ +/, $datafile[$start+4+$i]);
 
1822
    for($j=0; $j<4; $j++) {
 
1823
      $epef[$noa*$i+$j] = $line[$j+2];
 
1824
    }
 
1825
  }
 
1826
  
 
1827
  if($start != 0) {
 
1828
    return @epef;
 
1829
  }
 
1830
  
 
1831
  printf "Error: Could not find Electrostatic potential\n";
 
1832
  printf "       and electric field in $_[0].\n";
 
1833
  exit 1;
 
1834
}
 
1835
 
 
1836
sub seek_edensity
 
1837
{   
 
1838
  my $noa = seek_natoms($_[0]);
 
1839
 
 
1840
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1841
  @datafile = <OUT>;
 
1842
  close (OUT);
 
1843
 
 
1844
  $linenum=0;
 
1845
  $start = 0;
 
1846
  foreach $line (@datafile) {
 
1847
    if ($line =~ m/-Electron density/) {
 
1848
      $start = $linenum;
 
1849
    }
 
1850
    $linenum++;
 
1851
  }
 
1852
 
 
1853
  my @edensity;
 
1854
  for($i=0; $i<$noa; $i++) {
 
1855
    @line = split(/ +/, $datafile[$start+4+$i]);
 
1856
    $edensity[$i] = $line[2];
 
1857
  }
 
1858
    
 
1859
  if($start != 0) {
 
1860
    return @edensity;
 
1861
  }
 
1862
  
 
1863
  printf "Error: Could not find Electron density in $_[0].\n";
 
1864
  exit 1;
 
1865
}
 
1866
 
 
1867
sub seek_mvd
 
1868
{   
 
1869
  open(OUT, "$_[0]") || die "cannot open $_[0] $!";
 
1870
  seek(OUT,0,0);
 
1871
  while(<OUT>) {
 
1872
    if (/Total one-electron MVD terms/) {
 
1873
      @data = split(/[ \t]+/, $_);
 
1874
      $mvd = $data[6];
 
1875
      return $mvd;
 
1876
    }
 
1877
  }
 
1878
  close(OUT);
 
1879
 
 
1880
  printf "Error: Could not find Relativistic MVD one-electron\n";
 
1881
  printf "       corrections in $_[0].\n";
 
1882
  exit 1;
 
1883
}
 
1884
 
 
1885
sub compare_arrays
 
1886
{
 
1887
  my $A = $_[0];
 
1888
  my $B = $_[1];
 
1889
  my $dim = $_[2];
 
1890
  my $tol = $_[3];
 
1891
  my $OK = 1;
 
1892
  
 
1893
  for($i=0; $i < $dim; $i++) {
 
1894
    if(abs(@$A[$i] - @$B[$i]) > $tol) {
 
1895
      $OK = 0;
 
1896
    }
 
1897
  }
 
1898
 
 
1899
  return $OK;
 
1900
}
 
1901
 
 
1902
sub build_psi_cmd
 
1903
{
 
1904
  $EXEC = $_[0];
 
1905
  $QUIET = $_[1];
 
1906
  $SRC_PATH = $_[2];
 
1907
  $EXEC_PATH = $_[3];
 
1908
  $EXTRA_ARGS = $_[4];
 
1909
 
 
1910
  $PSICMD = "";
 
1911
 
 
1912
  if($EXEC_PATH ne "") {
 
1913
      $PSICMD = "PATH=$EXEC_PATH:\$PATH;export PATH;$EXEC";
 
1914
  }
 
1915
  else {
 
1916
      $PSICMD = "$EXEC";
 
1917
  }
 
1918
 
 
1919
  if($SRC_PATH ne "") {
 
1920
      $PSICMD = $PSICMD . " -f $SRC_PATH/$PSITEST_INPUT";
 
1921
  }
 
1922
 
 
1923
  if($QUIET == 1) {
 
1924
      $PSICMD = $PSICMD . " 1>/dev/null 2>/dev/null";
 
1925
  }
 
1926
 
 
1927
  if($EXTRA_ARGS ne "") {
 
1928
      $PSICMD = $PSICMD . $EXTRA_ARGS;
 
1929
  }
 
1930
 
 
1931
  return $PSICMD;
 
1932
}
 
1933
 
 
1934
sub run_psi_command
 
1935
{
 
1936
  $test_name = get_test_name();
 
1937
  my $target = "$test_name.$PSITEST_TARGET_SUFFIX";
 
1938
 
 
1939
  my $clean_only = 0;
 
1940
  my $interrupted = 1;
 
1941
  my $quiet = 0;
 
1942
  my $ARGV;
 
1943
  while ($ARGV = shift) {
 
1944
    if   ("$ARGV" eq "-q") { $quiet = 1; }
 
1945
    elsif("$ARGV" eq "-c") { $clean_only = 1; }
 
1946
    elsif("$ARGV" eq "-u") { $interrupted = 0; }
 
1947
    elsif("$ARGV" eq "-h") { usage_notice($PSITEST_TEST_SCRIPT); exit(1); }
 
1948
  }
 
1949
 
 
1950
  my $exec = "";
 
1951
  if($clean_only == 1) {
 
1952
    $exec = "psiclean";
 
1953
  }
 
1954
  else {
 
1955
    $exec = "psi3";
 
1956
  }
 
1957
 
 
1958
  my $psicmd = build_psi_cmd($exec, $quiet, $SRC_PATH, $PSITEST_EXEC_PATH, "");
 
1959
 
 
1960
  my $psi_fail = system ("$psicmd");
 
1961
  if ($clean_only == 1) {
 
1962
    exit(0);
 
1963
  }
 
1964
  
 
1965
  if ($psi_fail != 0) {
 
1966
    open(RE, ">>$target") || die "cannot open $target $!"; 
 
1967
    printf RE "Psi3 failed!\n";
 
1968
    close (RE);
 
1969
    printf STDOUT "Psi3 failed!\n";
 
1970
    my $psicmd = build_psi_cmd("psiclean", 1, $SRC_PATH, $PSITEST_EXEC_PATH, "");
 
1971
    system("$psicmd");
 
1972
    exit($interrupted);
 
1973
  }
 
1974
 
 
1975
  my @result = ($interrupted);
 
1976
  return @result;
 
1977
}
 
1978
 
 
1979
sub get_calctype_string
 
1980
{
 
1981
  # It's better to use File::Temp but it doesn't seem to be installed by default
 
1982
  # use File::Temp;
 
1983
  use POSIX qw(tmpnam);
 
1984
 
 
1985
  my $tempfile = tmpnam();
 
1986
  my $psicmd = build_psi_cmd("psi3 -c", 0, $SRC_PATH,  $PSITEST_EXEC_PATH, " 1>$tempfile 2>/dev/null");
 
1987
  my $psi_fail = system($psicmd);
 
1988
  open(RE, "$tempfile") || die "cannot open $tempfile $!";
 
1989
  my $calctype;
 
1990
  my $wfn;
 
1991
  my $jobtype;
 
1992
  my $reftype;
 
1993
  my $dertype;
 
1994
  my $direct;
 
1995
  seek(RE,0,0);
 
1996
  while(<RE>) {
 
1997
    if (/Calculation type string = /) {
 
1998
      @data = split(/ +/, $_);
 
1999
      $calctype = $data[4];
 
2000
      $calctype =~ s/\n//;
 
2001
    }
 
2002
  }
 
2003
  seek(RE,0,0);
 
2004
  while(<RE>) {
 
2005
    if (/Wavefunction            = /) {
 
2006
      @data = split(/ +/, $_);
 
2007
      $wfn = $data[2];
 
2008
      $wfn =~ s/\n//;
 
2009
    }
 
2010
  }
 
2011
  seek(RE,0,0);
 
2012
  while(<RE>) {
 
2013
    if (/Reference               = /) {
 
2014
      @data = split(/ +/, $_);
 
2015
      $reftype = $data[2];
 
2016
      $reftype =~ s/\n//;
 
2017
    }
 
2018
  }
 
2019
  seek(RE,0,0);
 
2020
  while(<RE>) {
 
2021
    if (/Jobtype                 = /) {
 
2022
      @data = split(/ +/, $_);
 
2023
      $jobtype = $data[2];
 
2024
      $jobtype =~ s/\n//;
 
2025
    }
 
2026
  }
 
2027
  seek(RE,0,0);
 
2028
  while(<RE>) {
 
2029
    if (/Dertype                 = /) {
 
2030
      @data = split(/ +/, $_);
 
2031
      $dertype = $data[2];
 
2032
      $dertype =~ s/\n//;
 
2033
    }
 
2034
  }
 
2035
  seek(RE,0,0);
 
2036
  while(<RE>) {
 
2037
    if (/Direct                  = /) {
 
2038
      @data = split(/ +/, $_);
 
2039
      my $tmp = $data[2];
 
2040
      $tmp =~ s/\n//;
 
2041
      if ($tmp eq "true") {
 
2042
        $direct = 1;
 
2043
      }
 
2044
      elsif ($tmp eq "false") {
 
2045
        $direct = 0;
 
2046
      }
 
2047
    }
 
2048
  }
 
2049
  close (RE);
 
2050
  system("rm -f $tempfile");
 
2051
  
 
2052
  return ($calctype, $wfn, $reftype, $jobtype, $dertype, $direct);
 
2053
}
 
2054
 
 
2055
1;
 
2056