← Back to branch summary

~ubuntu-branches/ubuntu/utopic/nwchem/utopic

« back to all changes in this revision

Viewing changes to src/nwdft/rt_tddft/init/rt_tddft_init_overlap_canorg.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Daniel Leidert, Andreas Tille, Michael Banck
  • Date: 2013-07-04 12:14:55 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130704121455-5tvsx2qabor3nrui
Tags: 6.3-1
http://bugs.debian.org/696361
* New upstream release.
* Fixes anisotropic properties (Closes: #696361).
* New features include:
  + Multi-reference coupled cluster (MRCC) approaches
  + Hybrid DFT calculations with short-range HF 
  + New density-functionals including Minnesota (M08, M11) and HSE hybrid
    functionals
  + X-ray absorption spectroscopy (XAS) with TDDFT
  + Analytical gradients for the COSMO solvation model
  + Transition densities from TDDFT 
  + DFT+U and Electron-Transfer (ET) methods for plane wave calculations
  + Exploitation of space group symmetry in plane wave geometry optimizations
  + Local density of states (LDOS) collective variable added to Metadynamics
  + Various new XC functionals added for plane wave calculations, including
    hybrid and range-corrected ones
  + Electric field gradients with relativistic corrections 
  + Nudged Elastic Band optimization method
  + Updated basis sets and ECPs 

[ Daniel Leidert ]
* debian/watch: Fixed.

[ Andreas Tille ]
* debian/upstream: References

[ Michael Banck ]
* debian/upstream (Name): New field.
* debian/patches/02_makefile_flags.patch: Refreshed.
* debian/patches/06_statfs_kfreebsd.patch: Likewise.
* debian/patches/07_ga_target_force_linux.patch: Likewise.
* debian/patches/05_avoid_inline_assembler.patch: Removed, no longer needed.
* debian/patches/09_backported_6.1.1_fixes.patch: Likewise.
* debian/control (Build-Depends): Added gfortran-4.7 and gcc-4.7.
* debian/patches/10_force_gcc-4.7.patch: New patch, explicitly sets
  gfortran-4.7 and gcc-4.7, fixes test suite hang with gcc-4.8 (Closes:
  #701328, #713262).
* debian/testsuite: Added tests for COSMO analytical gradients and MRCC.
* debian/rules (MRCC_METHODS): New variable, required to enable MRCC methods.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/nwdft/rt_tddft/init/rt_tddft_init_overlap_canorg.F
 
1
C
 
2
C     rt_tddft_init_overlap_canorg.F
 
3
C
 
4
C     Initialize overlap matrix and find eigenvalues, then initialize
 
5
C     canonical orthogonalization.
 
6
C
 
7
C
 
8
      subroutine rt_tddft_init_overlap_canorg (params)
 
9
      implicit none
 
10
 
 
11
#include "errquit.fh"
 
12
#include "mafdecls.fh"
 
13
#include "stdio.fh"
 
14
#include "global.fh"
 
15
#include "msgids.fh"
 
16
#include "rtdb.fh"
 
17
#include "bas.fh"
 
18
#include "cdft.fh"
 
19
#include "rt_tddft.fh"
 
20
 
 
21
 
 
22
C     == In/out ==
 
23
      type(rt_params_t), intent(inout) ::  params  !geom params stored in here
 
24
 
 
25
      
 
26
C     == Parameters ==
 
27
      character(*), parameter :: pname =
 
28
     $     "rt_tddft_init_overlap_canorg: "
 
29
 
 
30
      
 
31
C     == External ==
 
32
      integer  ga_create_atom_blocked
 
33
      external ga_create_atom_blocked
 
34
 
 
35
      
 
36
C     == Variables ==
 
37
      integer me
 
38
      integer g_s, g_svecs
 
39
      integer isvals, lsvals
 
40
      logical atmblk
 
41
 
 
42
C     (tmp)
 
43
      double precision toll_s
 
44
      integer n_dep
 
45
C      integer g_scr, g_s12, g_sn12
 
46
 
 
47
 
 
48
 
 
49
      me = ga_nodeid ()
 
50
 
 
51
 
 
52
C
 
53
C     Build overlap matrix (ripped from dft_main0d)
 
54
C     
 
55
      if (.not. rtdb_get(params%rtdb, 'dft:atomblock',mt_log,1,atmblk))
 
56
     &     atmblk=.true.
 
57
 
 
58
      if(atmblk) then
 
59
         g_s = ga_create_atom_blocked(geom, AO_bas_han, 'AO ovl')
 
60
      else
 
61
         if (.not. ga_create(mt_dbl, nbf_ao, nbf_ao, 'AO ovl',
 
62
     &        0, 0, g_s))
 
63
     &        call errquit(pname//'Error creating ga',0,GA_ERR)
 
64
      endif
 
65
      
 
66
      call ga_zero(g_s)
 
67
      
 
68
      if (.not.MA_Push_Get(MT_Dbl, nbf_ao, 'ovl eig vals', lsvals, 
 
69
     &   isvals))
 
70
     &   call errquit(pname//'Cannot allocate ovl eig vals', 0,
 
71
     &       MA_ERR)
 
72
      
 
73
      call dfill(nbf_ao, 0.0d0, dbl_mb(isvals), 1)
 
74
      
 
75
      call int_1e_ga(AO_bas_han, AO_bas_han, g_s, 'overlap', oskel)
 
76
      if (oskel) call sym_symmetrize(geom, AO_bas_han, .false., g_s)
 
77
 
 
78
      
 
79
C     
 
80
C     Diagonalize overlap (partially ripped from dft_main0d).  We just
 
81
C     use the stock diagonalizer.
 
82
C     
 
83
      if (.not. ga_duplicate(g_s, g_svecs, 'AO ovl eig vecs'))
 
84
     &     call errquit(pname//'Error creating ga',0,GA_ERR)
 
85
      call ga_zero(g_svecs)
 
86
 
 
87
CXXX  [KAL]: valrgrind picking up unintialized values when using parallel diag routine??      
 
88
C      call ga_diag_std(g_s, g_svecs, Dbl_MB(isvals))
 
89
      call ga_diag_std_seq (g_s, g_svecs, Dbl_MB(isvals))
 
90
 
 
91
 
 
92
C
 
93
C     Now that we have the overlap eigenvalues/vectors, initialize
 
94
C     canonical orthogonalization.  This will set the value of
 
95
C     params%nbf_mo.
 
96
C      
 
97
      call canorg_init (params, dbl_mb(isvals), g_svecs)
 
98
 
 
99
 
 
100
C
 
101
C     Store overlap for future use and destroy eigenvals/vecs.
 
102
C
 
103
      params%g_s = g_s
 
104
 
 
105
 
 
106
C     XXX TMP XXX
 
107
c$$$      if (.not. ga_duplicate (g_s, g_scr, "scr"))
 
108
c$$$     $     call errquit (pname//"failed to create scr",0,0)
 
109
c$$$
 
110
c$$$      if (.not. ga_duplicate (g_s, g_s12, "s12"))
 
111
c$$$     $     call errquit (pname//"failed to create s12",0,0)
 
112
c$$$
 
113
c$$$      if (.not. ga_duplicate (g_s, g_sn12, "sn12"))
 
114
c$$$     $     call errquit (pname//"failed to create sn12",0,0)
 
115
 
 
116
      
 
117
      call util_tolls (params%rtdb, .false., toll_s,
 
118
     $     n_dep, dbl_mb(isvals), params%nbf_ao)
 
119
 
 
120
 
 
121
C     S^{-1/2}
 
122
c$$$      call ga_zero (g_scr)
 
123
c$$$      call diis_bld12_so(toll_s, dbl_mb(isvals), g_svecs, g_sn12, 
 
124
c$$$     &     g_scr, nbf_ao, 2)
 
125
 
 
126
C     S^{1/2}
 
127
c$$$      call ga_zero (g_scr)
 
128
c$$$      call diis_bld12_so(toll_s, dbl_mb(isvals), g_svecs, g_s12, 
 
129
c$$$     &     g_scr, nbf_ao, 3)
 
130
 
 
131
 
 
132
C      params%g_s12 = g_s12
 
133
C      params%g_sn12 = g_sn12
 
134
 
 
135
 
 
136
      if (.not. ga_destroy (g_svecs))
 
137
     $     call errquit (pname//"Failed to destroy Svecs", 0, 0)
 
138
 
 
139
c$$$      if (.not. ga_destroy (g_scr))
 
140
c$$$     $     call errquit (pname//"Failed to destroy scr", 0, 0)
 
141
 
 
142
      if (.not.ma_pop_stack(lsvals))
 
143
     $     call errquit(pname//'cannot pop stack',0, MA_ERR)
 
144
 
 
145
      end subroutine
 
146
 
 
147
 
 
148
 
 
149
 
 
150
 
 
151
 
 
152
 
 
153
 
 
154
CXXX  [KAL]: EXPERIMENTAL SO ROUTINE
 
155
 
 
156
      subroutine rt_tddft_init_overlap_canorg_new (params)
 
157
      implicit none
 
158
 
 
159
#include "errquit.fh"
 
160
#include "mafdecls.fh"
 
161
#include "stdio.fh"
 
162
#include "global.fh"
 
163
#include "msgids.fh"
 
164
#include "rtdb.fh"
 
165
#include "bas.fh"
 
166
#include "cdft.fh"
 
167
#include "rt_tddft.fh"
 
168
 
 
169
 
 
170
C     == In/out ==
 
171
      type(rt_params_t), intent(inout) ::  params  !geom params stored in here
 
172
 
 
173
      
 
174
C     == Parameters ==
 
175
      character(*), parameter :: pname =
 
176
     $     "rt_tddft_init_overlap_canorg: "
 
177
 
 
178
      
 
179
C     == External ==
 
180
      integer  ga_create_atom_blocked
 
181
      external ga_create_atom_blocked
 
182
 
 
183
      
 
184
C     == Variables ==
 
185
      integer me
 
186
      integer g_s, g_svecs, g_s_super
 
187
      integer isvals, lsvals
 
188
      logical atmblk
 
189
      integer i
 
190
 
 
191
 
 
192
      me = ga_nodeid ()
 
193
 
 
194
 
 
195
C
 
196
C     Build overlap matrix (ripped from dft_main0d)
 
197
C     note "geom" (active geometry) is in common block
 
198
C     
 
199
      if (.not. rtdb_get(params%rtdb, 'dft:atomblock',mt_log,1,atmblk))
 
200
     &     atmblk=.true.
 
201
 
 
202
      if(atmblk) then
 
203
         g_s = ga_create_atom_blocked(geom, AO_bas_han, 'AO ovl')
 
204
      else
 
205
         if (.not. ga_create(mt_dbl, nbf_ao, nbf_ao, 'AO ovl',
 
206
     &        0, 0, g_s))
 
207
     &        call errquit(pname//'Error creating ga',0,GA_ERR)
 
208
      endif
 
209
      
 
210
      call ga_zero(g_s)
 
211
      
 
212
      call int_1e_ga(AO_bas_han, AO_bas_han, g_s, 'overlap', oskel)
 
213
      if (oskel) call sym_symmetrize(geom, AO_bas_han, .false., g_s)
 
214
 
 
215
 
 
216
C     (note 2*nbf_ao)
 
217
      if (.not.MA_Push_Get(MT_Dbl, 2*nbf_ao, 'ovl eig vals', lsvals, 
 
218
     &   isvals))
 
219
     &   call errquit(pname//'Cannot allocate ovl eig vals', 0,
 
220
     &       MA_ERR)
 
221
      
 
222
      call dfill(2*nbf_ao, 0.0d0, dbl_mb(isvals), 1)
 
223
 
 
224
 
 
225
 
 
226
C
 
227
C     Upconvert overlap matrix to supermatrix form:
 
228
C
 
229
C     [ S 0 ]
 
230
C     [ 0 S ]
 
231
C
 
232
C      call rt_tddft_so_upconvert (params, g_s)
 
233
 
 
234
      if (.not. ga_create(mt_dbl, 2*nbf_ao, 2*nbf_ao, 'AO ovl (super)',
 
235
     &     0, 0, g_s_super))
 
236
     &     call errquit(pname//'Error creating g_s_super',0,GA_ERR)
 
237
      
 
238
      call ga_zero (g_s_super)
 
239
 
 
240
      
 
241
C     (top left)
 
242
      call ga_dadd_patch (
 
243
     $     1d0, g_s, 1, nbf_ao, 1, nbf_ao,
 
244
     $     1d0, g_s_super, 1, nbf_ao, 1, nbf_ao,
 
245
     $     g_s_super, 1, nbf_ao, 1, nbf_ao)
 
246
 
 
247
 
 
248
C     (bottom right)
 
249
      call ga_dadd_patch (
 
250
     $     1d0, g_s, 1, nbf_ao, 1, nbf_ao,
 
251
     $     1d0, g_s_super, nbf_ao+1, 2*nbf_ao, nbf_ao+1, 2*nbf_ao,
 
252
     $     g_s_super, nbf_ao+1, 2*nbf_ao, nbf_ao+1, 2*nbf_ao)
 
253
 
 
254
      
 
255
      
 
256
C     
 
257
C     Diagonalize the super overlap (partially ripped from dft_main0d).
 
258
C     We just use the stock diagonalizer.
 
259
C     
 
260
      if (.not. ga_duplicate(g_s_super, g_svecs, 'AO ovl eig vecs'))
 
261
     &     call errquit(pname//'Error creating ga',0,GA_ERR)
 
262
      call ga_zero(g_svecs)
 
263
 
 
264
CXXX  [KAL]: valrgrind picking up unintialized values when using parallel diag routine??      
 
265
C      call ga_diag_std(g_s, g_svecs, Dbl_MB(isvals))
 
266
      call ga_diag_std_seq (g_s_super, g_svecs, Dbl_MB(isvals))
 
267
 
 
268
 
 
269
C
 
270
C     Now that we have the overlap eigenvalues/vectors, initialize
 
271
C     canonical orthogonalization.  This will set the value of
 
272
C     params%nbf_mo.
 
273
C      
 
274
C      call canorg_init (params, dbl_mb(isvals), g_svecs)
 
275
C      XXX MAKE NEW CANORG WHICH TAKES SUPER MATS AND DOESNT UPCONVERT
 
276
 
 
277
      call ga_print (g_svecs)
 
278
 
 
279
      do i = 1, 2*nbf_ao
 
280
         if (ga_nodeid().eq.0) then
 
281
            write (6,*) i, dbl_mb(isvals+i-1)
 
282
         endif
 
283
      enddo
 
284
      
 
285
      call halt ()
 
286
 
 
287
C      call canorg_init_new (params, dbl_mb(isvals), g_svecs)
 
288
 
 
289
 
 
290
      
 
291
C
 
292
C     Store overlap for future use and destroy eigenvals/vecs.
 
293
C
 
294
      params%g_s = g_s_super
 
295
 
 
296
      if (.not. ga_destroy (g_svecs))
 
297
     $     call errquit (pname//"Failed to destroy Svecs", 0, 0)
 
298
 
 
299
      if (.not.ma_pop_stack(lsvals))
 
300
     &     call errquit(pname//'cannot pop stack',0, MA_ERR)
 
301
 
 
302
      end subroutine
 
303
 
 
304