← Back to branch summary

~siesta-pseudos-bases/siesta/trunk-psml

« back to all changes in this revision

Viewing changes to Src/diagk.F

  • Committer: Alberto Garcia
  • Date: 2019-09-02 14:09:43 UTC
  • mfrom: (427.6.323 trunk)
  • Revision ID: albertog@icmab.es-20190902140943-mzmbe1jacgefpgxw
Sync to trunk-776 (notably nc/soc wavefunction support)


Show diffs side-by-side

added added

removed removed

Lines of Context:
Src/diagk.F
101
101
      use writewave,     only : writew
102
102
      use m_fermid,      only : fermid, fermispin, stepf
103
103
      use m_spin,        only : spinor_dim, e_spin_dim
 
104
      use iso_c_binding, only : c_loc, c_f_pointer
104
105
#ifdef MPI
105
106
      use mpi_siesta
106
107
#endif
143
144
      real(dp) :: qp1, qp2, eqp1, eqp2
144
145
 
145
146
      real(dp), pointer :: lpsi(:,:)
 
147
      real(dp), pointer :: psi_real_1d(:)
146
148
 
147
149
      logical, allocatable :: done_juo(:)
148
150
C     ....................
217
219
 
218
220
      nd = listdptr(nuo) + numd(nuo)
219
221
 
220
 
! NPA:
221
 
! I have tried putting the parallel section out here
222
 
! However, the intel compilers cannot figure it out :(
223
 
 
224
222
C Find weights for local density of states ............................
225
223
      if (e1 .lt. e2) then
226
224
*       e1 = e1 - ef
227
225
*       e2 = e2 - ef
228
226
        t = max( temp, 1.e-6_dp )
229
227
        rt = 1._dp / t
230
 
!$OMP parallel do default(shared), collapse(3), private(ik,ispin,io)
 
228
!$OMP parallel do default(shared), private(ik,ispin,io)
231
229
        do ik = 1,nk
232
230
          do ispin = 1,spinor_dim
233
231
            do io = 1,nuotot
242
240
 
243
241
C New density and energy-density matrices of unit-cell orbitals .......
244
242
      if (nuo.gt.0) then
245
 
!$OMP parallel workshare
246
243
        Dnew(1:nd,1:h_spin_dim) = 0.0_dp
247
244
        Enew(1:nd,1:e_spin_dim) = 0.0_dp
248
 
!$OMP end parallel workshare
249
245
      endif
250
246
 
251
247
 
347
343
                ! This is useful if we are requesting WFS in a "bands" setting
348
344
                call kludge_copy(nuotot,eo(1,ispin,ik),aux)
349
345
             endif
 
346
             call c_f_pointer(c_loc(psi),psi_real_1d,[size(psi)])
350
347
             call writew(nuotot,nuo,ik,kpoint(1,ik),ispin,
351
 
     .                 aux,psi,.false.)
 
348
     .                 aux,psi_real_1d,gamma=.false.,non_coll=.false.,
 
349
     $                 blocksize=BlockSize)
352
350
          endif
353
351
 
354
352
          if (getD) then
356
354
 
357
355
C Add contribution to density matrices of unit-cell orbitals
358
356
C WARNING: Dk and Ek may be EQUIVALENCE'd to Haux and Saux
359
 
!$OMP parallel do default(shared), collapse(2)
360
 
!$OMP&private(iuo,juo)
 
357
!$OMP parallel do default(shared), private(iuo,juo)
361
358
            do iuo = 1,nuo
362
359
              do juo = 1,nuotot
363
360
                Dk(1,juo,iuo) = 0.0_dp