← Back to branch summary

~ubuntu-branches/ubuntu/saucy/nwchem/saucy

« back to all changes in this revision

Viewing changes to .pc/09_backported_6.1.1_fixes.patch/src/nwdft/so_dft/dft_scaleMO_so.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2012-09-13 14:35:37 UTC
  • Revision ID: package-import@ubuntu.com-20120913143537-5gkt1l68rxrprgnl
Tags: 6.1-4
[ Michael Banck ]
* debian/patches/09_backported_6.1.1_fixes.patch: New patch, backports the
  source code changes of the nwchem-6.1.1 bugfix release:
  + PW: Fixed backspace issues on file I/O that caused I/O errors.
  + DFT: Removed dummy and bq centers from the Grimme dispersion
    corrections.
  + DFT: Fixed a race condition in the density fitting code.
  + DFT: Added a check for singularities in the HCTH functionals.
  + DFT: Fixed a problem with the DFT grids which caused strange behaviors
    if the number of cores is so large that some cores do not get any grid
    points.
  + HF&DFT: Fixed rolling back to distributed memory Fock-builder if not
    enough memory is available to use the replicated data one. Previously
    the code would crash trying to use non-existing GAs.
  + HF&DFT: Fixed clashes between MPI and GA communication when using OpenIB
    which enhances the stability.
  + MP2&DFT: On systems with limited I/O capabilities some quantities like
    2-electron integrals and DFT grids are now stored in memory rather than
    on disk.
  + CASSCF: Added ga_sync to fix race conditions that can cause the Davidson
    diagonalizer to fail.
  + CASSCF: Fixed a problem with the phase in the Lagrangian that caused
    problems with the gradient evaluation.
  + RAMAN: A number of problems with static polarizabilities were fixed.
  + Property: Fixed an issue with add_patch that caused unexpected results
    with dynamic polarizabilities.
  + DRDY: Removed system calls to copy files avoiding forking from NWChem
    processes which is relatively likely to fail due to the resources
    attached to such a process.
  + Input: Fixed some issues with GEOM LOAD that caused the selection of
    centers to fail in some cases.
  + Geometry: Dummy centers are no longer removed from a geometry so that
    constraints involving those centers remain valid.
  + Memory: All shared memory (global memory region) is now allocated at the
    start.

[ Daniel Leidert ]
* debian/control: Added X-Python-Version.
  (Build-Depends): Added python-dev. Use texlive to fix manual build.
  (Standards-Version): Bumped to recent 3.9.3.
* debian/nwchem.1: Added.
* debian/nwchem.doc-base: Ditto.
* debian/nwchem.lintian-overrides: Ditto.
* debian/nwchem.manpages: Ditto.
* debian/nwchem-data.lintian-overrides: Ditto.
* debian/rules: Added PYTHONVERSION, PYTHONHOME. Enable parallel building.
  (NWCHEM_MODULES): Build with python support (pnnl).
* debian/patches/02_makefile_flags.patch: Adjusted.
  - src/config/makefile.h: Fix linker flags building with python support.

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/09_backported_6.1.1_fixes.patch/src/nwdft/so_dft/dft_scaleMO_so.F
 
1
       subroutine dft_scaleMO_so(rtdb,           ! IN
 
2
     &                           g_moso,         ! IN     : MO vectors
 
3
     &                           occ,            ! IN/OUt : occupancies
 
4
     &                           g_densso,       ! OUT    : spin-orbit density matrix
 
5
     &                           nbf_mo,         ! IN     : nr. basis functions
 
6
     &                           nTotOcc,        ! IN     : nr. occ
 
7
     &                           switch_sclMO_so)! OUT    : switch 1,0=ON,OFF
 
8
c      Purpose: Fractional occupation routine
 
9
c               entered from input script:
 
10
c               occupations nA nB
 
11
c               occA-1 occB-1
 
12
c               ...
 
13
c               occA-X  occB-nB
 
14
c               occA-nA
 
15
c      Author : Fredy Aquino
 
16
c      Date   : 02-15-11
 
17
       implicit none
 
18
#include "errquit.fh"
 
19
       integer rtdb
 
20
#include "mafdecls.fh"
 
21
#include "stdio.fh"
 
22
#include "rtdb.fh"
 
23
#include "global.fh"
 
24
#include "msgids.fh"
 
25
#include "util.fh"
 
26
       double precision occ(nbf_mo) ! occupancies
 
27
       integer switch_sclMO_so ! switch 1,0=ON,OFF scaling MOs
 
28
                               !                   with occupations
 
29
       integer g_densso(2)     ! spin-orbit density matrix
 
30
       integer scale_switch    ! input
 
31
       integer nbf_mo          ! input
 
32
       integer g_moso(2)       ! input/output
 
33
       integer g_moso1(2) ! scratch ga array
 
34
       integer i,ispin,iorb,iorb1,nTotOcc,nbf_ao
 
35
       logical status
 
36
       integer l_Iocc,k_Iocc,nfocc_in(2), 
 
37
     &         nfocc_tot,ind_min,ind_max               
 
38
       double precision ac_occ,             
 
39
     &                  diff_occ,error_Iocc 
 
40
       external dft_densm_so
 
41
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
42
c +++++++ test: occupations keyword -- FA-02-10-11 ++ START
 
43
c ---- FA-01-31-11 ----- check vars ---- START 
 
44
c +++++++ test reading from rtdb occupations settings +++ START
 
45
c       if (ga_nodeid().eq.0)
 
46
c    &    write(*,*) 'In dft_scaleMO:: BEF rtdb_get'
 
47
        status = rtdb_get(rtdb,'focc:occupations',
 
48
     &                    mt_int,2,nfocc_in)
 
49
        nfocc_tot=nfocc_in(1)+nfocc_in(2)
 
50
        if (status) then
 
51
c        if (ga_nodeid().eq.0) then  
 
52
c         write(*,7) nfocc_in(1),nfocc_in(2),nfocc_tot
 
53
c7        format('rtdb-check: nfocc=(',i4,',',i4,',',i4,')')
 
54
c        endif
 
55
        if (.not. ma_push_get(mt_dbl,nfocc_tot,'occup1',
 
56
     &                        l_Iocc,k_Iocc))
 
57
     &  call errquit('occ_input ma_push_get fail k_Iocc',
 
58
     &               0,MA_ERR)
 
59
        endif   
 
60
        status = rtdb_get(rtdb,'focc:occup list',
 
61
     &                    mt_dbl,nfocc_tot,
 
62
     &                    dbl_mb(k_Iocc))    
 
63
       if (status) then ! --- START-fracc-occ-routine
 
64
         do i=1,2
 
65
          if(.not.ga_create(mt_dbl,nbf_mo,nbf_mo,
 
66
     &                      'Movecs Re',0,0, 
 
67
     &                      g_moso1(i)))     
 
68
     &    call errquit('scaleMO_so: error creating Movecs Re',0,
 
69
     &                 GA_ERR)
 
70
          call ga_copy(g_moso(i),g_moso1(i))
 
71
         enddo
 
72
c       if (ga_nodeid().eq.0)
 
73
c    &    write(*,*) 'In dft_scaleMO:: AFT rtdb_get'
 
74
c ------- check nel=sum(n_i) + int_mb(k_nIocc+i-1) =[1,nbf_mo]---- START
 
75
      ac_occ=0.0d0
 
76
      do i=1,nfocc_tot
 
77
c      if (ga_nodeid().eq.0) then
 
78
c       write(*,118) i,dbl_mb(k_Iocc+i-1)
 
79
c118    format('focc(',i3,')=',f15.8)
 
80
c      endif
 
81
       ac_occ=ac_occ+dbl_mb(k_Iocc+i-1)
 
82
      enddo
 
83
      diff_occ=abs(nTotOcc*1.0d0-ac_occ)
 
84
c     if (ga_nodeid().eq.0) then
 
85
c       write(*,18) nfocc_tot,nTotOcc,ac_occ,diff_occ
 
86
c 18    format('(nfocc_tot,nTotOcc,ac_occ,diff_occ)=(',
 
87
c    &       i3,',',i3,',',f15.8,',',f15.8,')')
 
88
c     endif
 
89
      error_Iocc=1e-2
 
90
      if (diff_occ .gt. error_Iocc) then ! TRUE IF-commented for the moment
 
91
       write(*,*) 'Error in dft_scf_so:',
 
92
     &            ' occupations keyword problem: ',
 
93
     &            'ac_occ from occupations keyword',
 
94
     &            ' is not close to nTotOcc'
 
95
       write(*,191) nTotOcc,ac_occ,diff_occ,error_Iocc
 
96
  191  format('(nTotOcc,ac_occ,diff_occ,error_Iocc)=(',i4,',',f15.8,
 
97
     &        ',',f15.8,',',f15.8)
 
98
       stop
 
99
      else
 
100
c ---- Calculate Sqrt(n_i)
 
101
c      if (ga_nodeid().eq.0)
 
102
c    &    write(*,*) 'Calculating sqrt(n_i):'
 
103
       do i=1,nfocc_tot
 
104
c       if (ga_nodeid().eq.0) then
 
105
c        write(*,24) i,dbl_mb(k_Iocc+i-1),sqrt(dbl_mb(k_Iocc+i-1))
 
106
c24      format('(n_i,sqrt(n_i))(',i3,')=(',f15.8,',',f15.8,')')
 
107
c       endif
 
108
        dbl_mb(k_Iocc+i-1)=sqrt(dbl_mb(k_Iocc+i-1))
 
109
       enddo
 
110
      endif
 
111
c ------- check nel=sum(n_i) + int_mb(k_nIocc+i-1) =[1,nbf_mo]---- END
 
112
c      write(*,*) 'BEF-scaling check g_moso ---------- START'
 
113
c      call ga_print(g_moso(1))
 
114
c      call ga_print(g_moso(2))
 
115
c      write(*,*) 'BEF-scaling check g_moso ---------- END'
 
116
c      if (ga_nodeid().eq.0) then
 
117
c        write(*,*) 'BEF. updating occupations:'
 
118
         do i=1,nbf_mo
 
119
c         write(*,1) i,occ(i)
 
120
c 1       format('occ(',i3,')=',f15.8)
 
121
          occ(i)=0.0d0 ! reset occupations
 
122
         enddo
 
123
c      endif
 
124
        ind_min=2
 
125
        ind_max=1
 
126
        if (nfocc_in(1).lt.nfocc_in(2)) then
 
127
         ind_min=1 
 
128
         ind_max=2
 
129
        endif
 
130
      do ispin=1,2
 
131
       iorb=ispin
 
132
       do i=1,nfocc_in(ind_min)
 
133
c       if (ga_nodeid().eq.0) then
 
134
c        write(*,111) i,iorb,dbl_mb(k_Iocc+iorb-1)
 
135
c111     format('CHECK-RTDB-occ:occ(',i3,',',i3,')=',f15.8)
 
136
c       endif
 
137
        call ga_scale_patch(g_moso1(1),1,nbf_mo,iorb,iorb,
 
138
     &                      dbl_mb(k_Iocc+iorb-1))
 
139
        call ga_scale_patch(g_moso1(2),1,nbf_mo,iorb,iorb,
 
140
     &                      dbl_mb(k_Iocc+iorb-1))
 
141
        occ(iorb)=dbl_mb(k_Iocc+iorb-1)*dbl_mb(k_Iocc+iorb-1) ! update occ
 
142
        iorb=iorb+2
 
143
       enddo ! end-loop-i
 
144
      end do   ! ispin-loop   
 
145
c ---- Storing the unpaired electrons ---- START
 
146
        iorb=2*nfocc_in(ind_min)+1 
 
147
        iorb1=iorb
 
148
        if (nfocc_in(1).lt.nfocc_in(2)) then
 
149
         iorb1=iorb+1
 
150
        endif
 
151
        do i=1,nfocc_in(ind_max)-nfocc_in(ind_min)
 
152
c        if (ga_nodeid().eq.0) then
 
153
c         write(*,151) i,iorb,iorb1,dbl_mb(k_Iocc+iorb-1)
 
154
c151      format('CHECK-RTDB-occ:occ-1(',
 
155
c    &           i3,',',i3,',',i3,')=',f15.8)
 
156
c        endif
 
157
         call ga_scale_patch(g_moso1(1),1,nbf_mo,iorb1,iorb1,
 
158
     &                       dbl_mb(k_Iocc+iorb-1))
 
159
         call ga_scale_patch(g_moso1(2),1,nbf_mo,iorb1,iorb1,
 
160
     &                       dbl_mb(k_Iocc+iorb-1))
 
161
         occ(iorb1)=dbl_mb(k_Iocc+iorb-1)*dbl_mb(k_Iocc+iorb-1) ! update occ -unpaired electron
 
162
         iorb=iorb+1
 
163
         iorb1=iorb1+2
 
164
        enddo ! end-loop-i
 
165
c ---- Storing the unpaired electrons ---- END
 
166
c ---- Calculate spin-orbit density matrix
 
167
       nbf_ao=nbf_mo/2
 
168
c      if (ga_nodeid().eq.0)
 
169
c    &  write(*,*) 'nbf_ao=',nbf_ao
 
170
       call dft_densm_so(g_densso,g_moso1,nbf_ao,nTotOcc)    
 
171
c----- Update occupations ----------- START
 
172
c      if (ga_nodeid().eq.0) then
 
173
c        write(*,*) 'AFT. updating occupations:'
 
174
c        do i=1,nbf_mo
 
175
c         write(*,2) i,occ(i)
 
176
c 2       format('occ(',i3,')=',f15.8)
 
177
c        enddo
 
178
c      endif
 
179
c----- Update occupations ----------- END
 
180
c ----- Free memory
 
181
          if (.not.ma_pop_stack(l_Iocc)) call
 
182
     &    errquit('dft_scaleMO_so: ma_pop_stack l_Iocc',0, MA_ERR)
 
183
        do i=1,2
 
184
          if (.not. ga_destroy(g_moso1(i))) 
 
185
     &       call errquit
 
186
     &       ('scaleMO_so: could not destroy g_moso_tmp',
 
187
     &        0, GA_ERR)
 
188
        enddo
 
189
        switch_sclMO_so=1 ! set ON
 
190
       endif ! --- END-fracc-occ-routine
 
191
       return
 
192
       end
 
193
c $Id: dft_scaleMO_so.F 21176 2011-10-10 06:35:49Z d3y133 $