← Back to branch summary

~ubuntu-branches/ubuntu/trusty/nwchem/trusty-proposed

« back to all changes in this revision

Viewing changes to src/tce/mrcc/ccsd/T2_C2_1.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/tce/mrcc/ccsd/T2_C2_1.F
 
1
      SUBROUTINE T2_C2_1a(d_i0,d_t1,k_i0_offset,k_t1_offset,
 
2
     1coef)
 
3
C     $Id: tce.py,v 1.10 2002/12/01 21:37:34 sohirata Exp $
 
4
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
 
5
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
 
6
C     i0 ( p3 p4 h1 h2 )_tt + = 1/2 * P( 4 ) * t ( p3 h1 )_t * t ( p4 h2 )_t
 
7
      IMPLICIT NONE
 
8
#include "global.fh"
 
9
#include "mafdecls.fh"
 
10
#include "util.fh"
 
11
#include "errquit.fh"
 
12
#include "tce.fh"
 
13
      INTEGER d_i0
 
14
      INTEGER k_i0_offset
 
15
      INTEGER d_t1
 
16
      INTEGER k_t1_offset
 
17
      double precision coef
 
18
      CALL T2_C2_1_1a(d_t1,k_t1_offset,d_t1,k_t1_offset,d_i0,
 
19
     1 k_i0_offset,coef)
 
20
      RETURN
 
21
      END
 
22
      SUBROUTINE T2_C2_1_1a(d_a,k_a_offset,d_b,k_b_offset,d_c,
 
23
     1k_c_offset, coef)
 
24
C     $Id: tce.py,v 1.10 2002/12/01 21:37:34 sohirata Exp $
 
25
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
 
26
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
 
27
C     i0 ( p3 p4 h1 h2 )_tt + = 1/2 * P( 4 ) * t ( p3 h1 )_t * t ( p4 h2 )_t
 
28
      IMPLICIT NONE
 
29
#include "global.fh"
 
30
#include "mafdecls.fh"
 
31
#include "sym.fh"
 
32
#include "errquit.fh"
 
33
#include "tce.fh"
 
34
      double precision coef
 
35
      INTEGER d_a
 
36
      INTEGER k_a_offset
 
37
      INTEGER d_b
 
38
      INTEGER k_b_offset
 
39
      INTEGER d_c
 
40
      INTEGER k_c_offset
 
41
      INTEGER NXTASK
 
42
      INTEGER next
 
43
      INTEGER nprocs
 
44
      INTEGER count
 
45
      INTEGER p3b
 
46
      INTEGER p4b
 
47
      INTEGER h1b
 
48
      INTEGER h2b
 
49
      INTEGER dimc
 
50
      INTEGER l_c_sort
 
51
      INTEGER k_c_sort
 
52
      INTEGER p3b_1
 
53
      INTEGER h1b_1
 
54
      INTEGER p4b_2
 
55
      INTEGER h2b_2
 
56
      INTEGER dim_common
 
57
      INTEGER dima_sort
 
58
      INTEGER dima
 
59
      INTEGER dimb_sort
 
60
      INTEGER dimb
 
61
      INTEGER l_a_sort
 
62
      INTEGER k_a_sort
 
63
      INTEGER l_a
 
64
      INTEGER k_a
 
65
      INTEGER l_b_sort
 
66
      INTEGER k_b_sort
 
67
      INTEGER l_b
 
68
      INTEGER k_b
 
69
      INTEGER l_c
 
70
      INTEGER k_c
 
71
      EXTERNAL NXTASK
 
72
      nprocs = GA_NNODES()
 
73
      count = 0
 
74
      next = NXTASK(nprocs,1)
 
75
      DO p3b = noab+1,noab+nvab
 
76
      DO p4b = noab+1,noab+nvab
 
77
      DO h1b = 1,noab
 
78
      DO h2b = 1,noab
 
79
      IF (next.eq.count) THEN
 
80
      IF ((.not.restricted).or.(int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1
 
81
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+h2b-1).ne.8)) THEN
 
82
      IF (int_mb(k_spin+p3b-1)+int_mb(k_spin+p4b-1) .eq. int_mb(k_spin+h
 
83
     &1b-1)+int_mb(k_spin+h2b-1)) THEN
 
84
      IF (ieor(int_mb(k_sym+p3b-1),ieor(int_mb(k_sym+p4b-1),ieor(int_mb(
 
85
     &k_sym+h1b-1),int_mb(k_sym+h2b-1)))) .eq. ieor(irrep_t,irrep_t)) TH
 
86
     &EN
 
87
      dimc = int_mb(k_range+p3b-1) * int_mb(k_range+p4b-1) * int_mb(k_ra
 
88
     &nge+h1b-1) * int_mb(k_range+h2b-1)
 
89
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c_sort,k_c_sort)) CALL
 
90
     & ERRQUIT('T2_C2_1_1',0,MA_ERR)
 
91
      CALL DFILL(dimc,0.0d0,dbl_mb(k_c_sort),1)
 
92
      IF (int_mb(k_spin+p3b-1) .eq. int_mb(k_spin+h1b-1)) THEN
 
93
      IF (ieor(int_mb(k_sym+p3b-1),int_mb(k_sym+h1b-1)) .eq. irrep_t) TH
 
94
     &EN
 
95
      CALL TCE_RESTRICTED_2(p3b,h1b,p3b_1,h1b_1)
 
96
      CALL TCE_RESTRICTED_2(p4b,h2b,p4b_2,h2b_2)
 
97
      dim_common = 1
 
98
      dima_sort = int_mb(k_range+p3b-1) * int_mb(k_range+h1b-1)
 
99
      dima = dim_common * dima_sort
 
100
      dimb_sort = int_mb(k_range+p4b-1) * int_mb(k_range+h2b-1)
 
101
      dimb = dim_common * dimb_sort
 
102
      IF ((dima .gt. 0) .and. (dimb .gt. 0)) THEN
 
103
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL
 
104
     & ERRQUIT('T2_C2_1_1',1,MA_ERR)
 
105
      IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT('
 
106
     &T2_C2_1_1',2,MA_ERR)
 
107
      CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(h1b_1
 
108
     & - 1 + noab * (p3b_1 - noab - 1)))
 
109
      CALL TCE_SORT_2(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+p3b-1)
 
110
     &,int_mb(k_range+h1b-1),2,1,1.0d0)
 
111
      IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('T2_C2_1_1',3,MA_ERR)
 
112
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b_sort,k_b_sort)) CALL
 
113
     & ERRQUIT('T2_C2_1_1',4,MA_ERR)
 
114
      IF (.not.MA_PUSH_GET(mt_dbl,dimb,'noname',l_b,k_b)) CALL ERRQUIT('
 
115
     &T2_C2_1_1',5,MA_ERR)
 
116
      CALL GET_HASH_BLOCK(d_b,dbl_mb(k_b),dimb,int_mb(k_b_offset),(h2b_2
 
117
     & - 1 + noab * (p4b_2 - noab - 1)))
 
118
      CALL TCE_SORT_2(dbl_mb(k_b),dbl_mb(k_b_sort),int_mb(k_range+p4b-1)
 
119
     &,int_mb(k_range+h2b-1),2,1,1.0d0)
 
120
      IF (.not.MA_POP_STACK(l_b)) CALL ERRQUIT('T2_C2_1_1',6,MA_ERR)
 
121
      CALL DGEMM('T','N',dima_sort,dimb_sort,dim_common,1.0d0,dbl_mb(k_a
 
122
     &_sort),dim_common,dbl_mb(k_b_sort),dim_common,1.0d0,dbl_mb(k_c_sor
 
123
     &t),dima_sort)
 
124
      IF (.not.MA_POP_STACK(l_b_sort)) CALL ERRQUIT('T2_C2_1_1',7,MA_ERR
 
125
     &)
 
126
      IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('T2_C2_1_1',8,MA_ERR
 
127
     &)
 
128
      END IF
 
129
      END IF
 
130
      END IF
 
131
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT('
 
132
     &T2_C2_1_1',9,MA_ERR)
 
133
      IF ((p3b .le. p4b) .and. (h1b .le. h2b)) THEN
 
134
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
 
135
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
 
136
     &,4,2,3,1,coef/2.0d0)
 
137
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
 
138
     & 1 + noab * (h1b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
 
139
     & - 1)))))
 
140
      END IF
 
141
      IF ((p3b .le. p4b) .and. (h2b .le. h1b)) THEN
 
142
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
 
143
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
 
144
     &,4,2,1,3,-coef/2.0d0)
 
145
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
 
146
     & 1 + noab * (h2b - 1 + noab * (p4b - noab - 1 + nvab * (p3b - noab
 
147
     & - 1)))))
 
148
      END IF
 
149
      IF ((p4b .le. p3b) .and. (h1b .le. h2b)) THEN
 
150
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
 
151
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
 
152
     &,2,4,3,1,-coef/2.0d0)
 
153
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h2b -
 
154
     & 1 + noab * (h1b - 1 + noab * (p3b - noab - 1 + nvab * (p4b - noab
 
155
     & - 1)))))
 
156
      END IF
 
157
      IF ((p4b .le. p3b) .and. (h2b .le. h1b)) THEN
 
158
      CALL TCE_SORT_4(dbl_mb(k_c_sort),dbl_mb(k_c),int_mb(k_range+h2b-1)
 
159
     &,int_mb(k_range+p4b-1),int_mb(k_range+h1b-1),int_mb(k_range+p3b-1)
 
160
     &,2,4,1,3,coef/2.0d0)
 
161
      CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(h1b -
 
162
     & 1 + noab * (h2b - 1 + noab * (p3b - noab - 1 + nvab * (p4b - noab
 
163
     & - 1)))))
 
164
      END IF
 
165
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('T2_C2_1_1',10,MA_ERR)
 
166
      IF (.not.MA_POP_STACK(l_c_sort)) CALL ERRQUIT('T2_C2_1_1',11,MA_ER
 
167
     &R)
 
168
      END IF
 
169
      END IF
 
170
      END IF
 
171
      next = NXTASK(nprocs,1)
 
172
      END IF
 
173
      count = count + 1
 
174
      END DO
 
175
      END DO
 
176
      END DO
 
177
      END DO
 
178
      next = NXTASK(-nprocs,1)
 
179
      call GA_SYNC()
 
180
      RETURN
 
181
      END