← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/tools/ga-5-2/global/examples/boltzmann/main.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/tools/ga-5-2/global/examples/boltzmann/main.F
 
1
#if HAVE_CONFIG_H
 
2
#   include "config.fh"
 
3
#endif
 
4
      program main
 
5
 
 
6
c
 
7
#include "common"
 
8
c
 
9
      integer i, j, gdim, type
 
10
      integer gdims(NDIM+1), gwidth(NDIM+1)
 
11
      integer pdims(NDIM+1), mcnt, mapc(5000)
 
12
      integer g_fg, g_fld, g_bc, ptr_fg, ptr_fld, ptr_bc
 
13
      integer ld_fg(NDIM+1), ld_fld(NDIM+1), ld_bc(NDIM)
 
14
      integer heap, stack, me, nproc
 
15
c
 
16
#include "mafdecls.fh"
 
17
#include "global.fh"
 
18
c
 
19
c  Initialize a message passing library
 
20
c
 
21
#include "mp3.fh"
 
22
      size(1) = NSIZE
 
23
      size(2) = NSIZE
 
24
c
 
25
c   Initialize global arrays
 
26
c
 
27
      call ga_initialize()
 
28
c
 
29
      nproc = ga_nnodes()
 
30
      me = ga_nodeid()
 
31
c
 
32
      if (ga_uses_ma()) then
 
33
        heap = (size(1)+2)*(size(2)+2)*34/nproc
 
34
      else
 
35
        heap = 100000
 
36
      endif
 
37
      stack = 50000
 
38
c
 
39
      if (.not.ma_init(MT_DBL, stack, heap))
 
40
     +  call ga_error("ma init failed", -1)
 
41
 
 
42
c
 
43
c initialize global arrays
 
44
c
 
45
      do i = 1, NDIM
 
46
        dims(i) = size(i)
 
47
        gdims(i) = size(i)
 
48
        width(i) = 1
 
49
        gwidth(i) = 1
 
50
      end do
 
51
c
 
52
c  evaluate distribution of processors
 
53
c
 
54
      gdim = NDIM
 
55
      call factor(nproc,gdim,pdims)
 
56
      mcnt = 1
 
57
      do i = 1, NDIM
 
58
        do j = 0, pdims(i)-1
 
59
          mapc(mcnt) = ((dble(j)/dble(pdims(i)))*dble(gdims(i)))+1
 
60
          mcnt = mcnt + 1
 
61
        end do
 
62
      end do
 
63
      do i = 0, pdims(1)-1
 
64
        mapc(mcnt) = ((dble(i)/dble(pdims(1)))*dble(NDIM))+1
 
65
        mcnt = mcnt + 1
 
66
      end do
 
67
      do i = 0, pdims(2)-1
 
68
        mapc(mcnt) = ((dble(i)/dble(pdims(2)))*dble(NDIM))+1
 
69
        mcnt = mcnt + 1
 
70
      end do
 
71
c
 
72
c   Create global arrays. Start by creating array for LB distribution
 
73
c   functions. The last dimension runs over the distribution function
 
74
c   indices. The first 9 elements are the actual distribution elements,
 
75
c   the next 9 indices are the equilibrium distribution elements,
 
76
c   and the last 9 elements are temporary storage space used for doing
 
77
c   the streaming updates.
 
78
c
 
79
      type = MT_DBL
 
80
      gdim = 3
 
81
      gdims(3) = 27
 
82
      gwidth(3) = 0
 
83
      pdims(3) = 1
 
84
      mapc(mcnt) = 1
 
85
      if (.not.nga_create_ghosts_irreg(type, gdim, gdims, gwidth,
 
86
     +    "lb_dist", mapc, pdims, g_fg))
 
87
     +    call ga_error("g_fg init failed",me)
 
88
c
 
89
c   Create global array to hold density, momentum, pressure,
 
90
c   and relaxation parameters. These are stored at each point
 
91
c   and indexed by the last indice as density, p_x, p_y,
 
92
c   pressure, t_rho.
 
93
c
 
94
      type = MT_DBL
 
95
      gdim = 3
 
96
      gdims(3) = 6
 
97
      gwidth(3) = 0
 
98
      pdims(3) = 1
 
99
      mapc(mcnt) = 1
 
100
      if (.not.nga_create_ghosts_irreg(type, gdim, gdims, gwidth,
 
101
     +    "fields", mapc, pdims, g_fld))
 
102
     +    call ga_error("g_fld init failed",me)
 
103
c
 
104
c   Create global array to hold boundary condition data.
 
105
c
 
106
      type = MT_INT
 
107
      gdim = 2
 
108
      if (.not.nga_create_ghosts_irreg(type, gdim, gdims, gwidth,
 
109
     +    "bc_mask", mapc, pdims, g_bc))
 
110
     +    call ga_error("g_bc init failed",me)
 
111
c
 
112
c   Find pointers to global array data
 
113
c
 
114
      call nga_access_ghosts(g_fg,dims_fg,ptr_fg,ld_fg)
 
115
      call nga_access_ghosts(g_fld,dims_fld,ptr_fld,ld_fld)
 
116
      call nga_access_ghosts(g_bc,dims_bc,ptr_bc,ld_bc)
 
117
      do i = 1, NDIM
 
118
        dims(i) = dims_fg(i)
 
119
      end do
 
120
c
 
121
c   Call routine to run main simulation
 
122
c
 
123
      call boltzmann(g_fg,  dbl_mb(ptr_fg),  ld_fg(1),  ld_fg(2),
 
124
     +               g_fld, dbl_mb(ptr_fld), ld_fld(1), ld_fld(2),
 
125
     +               g_bc,  int_mb(ptr_bc),  ld_bc(1))
 
126
c
 
127
c   Close out calculation
 
128
c
 
129
      call ga_terminate()
 
130
      call MP_FINALIZE()
 
131
      stop
 
132
      end
 
133
c
 
134
      subroutine factor(p,ndim,dims)
 
135
      implicit none
 
136
      integer i,j,p,ndim,dims(*),imin,mdim
 
137
      integer ip,ifac,pmax,prime(1000)
 
138
      integer fac(1000)
 
139
c
 
140
      i = 1
 
141
      ip = p
 
142
      do i = 1, ndim
 
143
        dims(i) = 1
 
144
      end do
 
145
c
 
146
c    factor p completely
 
147
c    first, find all prime numbers less than or equal to p
 
148
c
 
149
      pmax = 0
 
150
      do i = 2, p
 
151
        do j = 1, pmax
 
152
          if (mod(i,prime(j)).eq.0) go to 100
 
153
        end do
 
154
        pmax = pmax + 1
 
155
        prime(pmax) = i
 
156
  100   continue
 
157
      end do
 
158
c
 
159
c    find all prime factors of p
 
160
c
 
161
      ifac = 0
 
162
      do i = 1, pmax
 
163
  200   if (mod(ip,prime(i)).eq.0) then
 
164
          ifac = ifac + 1
 
165
          fac(ifac) = prime(i)
 
166
          ip = ip/prime(i)
 
167
          go to 200
 
168
        endif
 
169
      end do
 
170
c
 
171
c    determine dimensions of processor grid
 
172
c
 
173
      do i = ifac, 1, -1
 
174
c
 
175
c    find dimension with minimum value
 
176
c
 
177
        imin = dims(1)
 
178
        mdim = 1
 
179
        do j = 2, ndim
 
180
          if (dims(j).lt.imin) then
 
181
            imin = dims(j)
 
182
            mdim = j
 
183
          endif
 
184
        end do
 
185
        dims(mdim) = dims(mdim)*fac(i)
 
186
      end do
 
187
c
 
188
      return
 
189
      end