~ubuntu-branches/ubuntu/precise/psicode/precise

« back to all changes in this revision

Viewing changes to src/bin/cscf/cleanup.c

  • Committer: Bazaar Package Importer
  • Author(s): Michael Banck
  • Date: 2008-06-07 16:49:57 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080607164957-8pifvb133yjlkagn
Tags: 3.3.0-3
* debian/rules (DEB_MAKE_CHECK_TARGET): Do not abort test suite on
  failures.
* debian/rules (DEB_CONFIGURE_EXTRA_FLAGS): Set ${bindir} to /usr/lib/psi.
* debian/rules (install/psi3): Move psi3 file to /usr/bin.
* debian/patches/07_464867_move_executables.dpatch: New patch, add
  /usr/lib/psi to the $PATH, so that the moved executables are found.
  (closes: #464867)
* debian/patches/00list: Adjusted.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
/* $Log: cleanup.c,v $
2
 
/* Revision 1.28.4.3  2005/01/29 20:10:11  crawdad
3
 
/* (1) Fixed a bug in the UHF computation of the density in cints.
4
 
/* (2) Corrected calculation of <S^2> for UHF in cscf.
 
1
/* $Log$
 
2
 * Revision 1.32  2007/04/05 15:45:25  crawdad
 
3
 * Fixed a few memory leaks identified by valgrind. -TDC
 
4
 *
 
5
/* Revision 1.31  2005/11/10 16:37:50  evaleev
 
6
/* Added CHECK_MO_ORTHONORMALITY input keyword. Useful for debugging.
 
7
/*
 
8
/* Revision 1.30  2004/08/12 19:13:32  crawdad
 
9
/* Corrected computation of <S^2> for UHF references.  The equations were
 
10
/* coded correctly, but variable types screwed up results for doublets,
 
11
/* quartets, etc.  -TDC
 
12
/*
 
13
/* Revision 1.29  2004/05/03 04:32:40  crawdad
 
14
/* Major mods based on merge with stable psi-3-2-1 release.  Note that this
 
15
/* version has not been fully tested and some scf-optn test cases do not run
 
16
/* correctly beccause of changes in mid-March 2004 to optking.
5
17
/* -TDC
6
18
/*
7
 
/* Revision 1.28.4.2  2004/09/07 21:40:37  evaleev
8
 
/* Incorrect value for iopen was written out to chkpt file in UHF calculations.
9
 
/*
10
19
/* Revision 1.28.4.1  2004/04/01 22:04:49  evaleev
11
20
/* A critical bug: lagrangian was not written out to chkpt file correctly
12
21
/* thanks to missing symblk offsets in computing MO indices. ROHF HF gradients
192
201
/* Added a version of CSCF that can work with CINTS.
193
202
/* -Ed */
194
203
 
195
 
static char *rcsid = "$Id: cleanup.c,v 1.28.4.3 2005/01/29 20:10:11 crawdad Exp $";
 
204
static char *rcsid = "$Id: cleanup.c 3324 2007-04-05 15:45:25Z crawdad $";
196
205
 
197
206
#define EXTERN
198
207
#include "includes.h"
289
298
  chkpt_wt_nsymhf(n_so_typs);
290
299
  chkpt_wt_nmo(nmo);
291
300
 
292
 
  tmp_iopen = iopen;
293
 
  if (n_open && !uhf) {
294
 
    tmp_iopen = ioff[n_open];
295
 
    if(twocon) tmp_iopen = -tmp_iopen;
296
 
  }
 
301
  tmp_iopen = ioff[n_open];
 
302
  if(twocon) tmp_iopen = -tmp_iopen;
297
303
  chkpt_wt_iopen(tmp_iopen);
298
304
  nx = nmo*(nmo+1)/2;
299
305
   
376
382
  }
377
383
  else {
378
384
    for(k=0,row=0,col=0; k < num_ir; k++) {
 
385
      double** s_sq;
 
386
      double** tmp;
379
387
      s=&scf_info[k];
380
 
      for(i=0; i < s->num_so; i++) {
381
 
        for(j=0; j < s->num_mo; j++) {
382
 
          scr1[i+row][j+col] = s->cmat[i][j];
383
 
        }
 
388
      if (s->num_mo) {
 
389
        
 
390
        /* Test normalization of MOs */
 
391
        if (check_mo_orthonormality) {
 
392
          fprintf(outfile,"  -Testing orthonormality of MOs in symmetry block %d\n",k);
 
393
          fprintf(outfile,"    -overlap matrix:\n");
 
394
          print_array(s->smat,s->num_so,outfile);
 
395
          fprintf(outfile,"    -MOs:\n");
 
396
          print_mat(s->cmat,s->num_so,s->num_mo,outfile);
 
397
          s_sq = block_matrix(s->num_so,s->num_so);
 
398
          tri_to_sq(s->smat,s_sq,s->num_so);
 
399
          tmp = block_matrix(s->num_so,s->num_so);
 
400
          mmult(s_sq,0,s->cmat,0,tmp,0,s->num_so,s->num_so,s->num_so,0);
 
401
          mmult(s->cmat,1,tmp,0,s_sq,0,s->num_mo,s->num_so,s->num_mo,0);
 
402
          fprintf(outfile,"    -Ct.S.C:\n");
 
403
          print_mat(s_sq,s->num_mo,s->num_mo,outfile);
 
404
          free_block(s_sq);
 
405
          free_block(tmp);
 
406
        } 
 
407
        
 
408
        for(i=0; i < s->num_so; i++) {
 
409
          for(j=0; j < s->num_mo; j++) {
 
410
            scr1[i+row][j+col] = s->cmat[i][j];
 
411
          }
 
412
        }
 
413
        row += s->num_so;
 
414
        col += s->num_mo;
 
415
        
384
416
      }
385
 
      row += s->num_so;
386
 
      col += s->num_mo;
387
417
    }
388
418
    chkpt_wt_scf(scr1);
389
419
  }
487
517
          }
488
518
        }
489
519
      }
 
520
      free_matrix(scr1,nsfmax);
 
521
      free_matrix(scr2,nsfmax);
490
522
    }
491
523
       
492
524
    else {
556
588
  /*if(print & 1){
557
589
    print_mos_new();
558
590
    }*/
559
 
      
 
591
 
 
592
  /* TDC (04/04/07) -- some old cleanups */
 
593
  free(reference);
560
594
      
561
595
  fprintf(outfile,"\n%8cSCF total energy   = %20.12f\n",' ',etot);
562
596
      
674
708
 
675
709
double ssquare(void){
676
710
    
677
 
    int i,j,k,nn,n;
678
 
    int num_mo;
679
 
    double ss=0.0;
680
 
    double na=0;
681
 
    double nb=0;
682
 
    double nh=0;
683
 
    double nm=0;
684
 
    double **scr1,**scr2,**S;
685
 
    struct symm *s;
686
 
    
687
 
    scr1 = (double **)init_matrix(nsfmax,nsfmax);
688
 
    scr2 = (double **)init_matrix(nsfmax,nsfmax);
689
 
    
690
 
    /* Calculate the overlap matrix elements */
691
 
    
692
 
    for(i = 0;i < num_ir;i++){
693
 
        
694
 
        na += spin_info[0].scf_spin[i].noccup;
695
 
        nb += spin_info[1].scf_spin[i].noccup;
696
 
        
697
 
        s = &scf_info[i];
698
 
        if(nn = s->num_so){
699
 
            num_mo = s->num_mo;
700
 
            tri_to_sq(s->smat,scr1,nn);
701
 
            
702
 
            /* Transform the Overlap matrix to the MO basis */
703
 
            
704
 
            mmult(spin_info[0].scf_spin[i].cmat,1
705
 
                  ,scr1,0,scr2,0,num_mo,nn,nn,0);
706
 
            mmult(scr2,0,spin_info[1].scf_spin[i].cmat,0
707
 
                  ,scr1,0,num_mo,nn,num_mo,0);
708
 
            
709
 
            for(j = 0; j < spin_info[0].scf_spin[i].noccup; j++){
710
 
                for(k = 0;k < spin_info[1].scf_spin[i].noccup; k++){
711
 
                    ss -= scr1[j][k]*scr1[j][k];
712
 
                }
713
 
            }
 
711
  int i,j,k,nn,n;
 
712
  int num_mo;
 
713
  double ss=0.0;
 
714
  double na=0;
 
715
  double nb=0;
 
716
  double nm=0;
 
717
  double nh=0.0;
 
718
  double **scr1,**scr2,**S;
 
719
  struct symm *s;
 
720
    
 
721
  scr1 = (double **)init_matrix(nsfmax,nsfmax);
 
722
  scr2 = (double **)init_matrix(nsfmax,nsfmax);
 
723
    
 
724
  /* Calculate the overlap matrix elements */
 
725
    
 
726
  for(i = 0;i < num_ir;i++){
 
727
        
 
728
    na += spin_info[0].scf_spin[i].noccup;
 
729
    nb += spin_info[1].scf_spin[i].noccup;
 
730
        
 
731
    s = &scf_info[i];
 
732
    if(nn = s->num_so){
 
733
      num_mo = s->num_mo;
 
734
      tri_to_sq(s->smat,scr1,nn);
 
735
            
 
736
      /* Transform the Overlap matrix to the MO basis */
 
737
            
 
738
      mmult(spin_info[0].scf_spin[i].cmat,1,scr1,0,scr2,0,num_mo,nn,nn,0);
 
739
      mmult(scr2,0,spin_info[1].scf_spin[i].cmat,0,scr1,0,num_mo,nn,num_mo,0);
 
740
            
 
741
      for(j = 0; j < spin_info[0].scf_spin[i].noccup; j++){
 
742
        for(k = 0;k < spin_info[1].scf_spin[i].noccup; k++){
 
743
          ss -= scr1[j][k]*scr1[j][k];
714
744
        }
 
745
      }
715
746
    }
716
 
    
717
 
    
718
 
      /* Calculate the occupation part of the equation */
719
 
    
720
 
    nm = (na-nb)/2.0;
721
 
    nh = (nm*(nm+1))+nb;
 
747
  }
 
748
    
 
749
    
 
750
  /* Calculate the occupation part of the equation */
 
751
    
 
752
  nm = (na-nb)/2.0;
 
753
  nh = (nm*(nm+1))+nb;
722
754
        
723
 
    ss += (nm*(nm+1))+nb;
724
 
    
725
 
    free_matrix(scr1,nsfmax);
726
 
    free_matrix(scr2,nsfmax);
727
 
    
728
 
    return fabs(ss);
 
755
  ss += (nm*(nm+1))+nb;
 
756
    
 
757
  free_matrix(scr1,nsfmax);
 
758
  free_matrix(scr2,nsfmax);
 
759
    
 
760
  return fabs(ss);
729
761
}
730
762
 
731
763