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

« back to all changes in this revision

Viewing changes to src/tools/ga-5-2/global/examples/md_cluster/heapsort.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
* 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:
 
1
#if HAVE_CONFIG_H
 
2
#   include "config.fh"
 
3
#endif
 
4
      subroutine heapsort(iflg)
 
5
#include "common.fh"
 
6
c
 
7
c
 
8
c  This routine sorts either the locally owned particles (iflg=0) or
 
9
c  the particles stored in the buffer arrays (iflg=1) so that they are
 
10
c  arranged in order of increasing index
 
11
c
 
12
      double precision rr1(3,6),rmss
 
13
      double precision tbeg,wraptime
 
14
c     
 
15
      integer l, ir, i,j
 
16
      integer iflg,jj,kk,iat,idx
 
17
c     
 
18
      if (iflg.eq.1) go to 1000
 
19
      if ( antot .eq. 0 ) return
 
20
      if ( antot .eq. 1 ) return
 
21
c
 
22
      tbeg = wraptime()
 
23
c     
 
24
      l = antot/2 + 1
 
25
      ir = antot
 
26
c     
 
27
 10   continue
 
28
      if ( l .gt. 1 ) then
 
29
        l = l-1
 
30
        do jj = 1, 3
 
31
          do kk = 1, 6
 
32
            rr1(jj,kk) = ra(l,jj,kk)
 
33
          end do
 
34
        end do
 
35
        rmss = mass(l)
 
36
        iat = at(l)
 
37
        idx = aidx(l)
 
38
      else
 
39
        do jj = 1, 3
 
40
          do kk = 1, 6
 
41
            rr1(jj,kk) = ra(ir,jj,kk)
 
42
          end do
 
43
        end do
 
44
        rmss = mass(ir)
 
45
        iat = at(ir)
 
46
        idx = aidx(ir)
 
47
c
 
48
        do jj = 1, 3
 
49
          do kk = 1, 6
 
50
            ra(ir,jj,kk) = ra(1,jj,kk)
 
51
          end do
 
52
        end do
 
53
        mass(ir) = mass(1)
 
54
        at(ir) = at(1)
 
55
        aidx(ir) = aidx(1)
 
56
        ir = ir - 1
 
57
        if ( ir .eq. 1 ) then
 
58
          do jj = 1, 3
 
59
            do kk = 1, 6
 
60
              ra(1,jj,kk) = rr1(jj,kk)
 
61
            end do
 
62
          end do
 
63
          mass(1) = rmss
 
64
          at(1) = iat
 
65
          aidx(1) = idx
 
66
          tmstat(9) = tmstat(9) + wraptime() - tbeg
 
67
          return
 
68
        endif
 
69
      endif
 
70
c     
 
71
      if ( ir .eq. 1 ) then
 
72
        tmstat(9) = tmstat(9) + wraptime() - tbeg
 
73
        return
 
74
      endif
 
75
c     
 
76
      i = l
 
77
      j = l + l
 
78
 20   continue
 
79
      if ( j .le. ir ) then
 
80
        if ( j .lt. ir ) then
 
81
          if ( aidx(j) .lt. aidx(j+1)) j = j+1
 
82
        endif
 
83
        if ( idx .lt. aidx(j)) then
 
84
          do jj = 1, 3
 
85
            do kk = 1, 6
 
86
              ra(i,jj,kk) = ra(j,jj,kk)
 
87
            end do
 
88
          end do
 
89
          mass(i) = mass(j)
 
90
          at(i) = at(j)
 
91
          aidx(i) = aidx(j)
 
92
          i = j
 
93
          j = j + j
 
94
        else
 
95
          j = ir + 1
 
96
        endif
 
97
        go to 20
 
98
      endif
 
99
      do jj = 1, 3
 
100
        do kk = 1, 6
 
101
          ra(i,jj,kk) = rr1(jj,kk)
 
102
        end do
 
103
      end do
 
104
      mass(i) = rmss
 
105
      at(i) = iat
 
106
      aidx(i) = idx
 
107
      goto 10
 
108
c
 
109
 1000 if ( btot .eq. 0 ) return
 
110
      if ( btot .eq. 1 ) return
 
111
c     
 
112
      tbeg = wraptime()
 
113
c
 
114
      l = btot/2 + 1
 
115
      ir = btot
 
116
c     
 
117
 30   continue
 
118
      if ( l .gt. 1 ) then
 
119
        l = l-1
 
120
        rr1(1,1) = xcrd(l)
 
121
        rr1(2,1) = ycrd(l)
 
122
        rr1(3,1) = zcrd(l)
 
123
        rr1(1,2) = xfrc(l)
 
124
        rr1(2,2) = yfrc(l)
 
125
        rr1(3,2) = zfrc(l)
 
126
        rr1(3,3) = zacc(l)
 
127
        rmss = mbuf(l)
 
128
        iat = bat(l)
 
129
        idx = bidx(l)
 
130
      else
 
131
        rr1(1,1) = xcrd(ir)
 
132
        rr1(2,1) = ycrd(ir)
 
133
        rr1(3,1) = zcrd(ir)
 
134
        rr1(1,2) = xfrc(ir)
 
135
        rr1(2,2) = yfrc(ir)
 
136
        rr1(3,2) = zfrc(ir)
 
137
        rr1(3,3) = zacc(ir)
 
138
        rmss = mbuf(ir)
 
139
        iat = bat(ir)
 
140
        idx = bidx(ir)
 
141
c
 
142
        xcrd(ir) = xcrd(1)
 
143
        ycrd(ir) = ycrd(1)
 
144
        zcrd(ir) = zcrd(1)
 
145
        xfrc(ir) = xfrc(1)
 
146
        yfrc(ir) = yfrc(1)
 
147
        zfrc(ir) = zfrc(1)
 
148
        zacc(ir) = zacc(1)
 
149
        mbuf(ir) = mbuf(1)
 
150
        bat(ir) = bat(1)
 
151
        bidx(ir) = bidx(1)
 
152
        ir = ir - 1
 
153
        if ( ir .eq. 1 ) then
 
154
          xcrd(1) = rr1(1,1)
 
155
          ycrd(1) = rr1(2,1)
 
156
          zcrd(1) = rr1(3,1)
 
157
          xfrc(1) = rr1(1,2)
 
158
          yfrc(1) = rr1(2,2)
 
159
          zfrc(1) = rr1(3,2)
 
160
          zacc(1) = rr1(3,3)
 
161
          mbuf(1) = rmss
 
162
          bat(1) = iat
 
163
          bidx(1) = idx
 
164
          tmstat(10) = tmstat(10) + wraptime() - tbeg
 
165
          return
 
166
        endif
 
167
      endif
 
168
c     
 
169
      if ( ir .eq. 1 ) then
 
170
        tmstat(10) = tmstat(10) + wraptime() - tbeg
 
171
        return
 
172
      endif
 
173
c     
 
174
      i = l
 
175
      j = l + l
 
176
 40   continue
 
177
      if ( j .le. ir ) then
 
178
        if ( j .lt. ir ) then
 
179
          if ( bidx(j) .lt. bidx(j+1)) j = j+1
 
180
        endif
 
181
        if ( idx .lt. bidx(j)) then
 
182
          xcrd(i) = xcrd(j)
 
183
          ycrd(i) = ycrd(j)
 
184
          zcrd(i) = zcrd(j)
 
185
          xfrc(i) = xfrc(j)
 
186
          yfrc(i) = yfrc(j)
 
187
          zfrc(i) = zfrc(j)
 
188
          zacc(i) = zacc(j)
 
189
          mbuf(i) = mbuf(j)
 
190
          bat(i) = bat(j)
 
191
          bidx(i) = bidx(j)
 
192
          i = j
 
193
          j = j + j
 
194
        else
 
195
          j = ir + 1
 
196
        endif
 
197
        go to 40
 
198
      endif
 
199
      xcrd(i) = rr1(1,1)
 
200
      ycrd(i) = rr1(2,1)
 
201
      zcrd(i) = rr1(3,1)
 
202
      xfrc(i) = rr1(1,2)
 
203
      yfrc(i) = rr1(2,2)
 
204
      zfrc(i) = rr1(3,2)
 
205
      zacc(i) = rr1(3,3)
 
206
      mbuf(i) = rmss
 
207
      bat(i) = iat
 
208
      bidx(i) = idx
 
209
      goto 30
 
210
c
 
211
      end