~albertog/siesta/efield-2.5-jjunquera

« back to all changes in this revision

Viewing changes to Src/meshmatrix.F

  • Committer: Alberto Garcia
  • Date: 2007-11-21 11:45:49 UTC
  • mfrom: (192.1.67)
  • Revision ID: Arch-1:siesta@uam.es--2006%siesta-devel--reference--2.3--patch-1
Direct merge into master branch of initial BSC changes
The changes along the BSC branches, up to the end of the restructuring
of siesta.F and associated changes, have been merged into a direct
descendant of the main development line. The BSC work originally
started as a branch of siesta-devel--reference--2.1--patch-29. Development
along 2.1 continued, and a new continuation branch 2.3 has been created
specifically for this merge.

Main patches applied:

 * ref@bsc--2007/siesta-bsc--master--2.1--base-0
   tag of siesta@uam.es--2006/siesta-bsc--reference--2.1--patch-7

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-1
   Use of xalast in analysis routines. Exit of geometry loop

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-2
   Creation of a module to hold the siesta options

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-3
   New geometry module

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-4
   New stub module for sparse matrices

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-5
   More options for running tests

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-6
   Encapsulation of k-point handling

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-7
   Initialize iza in struct_init

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-8
   Siesta_todo slimming by M. Quero

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-9
   Fix import of no_l in born_charge

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-10
   Some conversions to Fortran90 by M. Quero

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-11
   Fourth session at the BSC

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-12
   Clarification of the scope of the stress variables

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-13
   Creation of siesta_forces

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-14
   Replacement of some allocatables by pointers and automatics

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-15
   New m_energies and m_steps modules. Back to old k-point behavior

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-16
   Merge of removal of integer and real variables from siesta_todo

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-17
   Fixes for troublesome bugs in reference code

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-18
   Final cleanup of siesta_todo

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-19
   Add character(len=*) routines to alloc.F90

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-20
   Pointers in fixed and setspatial. si2x1h test added to bsc-Makefile

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-21
   Re-organization of pulay module

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-22
   Reorganization of hsparse/xijorb calls with new neighbor module

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-23
   VPATH-aware compilation for multiple executable versions

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-24
   Allocatables to pointers  I

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-25
   Allocatables to pointers  II

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-26
   Allocatables to pointers III

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-27
   Allocatables to pointers IV -- new neighbor code + nspecies fix

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-28
   Explicit array-ness in calls in initatom and cellxc

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-29
   Fix wrong allocations in cellxc.F

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-30
   Explicit array extents in initatom.f

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-31
   Avoid shrinking of density-matrix arrays for extrapol.

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-32
   Fix typo in state_init.F

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-33
   Execute SCF loop when nscf=1

 * ref@bsc--2007/siesta-bsc--master--2.1--patch-34
   Clarify bounds of SCF loop in siesta_forces.

 * ref@bsc--2007/siesta-bsc--master--2.2--base-0
   tag of ref@bsc--2007/siesta-bsc--master--2.1--patch-31

 * ref@bsc--2007/siesta-bsc--master--2.3--base-0
   tag of ref@bsc--2007/siesta-bsc--master--2.2--base-0

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-1
   Prepare CHANGES file

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-2
   Merge patch-log for patch-30 from 2.1

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-3
   New treatment of fractional atoms in VCA. Bug fix in lmxo

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-4
   Re-enabling of kgrid update in variable-cell calculations

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-5
   Fix typo in state_init.F

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-6
   Merge filtering package by Eduardo Anglada

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-7
   Add graphite_c6_full test for more realistic vdW test

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-8
   Add patchlog for k-point fix

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-9
   Fix of zmatrix code to deal with degenerate case

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-10
   Units conversion in Util/Optical/optical.f. Scripts. Cosmetics

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-11
   Implementation of basis_enthalpy calculation. Zmatrix dependency

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-12
   Option to use fractional rc's for multiple zeta

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-13
   Sync vpath changes. Update siesta.tex

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-14
   Fix tag in MPI send/receive in mulliken

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-15
   Option to use fractional rc's for multiple zeta

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-16
   Merge of XML tester by Eduardo Anglada. Portability fixes

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-17
   Fix marenostrum-mpi.make. Syntax in compare_m.f90

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-18
   MareNostrum fixes. zdrot to blas. obj_setup. compare_m syntax

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-19
   Sync to bsc--2.1. Change banner in CHANGES to bsc--2.3

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-20
   Execute SCF loop when nscf=1

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-21
   Refinements of XML tester. New ioncat program

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-22
   Undef var in kgridinit, iohs MPI write, pdosg array bound, Origin shift

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-23
   Zmatrix optimization enhancements. Sign change in MM stress.

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-24
   Clarify bounds of SCF loop in siesta_forces.

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-25
   Avoid MP-grid permutations in trivial gamma case

 * ref@bsc--2007/siesta-bsc--master--2.3--patch-26
   Sync to reference--2.1

 * siesta@uam.es--2006/siesta-bsc--reference--2.1--base-0
   tag of siesta@uam.es--2006/siesta-devel--reference--2.1--patch-29

 * siesta@uam.es--2006/siesta-bsc--reference--2.1--patch-1
   First stage of siesta.F splitting at BSC

 * siesta@uam.es--2006/siesta-bsc--reference--2.1--patch-2
   Created struct_init for initial geometry setup. New test force_2

 * siesta@uam.es--2006/siesta-bsc--reference--2.1--patch-3
   Consolidate geometry updates at the end of loop

 * siesta@uam.es--2006/siesta-bsc--reference--2.1--patch-4
   Initialize vol2 correctly in m_check_supercell.f

 * siesta@uam.es--2006/siesta-bsc--reference--2.1--patch-5
   Kgrid setup streamlined. Bands. Proximity check. Hsparse allocation 

 * siesta@uam.es--2006/siesta-bsc--reference--2.1--patch-6
   Work by Manuel Quero before the meeting on Feb 7th

 * siesta@uam.es--2006/siesta-bsc--reference--2.1--patch-7
   Moved the Born-effective-charge code




Show diffs side-by-side

added added

removed removed

Lines of Context:
14
14
C form when data is distributed for parallel execution
15
15
C
16
16
      use precision, only: dp
 
17
      use alloc
17
18
      implicit none
18
19
 
19
20
C ----------------------------------------------------------------------
33
34
 
34
35
      integer, save :: nrowsDscfL
35
36
 
36
 
      integer, dimension(:), allocatable, save :: listdl
37
 
      integer, dimension(:), allocatable, save :: listdlptr
38
 
      integer, dimension(:), allocatable, save :: NeedDscfL
39
 
      integer, dimension(:), allocatable, save :: numdl
40
 
 
41
 
      real(dp),  dimension(:,:), allocatable, save :: DscfL
 
37
      integer, dimension(:), pointer, save :: listdl
 
38
      integer, dimension(:), pointer, save :: listdlptr
 
39
      integer, dimension(:), pointer, save :: NeedDscfL
 
40
      integer, dimension(:), pointer, save :: numdl
 
41
 
 
42
      real(dp), dimension(:,:), pointer, save :: DscfL
 
43
 
 
44
      logical, public, save :: nullified_pointers = .false.
42
45
 
43
46
      end module meshdscf
44
47
 
68
71
C
69
72
      use atomlist,     only : indxuo
70
73
      use meshdscf,     only : listdl, listdlptr, NeedDscfL, 
71
 
     .                         nrowsDscfL, numdl
 
74
     .                         nrowsDscfL, numdl, nullified_pointers
72
75
      use meshphi,      only : endpht, lstpht
73
76
      use parallel,     only : Node, Nodes
74
77
      use parallelsubs, only : GlobalToLocalOrb, WhichNodeOrb
75
78
      use precision
 
79
      use alloc
76
80
#ifdef MPI
77
81
      use mpi_siesta
78
82
#endif
99
103
     .  MPIerror
100
104
#endif
101
105
 
102
 
      integer, dimension(:), allocatable :: ibuffer
 
106
      integer, dimension(:), pointer :: ibuffer
 
107
 
 
108
      if (.not. nullified_pointers) then
 
109
        nullify( NeedDscfL )
 
110
        nullify( listdl )
 
111
        nullify( listdlptr )
 
112
        nullify( numdl )
 
113
        nullified_pointers = .true.
 
114
      endif
103
115
 
104
116
C Create pointer as to whether a given row of DscfL is needed in NeedDscfL
105
 
      if (.not.allocated(NeedDscfL)) then
106
 
        allocate(NeedDscfL(nuotot))
107
 
        call memory('A','I',nuotot,'CreateLocalDscfPointers')
108
 
      endif
 
117
C This pointer is never deallocated...
 
118
 
 
119
      call re_alloc( NeedDscfL, 1, nuotot, name='NeedDscfL',
 
120
     &                 routine='CreateLocalDscfPointers' )
 
121
 
109
122
      NeedDscfL(1:nuotot) = 0
110
123
      do ip = 1,nmpl
111
124
        do imp = 1+endpht(ip-1), endpht(ip)
123
136
      enddo
124
137
 
125
138
C Allocate/reallocate memory for numdl and listdlptr
126
 
      if (allocated(numdl)) then
127
 
        if (size(numdl).ne.nrowsDscfL) then
128
 
          call memory('D','I',size(numdl),'CreateLocalDscfPointers')
129
 
          deallocate(numdl)
130
 
          call memory('D','I',size(listdlptr),'CreateLocalDscfPointers')
131
 
          deallocate(listdlptr)
132
 
        endif
133
 
      endif
134
 
      if (.not.allocated(numdl)) then
135
 
        allocate(numdl(max(1,nrowsDscfL)))
136
 
        call memory('A','I',max(1,nrowsDscfL),'CreateLocalDscfPointers')
137
 
        allocate(listdlptr(max(1,nrowsDscfL)))
138
 
        call memory('A','I',max(1,nrowsDscfL),'CreateLocalDscfPointers')
139
 
      endif
 
139
 
 
140
      call re_alloc( numdl, 1, max(1,nrowsDscfL), name='numdl',
 
141
     &                 routine='CreateLocalDscfPointers' )
 
142
      call re_alloc( listdlptr, 1, max(1,nrowsDscfL), 
 
143
     &                 name='listdlptr',
 
144
     &                 routine='CreateLocalDscfPointers' )
140
145
 
141
146
C Distribute information about numd globally
142
147
      maxndmax = 0
161
166
      enddo
162
167
 
163
168
C Allocate/reallocate listdl
164
 
      if (allocated(listdl)) then
165
 
        call memory('D','I',size(listdl),'CreateLocalDscfPointers')
166
 
        deallocate(listdl)
167
 
      endif
168
169
      if (nrowsDscfL.gt.0) then
169
170
        nsize = listdlptr(nrowsDscfL)+numdl(nrowsDscfL)
170
171
      else
171
172
        nsize = 1
172
173
      endif
173
 
      allocate(listdl(nsize))
174
 
      call memory('A','I',nsize,'CreateLocalDscfPointers')
 
174
      call re_alloc( listdl, 1, nsize, name='listdl',
 
175
     &               routine='CreateLocalDscfPointers' )
175
176
 
176
177
C Distribute information about listd globally
177
 
      allocate(ibuffer(maxndmax))
178
 
      call memory('A','I',maxndmax,'CreateLocalDscfPointers')
179
 
      ibuffer(1:maxndmax) = 0
 
178
      nullify( ibuffer )
 
179
      call re_alloc( ibuffer, 1, maxndmax, name='ibuffer',
 
180
     &               routine='CreateLocalDscfPointers' )
 
181
      ibuffer(1:maxndmax) = 0      ! AG: superfluous
180
182
      do io = 1,nuotot
181
183
        call WhichNodeOrb(io,Nodes,BNode)
182
184
        if (Node.eq.BNode) then
196
198
          enddo
197
199
        endif
198
200
      enddo
199
 
      call memory('D','I',size(ibuffer),'CreateLocalDscfPointers')
200
 
      deallocate(ibuffer)
 
201
      call de_alloc( ibuffer, name='ibuffer' )
201
202
 
202
203
      end subroutine CreateLocalDscfPointers
203
204
 
225
226
C  Modules
226
227
      use precision
227
228
      use meshdscf, only : nrowsDscfL, numdl, listdlptr, NeedDscfL
 
229
      use alloc,    only : re_alloc, de_alloc
228
230
#ifdef MPI
229
231
      use mpi_siesta
230
232
      use parallel,     only : Node, Nodes
251
253
#ifdef MPI
252
254
      integer 
253
255
     .  BNode, ii, iio, maxno, maxnog, MPIerror
254
 
      real(dp), dimension(:), allocatable, save :: 
255
 
     .  buffer
 
256
      real(dp), dimension(:), pointer ::  buffer
256
257
#endif
257
258
 
258
259
C***********************
268
269
     .  MPI_Comm_World,MPIerror)
269
270
 
270
271
C Allocate local Dscf storage array
271
 
      allocate(buffer(maxnog*nspin))
272
 
      call memory('A','D',maxnog*nspin,'matrixOtoM')
 
272
      nullify(buffer)
 
273
      call re_alloc( buffer, 1, maxnog*nspin, name='buffer',
 
274
     &               routine='matrixOtoM' )
273
275
 
274
276
C Zero buffer as we will be passing the complete array
275
277
C as the number of explicitly non-zero elements will
276
278
C not be known on all nodes
277
 
      buffer(1:maxnog*nspin) = 0.0d0
 
279
      buffer(1:maxnog*nspin) = 0.0d0  ! AG: superfluous
278
280
 
279
281
C Loop over rows of Dscf broadcasting to all other nodes
280
282
      do io = 1,nuotot
306
308
      enddo
307
309
 
308
310
C Deallocate buffer memory
309
 
      call memory('D','D',size(buffer),'matrixOtoM')
310
 
      deallocate(buffer)
 
311
      call de_alloc(buffer, name="buffer")
311
312
#else
312
313
C*********************
313
314
C  Serial execution  *
357
358
C  Modules
358
359
      use precision
359
360
      use meshdscf
 
361
      use alloc, only: re_alloc, de_alloc
360
362
#ifdef MPI
361
363
      use mpi_siesta
362
364
      use parallel,     only : Node, Nodes
378
380
     .  i, iu, ispin
379
381
 
380
382
#ifdef MPI
381
 
      integer 
382
 
     .  ii, in, iul, maxnvg, MPIerror, nVsL, nVsLmax
383
 
      real(dp), dimension(:), allocatable, save :: 
384
 
     .  Vi
385
 
      integer, dimension(:), allocatable, save :: 
386
 
     .  nVsLPtr, listViptr
 
383
      integer :: ii, in, iul, maxnvg, MPIerror, nVsL, nVsLmax
 
384
      real(dp), dimension(:), pointer ::  Vi
 
385
      integer, dimension(:), pointer  ::  nVsLPtr, listViptr
387
386
#endif
388
387
      
389
388
C***********************
399
398
     .  MPI_max,MPI_Comm_World,MPIerror)
400
399
 
401
400
C Allocate buffer memory for transfer of matrix and pointer
402
 
      allocate(Vi(maxnvg*nspin))
403
 
      call memory('A','D',maxnvg*nspin,'matrixMtoO')
404
 
      allocate(nVsLPtr(nuotot))
405
 
      call memory('A','I',nuotot,'matrixMtoO')
406
 
      allocate(listViptr(nuotot))
407
 
      call memory('A','I',nuotot,'matrixMtoO')
 
401
      nullify(Vi)
 
402
      call re_alloc( Vi, 1, maxnvg*nspin, name='Vi',
 
403
     &               routine='matrixMtoO' )
 
404
      nullify(nVsLPtr)
 
405
      call re_alloc( nVsLPtr, 1, nuotot, name='nVsLPtr',
 
406
     &               routine='matrixMtoO' )
 
407
      nullify(listViptr)
 
408
      call re_alloc( listViptr, 1, nuotot, name='listViptr',
 
409
     &               routine='matrixMtoO' )
408
410
 
409
411
C Initialise buffers to avoid number trapping errors during transfer
410
 
      Vi(1:maxnvg) = 0.0d0
 
412
      Vi(1:maxnvg) = 0.0d0  ! AG : superfluous
411
413
      listViptr(1:nuotot) = 0
412
414
 
413
415
C Loop over Nodes for broadcasting of local data
463
465
      enddo
464
466
 
465
467
C Deallocate buffer and pointer memory
466
 
      call memory('D','I',size(listViptr),'matrixMtoO')
467
 
      deallocate(listViptr)
468
 
      call memory('D','I',size(nVsLPtr),'matrixMtoO')
469
 
      deallocate(nVsLPtr)
470
 
      call memory('D','D',size(Vi),'matrixMtoO')
471
 
      deallocate(Vi)
 
468
      call de_alloc(listViptr, name="listViptr")
 
469
      call de_alloc(nVsLPtr, name="nVsLPtr")
 
470
      call de_alloc(Vi, name="Vi")
472
471
#else
473
472
C*********************
474
473
C  Serial execution  *