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

« back to all changes in this revision

Viewing changes to src/bin/oeprop/get_nmo.c

  • Committer: Bazaar Package Importer
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2009-02-23 00:12:02 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20090223001202-rutldoy3dimfpesc
Tags: 3.4.0-1
* New upstream release.

[ Michael Banck ]
* debian/patches/01_DESTDIR.dpatch: Refreshed.
* debian/patches/02_FHS.dpatch: Removed, applied upstream.
* debian/patches/03_debian_docdir: Likewise.
* debian/patches/04_man.dpatch: Likewise.
* debian/patches/06_466828_fix_gcc_43_ftbfs.dpatch: Likewise.
* debian/patches/07_464867_move_executables: Fixed and refreshed.
* debian/patches/00list: Adjusted.
* debian/control: Improved description.
* debian/patches-held: Removed.
* debian/rules (install/psi3): Do not ship the ruby bindings for now.

[ Daniel Leidert ]
* debian/rules: Fix txtdir via DEB_MAKE_INSTALL_TARGET.
* debian/patches/01_DESTDIR.dpatch: Refreshed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
#define EXTERN
2
 
#include "includes.h"
3
 
#include "prototypes.h"
4
 
#include "globals.h"
5
 
 
6
 
void get_nmo()
7
 
{
8
 
  int i,k,l,count,dim_i;
9
 
  double *evals, *evals_symbl;
10
 
  double **nmo_mo, **nmo_symbl;
11
 
  double **b, **binv;           /* (C+)*C */
12
 
  double **cinv;                /* C_{AO}^-1 = C_{AO}^T S_{AO,AO} */
13
 
  double **tmat, **Smat;
14
 
  double **psq_ao, **p_symbl;
15
 
  
16
 
  nmo_ao = init_matrix(nbfao,nmo);
17
 
  nmo_so = block_matrix(nbfso,nmo); /* need block matrix for chkpt_wt_scf() */
18
 
  evals = init_array(nmo);
19
 
  nmo_mo = init_matrix(nmo,nmo);
20
 
  psq_ao = init_matrix(nbfao,nbfao);
21
 
 
22
 
  tri_to_sq(Ptot,psq_ao,nbfao);
23
 
 
24
 
  b = init_matrix(nmo,nmo);
25
 
  cinv = init_matrix(nmo, nbfao);
26
 
  tmat = init_matrix(nmo,nbfao);
27
 
  Smat = init_matrix(nbfao,nbfao);
28
 
  tri_to_sq(S,Smat,nbfao);
29
 
 
30
 
  mmult(scf_evec_ao,1,Smat,0,cinv,0,nmo,nbfao,nbfao,0);
31
 
 
32
 
  mmult(cinv,0,psq_ao,0,tmat,0,nmo,nbfao,nbfao,0);
33
 
  mmult(tmat,0,cinv,1,b,0,nmo,nbfao,nmo,0);
34
 
  free_matrix(cinv,nmo);
35
 
  free_matrix(tmat,nmo);
36
 
  free_matrix(Smat,nbfao);
37
 
 
38
 
  count = 0;
39
 
  for(i=0;i<nirreps;i++) {
40
 
    dim_i = orbspi[i];
41
 
    if (dim_i != 0) {
42
 
      p_symbl = init_matrix(dim_i,dim_i);
43
 
      evals_symbl = init_array(dim_i);
44
 
      nmo_symbl = init_matrix(dim_i,dim_i);
45
 
      for(k=0;k<dim_i;k++) {
46
 
        for(l=0;l<=k;l++) {
47
 
          p_symbl[k][l] = p_symbl[l][k] = b[count+k][count+l];
48
 
        }
49
 
      }
50
 
 
51
 
      if (print_lvl >= PRINTNMOLEVEL) {
52
 
        fprintf(outfile, "  Density Matrix for Symmetry Block %s\n",
53
 
                irr_labs[i]);
54
 
        print_mat(p_symbl,dim_i,dim_i,outfile);
55
 
        fprintf(outfile,"\n");
56
 
      }
57
 
 
58
 
      sq_rsp(dim_i,dim_i,p_symbl,evals_symbl,3,nmo_symbl,1.0E-14);
59
 
 
60
 
      for(k=0;k<dim_i;k++) {
61
 
        evals[count+k] = evals_symbl[k];
62
 
        for(l=0;l<dim_i;l++)
63
 
          nmo_mo[count+k][count+l] = nmo_symbl[k][l];
64
 
      }
65
 
      
66
 
      if (print_nos) {
67
 
        fprintf(outfile, 
68
 
          "  Natural Orbital Occupation Numbers for Symmetry Block %s\n\n",
69
 
          irr_labs[i]);
70
 
        for (k=0; k<dim_i; k++) {
71
 
          fprintf(outfile, "%5d  %f\n",k+1,evals_symbl[k]);
72
 
        }
73
 
        fprintf(outfile, "\n");
74
 
      }
75
 
 
76
 
      if (print_lvl >= PRINTNMOLEVEL) {
77
 
        fprintf(outfile, "  Natural Orbitals for Symmetry Block %s\n",
78
 
                irr_labs[i]);
79
 
        eivout(nmo_symbl,evals_symbl,dim_i,dim_i,outfile);
80
 
        fprintf(outfile, "\n");
81
 
      }
82
 
      free_matrix(p_symbl,dim_i);
83
 
      free_matrix(nmo_symbl,dim_i);
84
 
      free(evals_symbl);
85
 
      count += dim_i;
86
 
    }
87
 
  }
88
 
                            
89
 
  mmult(scf_evec_ao,0,nmo_mo,0,nmo_ao,0,nbfao,nmo,nmo,0);
90
 
  mmult(scf_evec_so,0,nmo_mo,0,nmo_so,0,nbfso,nmo,nmo,0);
91
 
 
92
 
 
93
 
  if (print_lvl >= PRINTNMOLEVEL) {
94
 
    fprintf(outfile,
95
 
            "  Natural orbitals in SO basis computed from density in file%d:\n",
96
 
            opdm_file);
97
 
    eivout(nmo_so,evals,nbfso,nmo,outfile);
98
 
    fprintf(outfile,"\n\n");
99
 
  }
100
 
 
101
 
  if (wrtnos) {
102
 
    chkpt_wt_scf(nmo_so);
103
 
    if (print_lvl >= 1)
104
 
      fprintf(outfile,
105
 
        "  Natural Orbitals have just been written to the checkpoint file\n\n");
106
 
  }
107
 
 
108
 
  free(evals);
109
 
  free_matrix(b,nmo);
110
 
  free_matrix(nmo_mo,nmo);
111
 
  free_block(nmo_so);
112
 
}