File: rhomagq.f90

package info (click to toggle)
elkcode 5.4.24-2
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 12,840 kB
  • sloc: f90: 48,415; fortran: 22,457; perl: 965; makefile: 384; sh: 369; python: 105; ansic: 67
file content (154 lines) | stat: -rw-r--r-- 3,812 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154

! Copyright (C) 2018 T. Mueller, J. K. Dewhurst, S. Sharma and E. K. U. Gross.
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.

subroutine rhomagq
use modmain
use modulr
use modomp
implicit none
! local variables
integer iq,ifq,idm,i
integer is,ias,npc,ir
integer nthd,ithd
! allocatable arrays
complex(8), allocatable :: zfmt(:),zfft(:,:)
!---------------------------------------------------------!
!     partial Fourier transform of density to Q-space     !
!---------------------------------------------------------!
! muffin-tin density
do ias=1,natmtot
  is=idxis(ias)
  npc=npcmt(is)
  call omp_hold(npc,nthd)
  allocate(zfft(nqpt,0:nthd-1))
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(ithd) &
!$OMP NUM_THREADS(nthd)
!$OMP DO
  do i=1,npc
    ithd=omp_get_thread_num()
    zfft(:,ithd)=rhormt(i,ias,:)
    call zfftifc(3,ngridq,-1,zfft(:,ithd))
    rhoqmt(i,ias,:)=zfft(:,ithd)
  end do
!$OMP END DO
!$OMP END PARALLEL
  deallocate(zfft)
  call omp_free(nthd)
end do
call omp_hold(nqpt,nthd)
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(zfmt,ifq) &
!$OMP PRIVATE(ias,is,npc) &
!$OMP NUM_THREADS(nthd)
!$OMP DO
do iq=1,nqpt
  allocate(zfmt(npcmtmax))
  ifq=iqfft(iq)
  do ias=1,natmtot
    is=idxis(ias)
    npc=npcmt(is)
! multiply by the phase factor function exp(iQ.r)
    zfmt(1:npc)=rhoqmt(1:npc,ias,ifq)*expqmt(1:npc,ias,iq)
! convert to spherical harmonics
    call zfsht(nrcmt(is),nrcmti(is),zfmt,rhoqmt(:,ias,ifq))
  end do
  deallocate(zfmt)
end do
!$OMP END DO
!$OMP END PARALLEL
call omp_free(nthd)
! interstitial density
call omp_hold(ngtot,nthd)
allocate(zfft(nqpt,0:nthd-1))
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(ithd) &
!$OMP NUM_THREADS(nthd)
!$OMP DO
do ir=1,ngtot
  ithd=omp_get_thread_num()
  zfft(:,ithd)=rhorir(ir,:)
  call zfftifc(3,ngridq,-1,zfft(:,ithd))
  rhoqir(ir,:)=zfft(:,ithd)
end do
!$OMP END DO
!$OMP END PARALLEL
deallocate(zfft)
call omp_free(nthd)
!---------------------------------------------------------------!
!     partial Fourier transform of magnetisation to Q-space     !
!---------------------------------------------------------------!
if (.not.spinpol) return
! muffin-tin magnetisation
do idm=1,ndmag
  do ias=1,natmtot
    is=idxis(ias)
    npc=npcmt(is)
    call omp_hold(npc,nthd)
    allocate(zfft(nqpt,0:nthd-1))
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(ithd) &
!$OMP NUM_THREADS(nthd)
!$OMP DO
    do i=1,npc
      ithd=omp_get_thread_num()
      zfft(:,ithd)=magrmt(i,ias,idm,:)
      call zfftifc(3,ngridq,-1,zfft(:,ithd))
      magqmt(i,ias,idm,:)=zfft(:,ithd)
    end do
!$OMP END DO
!$OMP END PARALLEL
    deallocate(zfft)
    call omp_free(nthd)
  end do
end do
call omp_hold(nqpt,nthd)
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(zfmt,ifq,idm) &
!$OMP PRIVATE(ias,is,npc) &
!$OMP NUM_THREADS(nthd)
!$OMP DO
do iq=1,nqpt
  allocate(zfmt(npcmtmax))
  ifq=iqfft(iq)
  do idm=1,ndmag
    do ias=1,natmtot
      is=idxis(ias)
      npc=npcmt(is)
! multiply by phase factor function exp(iQ.r)
      zfmt(1:npc)=magqmt(1:npc,ias,idm,ifq)*expqmt(1:npc,ias,iq)
! convert to spherical harmonics
      call zfsht(nrcmt(is),nrcmti(is),zfmt,magqmt(:,ias,idm,ifq))
    end do
  end do
  deallocate(zfmt)
end do
!$OMP END DO
!$OMP END PARALLEL
call omp_free(nthd)
! interstitial magnetisation
do idm=1,ndmag
  call omp_hold(ngtot,nthd)
  allocate(zfft(nqpt,0:nthd-1))
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(ithd) &
!$OMP NUM_THREADS(nthd)
!$OMP DO
  do ir=1,ngtot
    ithd=omp_get_thread_num()
    zfft(:,ithd)=magrir(ir,idm,:)
    call zfftifc(3,ngridq,-1,zfft(:,ithd))
    magqir(ir,idm,:)=zfft(:,ithd)
  end do
!$OMP END DO
!$OMP END PARALLEL
  deallocate(zfft)
  call omp_free(nthd)
end do
! determine the moments
call momentu
return
end subroutine