← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/ccsd/ccsd_zitf.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/ccsd/ccsd_zitf.F
1
 
      subroutine ccsd_zitf(basis,nsh,ncor,nocc,nvir,nact,nbf,
2
 
     &                     t1,z1,hiu,giu,habe,gabe,hia,hz1,
3
 
     &                    idiis,cmo,eorb,iprt,
4
 
     &                    g_t2,g_z2,g_hz2,g_ncoul,g_nexch,tklst)
5
 
C     $Id: ccsd_zitf.F 19708 2010-10-29 18:04:21Z d3y133 $
6
 
      implicit none
7
 
#include "errquit.fh"
8
 
      integer basis,nsh,ncor,nocc,nvir,nact,nbf,
9
 
     &        idiis,iprt,g_t2,g_z2,g_hz2
10
 
      double precision cmo(*),eorb(*),t1(*),hiu(*),giu(*),habe(*),
11
 
     &                 gabe(*),hz1(*),hia(*),z1(*)
12
 
#include "mafdecls.fh"
13
 
#include "bas.fh"
14
 
#include "global.fh"
15
 
#include "ccsd_debug.fh"
16
 
c
17
 
      integer lnov,g_nt2,g_nz2,g_nhz2,offt2,lnoov,g_jlo,g_jhi,
18
 
     &        g_ilo,g_ihi,a,i,j,b,ad1,ad2,lnoo,
19
 
     &        l_sa,k_sa,l_sb,k_sb,lsab,
20
 
     &        g_ncoul,g_nexch,tklst(nsh*(nsh+1)/2,2)
21
 
      double precision tol2e
22
 
      logical stat
23
 
      Integer IAm
24
 
c
25
 
      IAM = GA_NodeID()
26
 
C
27
 
      lnoo=nocc*nocc
28
 
      lnov=nocc*nvir
29
 
      lnoov=nocc*nocc*nvir
30
 
      tol2e=1.0d-12
31
 
      offt2=(idiis-1)*lnoov
32
 
c
33
 
      lsab=max(lnoov,nbf*nbf)
34
 
      stat=.true.
35
 
      stat=stat.and.ma_push_get(MT_DBL,lsab,'sa',l_sa, k_sa)
36
 
      stat=stat.and.ma_push_get(MT_DBL,lsab,'sb',l_sb, k_sb)
37
 
      if (.not.stat)call errquit('ma_push zitf ',0, MA_ERR)
38
 
c
39
 
c ------------------------------------------------------------
40
 
c create new GAs with proposed final ordering
41
 
c ------------------------------------------------------------
42
 
      if (.not.ga_create(MT_DBL,lnov,lnov,'nt2',
43
 
     &                   nvir,nvir,g_nt2))
44
 
     &     call errquit('ga_create g_nt2 failed',0, GA_ERR)
45
 
      if (.not.ga_create(MT_DBL,lnov,lnov,'nz2',
46
 
     &                   nvir,nvir,g_nz2))
47
 
     &     call errquit('ga_create g_nz2 failed',0, GA_ERR)
48
 
      if (.not.ga_create(MT_DBL,lnov,lnov,'nhz2',
49
 
     &                   nvir,nvir,g_nhz2))
50
 
     &     call errquit('ga_create g_nhz2 failed',0, GA_ERR)
51
 
 
52
 
c ------------------------------------------------------------
53
 
c fill new GAs
54
 
c ------------------------------------------------------------
55
 
      call ga_distribution(g_t2,iam,g_jlo,g_jhi,g_ilo,g_ihi)
56
 
      do a=1,nvir
57
 
        if (a.ge.g_ilo.and.a.le.g_ihi)then
58
 
          call ga_get(g_t2,1,lnoov,a,a,
59
 
     &                 dbl_mb(k_sa),lnoov)
60
 
          do i=1,nocc
61
 
            do j=1,nocc
62
 
              do b=1,nvir
63
 
                ad1=k_sa+(b-1)*lnoo+(i-1)*nocc+j-1
64
 
                ad2=k_sb+(j-1)*nvir+b-1
65
 
                dbl_mb(ad2)=dbl_mb(ad1)
66
 
              enddo
67
 
            enddo
68
 
            ad1=(i-1)*nvir+a
69
 
            call ga_put(g_nt2,1,lnov,ad1,ad1,dbl_mb(k_sb),lnov)
70
 
          enddo
71
 
        endif
72
 
      enddo
73
 
c
74
 
      call ga_distribution(g_z2,iam,g_jlo,g_jhi,g_ilo,g_ihi)
75
 
      do a=1,nvir
76
 
        if (a.ge.g_ilo.and.a.le.g_ihi)then
77
 
          call ga_get(g_z2,offt2+1,offt2+lnoov,a,a,
78
 
     &                 dbl_mb(k_sa),lnoov)
79
 
          do i=1,nocc
80
 
            do j=1,nocc
81
 
              do b=1,nvir
82
 
                ad1=k_sa+(b-1)*lnoo+(i-1)*nocc+j-1
83
 
                ad2=k_sb+(j-1)*nvir+b-1
84
 
                dbl_mb(ad2)=dbl_mb(ad1)
85
 
              enddo
86
 
            enddo
87
 
            ad1=(i-1)*nvir+a
88
 
            call ga_put(g_nz2,1,lnov,ad1,ad1,dbl_mb(k_sb),lnov)
89
 
          enddo
90
 
        endif
91
 
      enddo
92
 
c
93
 
      call ga_zero(g_nhz2)
94
 
c
95
 
      call ccsd_pzamp(basis,nsh,ncor,nocc,nvir,nact,nbf,
96
 
     &                 tol2e,cmo,eorb,iprt,hiu,giu,habe,gabe,hia,
97
 
     &                 t1,z1,hz1,idiis,g_nt2,g_nz2,g_nhz2,
98
 
     &                 g_ncoul,g_nexch,tklst)
99
 
c
100
 
      call ga_distribution(g_hz2,iam,g_jlo,g_jhi,g_ilo,g_ihi)
101
 
      do a=1,nvir
102
 
        if (a.ge.g_ilo.and.a.le.g_ihi)then
103
 
          do i=1,nocc
104
 
            ad1=(i-1)*nvir+a
105
 
            call ga_get(g_nhz2,1,lnov,ad1,ad1,dbl_mb(k_sb),lnov)
106
 
            do j=1,nocc
107
 
              do b=1,nvir
108
 
                ad1=k_sa+(b-1)*lnoo+(i-1)*nocc+j-1
109
 
                ad2=k_sb+(j-1)*nvir+b-1
110
 
                dbl_mb(ad1)=dbl_mb(ad2)
111
 
              enddo
112
 
            enddo
113
 
          enddo
114
 
          call ga_acc(g_hz2,offt2+1,offt2+lnoov,a,a,
115
 
     &                 dbl_mb(k_sa),lnoov,1.0d00)
116
 
        endif
117
 
      enddo
118
 
c
119
 
      if (.not.ga_destroy(g_nhz2))
120
 
     &    call errquit('ga_dest g_nhz2 fail',0, GA_ERR)
121
 
      if (.not.ga_destroy(g_nz2))
122
 
     &    call errquit('ga_dest g_nz2 fail',0, GA_ERR)
123
 
      if (.not.ga_destroy(g_nt2))
124
 
     &    call errquit('ga_dest g_nt2 fail',0, GA_ERR)
125
 
      stat=.true.
126
 
      stat=stat.and.ma_pop_stack(l_sb)
127
 
      stat=stat.and.ma_pop_stack(l_sa)
128
 
      if (.not.stat)call errquit('ma_pop zitf ',0, MA_ERR)
129
 
c
130
 
      return
131
 
      end