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

« back to all changes in this revision

Viewing changes to src/tools/ga-5-2/global/examples/md_cluster/mdstep.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
c
 
5
c                                   NOTICE
 
6
c
 
7
c   This software is being made available for internal testing and
 
8
c   evaluation purposes only. This software is a pre-release test version
 
9
c   which has not yet been authenticated and cleared for publication. Adherence
 
10
c   to this notice may be necessary for the author, Battelle Memorial
 
11
c   Institute, to successfully assert copyright in and commercialize this
 
12
c   software. This software is not intended for duplication or distribution
 
13
c   to third parties without the permission of the Manager of Software
 
14
c   Products at Pacific Northwest Laboratory, Richland, Washington,  99352.
 
15
c
 
16
      subroutine mdstep
 
17
#include "common.fh"
 
18
c
 
19
      double precision vbox, rmax
 
20
      integer i,j,me
 
21
      logical newcfg
 
22
      double precision cluster_check_radius
 
23
      logical debug
 
24
      if (istep.gt.3930438) then
 
25
        debug = .false.
 
26
      else
 
27
        debug = .false.
 
28
      endif
 
29
c
 
30
c   This routine guides the MD steps.
 
31
c   Begin the main loop through the MD steps
 
32
c
 
33
      me = ga_nodeid()
 
34
      r_confine = 0.0d00
 
35
      do 5000 istep = 1, nstep
 
36
c
 
37
        newcfg = .false.
 
38
        mbflg = .false.
 
39
        cmflg = .false.
 
40
        ipmode = 0
 
41
        t_rmndr = tau
 
42
        t_done = 0.0d00
 
43
        cllsn_cnt = 0
 
44
c
 
45
c  Check to see if there are any special instructions
 
46
c
 
47
        do 100 i = 1, nsc
 
48
c
 
49
c  is end >= istep >= beg
 
50
c
 
51
          if ((istep.ge.isc(i,1)).and.(istep.le.isc(i,2))) then
 
52
c
 
53
c   is mod(istep-beg,inc) = 0
 
54
c
 
55
            if (mod(istep,isc(i,3)).eq.0) then
 
56
c
 
57
c   get next configuration using the appropriate algorithm
 
58
c
 
59
              if (isc(i,4).eq.1) then
 
60
                call estep
 
61
                newcfg = .true.
 
62
              elseif (isc(i,4).eq.2) then
 
63
                prssr = rsc(i,2) 
 
64
                pmass = rsc(i,4)
 
65
                call pstep
 
66
                newcfg = .true.
 
67
              elseif (isc(i,4).eq.3) then
 
68
                tmprtr = rsc(i,1)
 
69
                prssr = rsc(i,2)
 
70
                pmass = rsc(i,4)
 
71
                call sstep
 
72
                newcfg = .true.
 
73
              elseif (isc(i,4).eq.4) then
 
74
                tmprtr = rsc(i,1)
 
75
                tmass = rsc(i,3)
 
76
                call tstep
 
77
                newcfg = .true.
 
78
              elseif (isc(i,4).eq.5) then
 
79
                tmprtr = rsc(i,1)
 
80
                prssr = rsc(i,2) 
 
81
                tmass = rsc(i,3)
 
82
                pmass = rsc(i,4)
 
83
                call ptstep
 
84
                newcfg = .true.
 
85
              elseif (isc(i,4).eq.6) then
 
86
                tmprtr = rsc(i,1)
 
87
                call mbstep
 
88
                newcfg = .true.
 
89
              elseif (isc(i,4).eq.7) then
 
90
                itarg = isc(i,2)
 
91
                tmprtr = rsc(i,1)
 
92
                tvol = rsc(i,2)
 
93
                tmass = rsc(i,3)
 
94
                call vlstep
 
95
                newcfg = .true.
 
96
              elseif (isc(i,4).eq.8) then
 
97
                tmprtr = rsc(i,1)
 
98
                call kstep
 
99
                newcfg = .true.
 
100
              elseif (isc(i,4).eq.9) then
 
101
                tmprtr = rsc(i,1)
 
102
                prssr = rsc(i,2) 
 
103
                tmass = rsc(i,3)
 
104
                pmass = rsc(i,4)
 
105
                ipmode = 1
 
106
                call ptstep
 
107
                newcfg = .true.
 
108
              elseif (isc(i,4).eq.10) then
 
109
                tmprtr = rsc(i,1)
 
110
                prssr = rsc(i,2) 
 
111
                tmass = rsc(i,3)
 
112
                pmass = rsc(i,4)
 
113
                ipmode = 2
 
114
                call ptstep
 
115
                newcfg = .true.
 
116
              endif
 
117
            endif
 
118
          endif
 
119
  100   continue
 
120
c
 
121
c  get next configuration if no special step is taken
 
122
c
 
123
        if (.not.newcfg) then
 
124
          if (dflalg.eq.1) then
 
125
            call estep
 
126
          elseif (dflalg.eq.2) then
 
127
            prssr = dfprs
 
128
            pmass = dfpm
 
129
            call pstep
 
130
          elseif (dflalg.eq.3) then
 
131
            tmprtr = dftmp
 
132
            prssr = dfprs
 
133
            pmass = dfpm
 
134
            call sstep
 
135
          elseif (dflalg.eq.4) then
 
136
            tmprtr = dftmp
 
137
            tmass = dftm
 
138
            call tstep
 
139
          elseif (dflalg.eq.5) then
 
140
            tmprtr = dftmp
 
141
            prssr = dfprs
 
142
            tmass = dftm
 
143
            pmass = dfpm
 
144
            call ptstep
 
145
          elseif (dflalg.eq.6) then
 
146
            tmprtr = dftmp
 
147
            call mbstep
 
148
          elseif (dflalg.eq.9) then
 
149
            tmprtr = dftmp
 
150
            prssr = dfprs
 
151
            tmass = dftm
 
152
            pmass = dfpm
 
153
            ipmode = 1
 
154
            call ptstep
 
155
          elseif (dflalg.eq.10) then
 
156
            tmprtr = dftmp
 
157
            prssr = dfprs
 
158
            tmass = dftm
 
159
            pmass = dfpm
 
160
            ipmode = 2
 
161
            call ptstep
 
162
          endif
 
163
        endif
 
164
            if (debug) then
 
165
              write(6,*) ga_nodeid(),' Got to 1 at step ',istep
 
166
            endif
 
167
c
 
168
c  Update remaining energy quantities
 
169
c
 
170
        nrg(3) = nrg(4) + nrg(6)
 
171
        vbox = xbox*ybox*zbox
 
172
        nrg(7) = nrg(5) * dble(atot-1) / vbox + nrg(15)
 
173
 
 
174
        if (istep.eq.equil_1) then
 
175
          call fixper
 
176
          do i = 1, antot
 
177
            do j = 1, 3
 
178
              ra(i,j,6) = ra(i,j,1)
 
179
            end do
 
180
          end do
 
181
          call cluster_com
 
182
          call cluster_center
 
183
          rmax = cluster_check_radius()
 
184
          if (rmax.gt.r_cluster) r_cluster = rmax + 0.01
 
185
        endif
 
186
        if (mod(istep,mcfreq).eq.0.and.istep.gt.equil_1) then
 
187
          call cluster_mc
 
188
          if (me.eq.0.and.l_rad) write(7,7100) dble(istep)*tau,r_cluster
 
189
        endif
 
190
            if (debug) then
 
191
              write(6,*) ga_nodeid(),' Got to 2 at step ',istep
 
192
            endif
 
193
        if (istep.gt.equil_2.and.r_cluster.le.cl_upper)
 
194
     +    call cluster_binr
 
195
            if (debug) then
 
196
              write(6,*) ga_nodeid(),' Got to 3 at step ',istep
 
197
            endif
 
198
        if (istep.eq.window_1) call cluster_reset_binr(1)
 
199
        if (istep.eq.window_2) call cluster_reset_binr(2)
 
200
c
 
201
c   Perform all statistical operations
 
202
c   on the new configuration.
 
203
c
 
204
c   print pressure
 
205
c
 
206
         if (mod(istep,istat).eq.0.and.l_stdio) then
 
207
           call header(istep)
 
208
           if (me.eq.0) write(6,6000) nrg(7) 
 
209
           if (me.eq.0) write(6,6300) nrg(3)
 
210
           if (me.eq.0) write(6,6700) nrg(6),nrg(4),nrg(5)
 
211
           if (me.eq.0) write(6,6800) xbox,ybox,zbox,scal1
 
212
           if (me.eq.0) write(6,6100) nrg(13),nrg(14),
 
213
     +       nrg(17),nrg(21)
 
214
           if (me.eq.0) write(6,6900) nrg(9)
 
215
         endif
 
216
c
 
217
c   accumulate energy statistics
 
218
c
 
219
         if (istep.gt.equil_2) call estat
 
220
c
 
221
         if (me.eq.0.and.l_step.and.mod(istep,1000).eq.0) then
 
222
           open(unit=2,file='step.cnt',status='unknown')
 
223
           write(2,*) 'proc : ',ga_pgroup_nodeid(ga_pgroup_get_world())
 
224
           write(2,*) 'istep : ',istep
 
225
           write(2,6900) nrg(9)
 
226
           write(2,6100) nrg(13),nrg(14),nrg(17),nrg(21)
 
227
           write(2,6000) nrg(7) 
 
228
           write(2,6300) nrg(3)
 
229
           write(2,6700) nrg(6),nrg(4),nrg(5)
 
230
           write(2,6800) xbox,ybox,zbox,scal1
 
231
           write(2,7000) r_cluster
 
232
           write(2,7200) cl_lower
 
233
           write(2,7300) cl_upper
 
234
           close(2)
 
235
         endif
 
236
 5000 continue
 
237
      return
 
238
 6000 format(1x,'The instantaneous pressure is ',f12.4)
 
239
 6100 format(1x,'Current energy statistics'/
 
240
     +          '       repulsion: ',f16.4,/
 
241
     +          '      dispersion: ',f16.4,/
 
242
     +          '           bonds: ',f16.4,/
 
243
     +          '          angles: ',f16.4)
 
244
 6200 format(1x,'Statistics at time ',i6,' ps')
 
245
 6300 format(1x,'The total energy is ',f12.4)
 
246
 6700 format('     potential      kinetic'/
 
247
     +       '     energy         energy   temperature'/,
 
248
     +          1x,3f13.3)
 
249
 6800 format(1x,'The current simulation cell dimensions:'/
 
250
     +         '              x:   ',f16.4,/
 
251
     +         '              y:   ',f16.4,/
 
252
     +         '              z:   ',f16.4,/
 
253
     +         '              s:   ',f16.4)
 
254
 6820 format(1x,'The current simulation cell dimensions:'/
 
255
     +         '              x:   ',f16.4,/
 
256
     +         '              y:   ',f16.4,/
 
257
     +         '              s:   ',f16.4)
 
258
 6900 format(1x,'The instantaneous value of the Hamiltonian is ',f12.4)
 
259
 7000 format(1x,'The current value of confining sphere is      ',f12.4)
 
260
 7100 format(2f16.8)
 
261
 7200 format(1x,'Lower bound of confining sphere               ',f12.4)
 
262
 7300 format(1x,'Upper bound of confining sphere               ',f12.4)
 
263
      end