1
2! Copyright (C) 2019 J. K. Dewhurst and S. Sharma.
3! This file is distributed under the terms of the GNU General Public License.
4! See the file COPYING for license details.
5
6subroutine genwfuv(evecu,evecv,wfmt,wfir,wfumt,wfuir,wfvmt,wfvir)
7use modmain
8use modomp
9implicit none
10! arguments
11complex(8), intent(in) :: evecu(nstsv,nstsv),evecv(nstsv,nstsv)
12complex(8), intent(in) :: wfmt(npcmtmax,natmtot,nspinor,nstsv)
13complex(8), intent(in) :: wfir(ngtc,nspinor,nstsv)
14complex(8), intent(out) :: wfumt(npcmtmax,natmtot,nspinor,nstsv)
15complex(8), intent(out) :: wfuir(ngtc,nspinor,nstsv)
16complex(8), intent(out) :: wfvmt(npcmtmax,natmtot,nspinor,nstsv)
17complex(8), intent(out) :: wfvir(ngtc,nspinor,nstsv)
18! local variables
19integer ist,jst,ispn
20integer is,ias,npc,nthd
21complex(8) z1
22call holdthd(nstsv,nthd)
23!$OMP PARALLEL DEFAULT(SHARED) &
24!$OMP PRIVATE(ist,z1,ispn) &
25!$OMP PRIVATE(ias,is,npc) &
26!$OMP NUM_THREADS(nthd)
27!$OMP DO
28do jst=1,nstsv
29  wfumt(:,:,:,jst)=0.d0
30  wfuir(:,:,jst)=0.d0
31  do ist=1,nstsv
32    z1=evecu(ist,jst)
33    if (abs(dble(z1))+abs(aimag(z1)).gt.epsocc) then
34      do ispn=1,nspinor
35        do ias=1,natmtot
36          is=idxis(ias)
37          npc=npcmt(is)
38          call zaxpy(npc,z1,wfmt(:,ias,ispn,ist),1,wfumt(:,ias,ispn,jst),1)
39        end do
40        call zaxpy(ngtc,z1,wfir(:,ispn,ist),1,wfuir(:,ispn,jst),1)
41      end do
42    end if
43  end do
44end do
45!$OMP END DO NOWAIT
46!$OMP DO
47do jst=1,nstsv
48  wfvmt(:,:,:,jst)=0.d0
49  wfvir(:,:,jst)=0.d0
50  do ist=1,nstsv
51    z1=evecv(ist,jst)
52    if (abs(dble(z1))+abs(aimag(z1)).gt.epsocc) then
53      do ispn=1,nspinor
54        do ias=1,natmtot
55          is=idxis(ias)
56          npc=npcmt(is)
57          call zaxpy(npc,z1,wfmt(:,ias,ispn,ist),1,wfvmt(:,ias,ispn,jst),1)
58        end do
59        call zaxpy(ngtc,z1,wfir(:,ispn,ist),1,wfvir(:,ispn,jst),1)
60      end do
61    end if
62  end do
63end do
64!$OMP END DO
65!$OMP END PARALLEL
66call freethd(nthd)
67end subroutine
68
69