Commit 06ff2000 authored by Henning Janssen's avatar Henning Janssen

Format rhonmt21

parent 0b79eff7
......@@ -5,97 +5,98 @@
!--------------------------------------------------------------------------------
MODULE m_rhonmt21
! *************************************************************
! subroutine sets up the coefficients of the spin (up,down)
! part of the non-spherical muffin-tin density.
! pk`00 ff`01 gb`02
! Added parallelization and reworked for the efficient use with FFN.
! R. Hilgers July '20
! *************************************************************
CONTAINS
SUBROUTINE rhonmt21(atoms,sphhar,we,ne,sym,eigVecCoeffs,uunmt21,udnmt21,dunmt21,ddnmt21)
#include"cpp_double.h"
USE m_gaunt,ONLY:gaunt1
USE m_types_setup
USE m_types_cdnval
! *************************************************************
! subroutine sets up the coefficients of the spin (up,down)
! part of the non-spherical muffin-tin density.
! pk`00 ff`01 gb`02
! Added parallelization and reworked for the efficient use with FFN.
! R. Hilgers July '20
! *************************************************************
USE m_gaunt,ONLY:gaunt1
USE m_types_setup
USE m_types_cdnval
USE m_constants
IMPLICIT NONE
CONTAINS
SUBROUTINE rhonmt21(atoms,sphhar,we,ne,sym,eigVecCoeffs,uunmt21,udnmt21,dunmt21,ddnmt21)
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
! .. Scalar Arguments ..
INTEGER, INTENT(IN) :: ne
! .. Scalar Arguments ..
INTEGER, INTENT(IN) :: ne
! .. Array Arguments ..
REAL, INTENT(IN) :: we(:)!(nobd)
COMPLEX, INTENT(INOUT) :: uunmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: udnmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: dunmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: ddnmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
! .. Local Scalars ..
COMPLEX coef, cil, coef1
COMPLEX, PARAMETER :: mi = (0.0,-1.0)
COMPLEX :: temp(ne)
COMPLEX CPP_BLAS_cdotc
EXTERNAL CPP_BLAS_cdotc
INTEGER jmem,l,lh,llp,lm,lmp,lp,lv,m, mp,mv,na,natom,nb,nn,ns,nt!,lplow0,lphi,lplow,lcond
! ..
!
DO ns=1,sym%nsymt
natom= 0
DO nn=1,atoms%ntype
nt= natom
DO na= 1,atoms%neq(nn)
nt= nt+1
IF (sym%ntypsy(nt)==ns) THEN
!$OMP PARALLEL DO PRIVATE(lh,lp,l,lv,cil,llp,jmem,coef1,mp,lmp,m,lm,coef,mv,temp) &
!$OMP DEFAULT(none) &
!$OMP SHARED(we,ne,na,nt,nn,ns,uunmt21,udnmt21,dunmt21,ddnmt21,atoms,sphhar,eigVecCoeffs) &
!$OMP collapse(3)
DO lh = 1,sphhar%nlh(ns)
DO lp = 0,atoms%lmax(nn)
DO l = 0,atoms%lmax(nn)
lv = sphhar%llh(lh,ns)
IF ( MOD(lv+l+lp,2) .EQ. 0 ) THEN
cil = mi**(l-lp)
llp= lp*(atoms%lmax(nn)+1)+l+1
DO jmem = 1,sphhar%nmem(lh,ns)
mv = sphhar%mlh(jmem,lh,ns)
coef1 = cil * sphhar%clnu(jmem,lh,ns)
mp_loop: DO mp = -lp,lp
lmp = lp*(lp+1) + mp
m_loop: DO m = -l,l
coef= CONJG(coef1 * gaunt1(l,lv,lp,m,mv,mp,atoms%lmaxd))
IF (ABS(coef) .GE. 0 ) THEN
lm= l*(l+1) + m
temp(:) = coef * we(:) * eigVecCoeffs%acof(:,lm,nt,1)
uunmt21(llp,lh,nn) = uunmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%acof(:,lmp,nt,2),1,temp,1)
dunmt21(llp,lh,nn) = dunmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%bcof(:,lmp,nt,2),1,temp,1)
temp(:) = coef * we(:) * eigVecCoeffs%bcof(:,lm,nt,1)
udnmt21(llp,lh,nn) = udnmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%acof(:,lmp,nt,2),1,temp,1)
ddnmt21(llp,lh,nn) = ddnmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%bcof(:,lmp,nt,2),1,temp,1)
ENDIF ! (coef >= 0)
ENDDO m_loop ! m
ENDDO mp_loop
ENDDO ! jmem
ENDIF ! ( MOD(lv+l+lp),2) == 0 )
ENDDO ! lp
ENDDO ! l
ENDDO ! lh
!$OMP END PARALLEL DO
ENDIF ! (sym%ntypsy(nt)==ns)
ENDDO ! na
natom= natom + atoms%neq(nn)
ENDDO ! nn
! .. Array Arguments ..
REAL, INTENT(IN) :: we(:)!(nobd)
COMPLEX, INTENT(INOUT) :: uunmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: udnmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: dunmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: ddnmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
! .. Local Scalars ..
COMPLEX coef, cil, coef1
COMPLEX, PARAMETER :: mi = (0.0,-1.0)
COMPLEX :: temp(ne)
#include"cpp_double.h"
COMPLEX CPP_BLAS_cdotc
EXTERNAL CPP_BLAS_cdotc
ENDDO ! ns
INTEGER jmem,l,lh,llp,lm,lmp,lp,lv,m, mp,mv,na,natom,nb,nn,ns,nt!,lplow0,lphi,lplow,lcond
RETURN
DO ns=1,sym%nsymt
natom= 0
DO nn=1,atoms%ntype
nt= natom
DO na= 1,atoms%neq(nn)
nt= nt+1
IF (sym%ntypsy(nt)==ns) THEN
!!$OMP parallel do default(none) &
!!$OMP private(lh,lp,l,lv,cil,llp,jmem,coef1,mp,lmp,m,lm,coef,mv,temp) &
!!$OMP shared(we,ne,na,nt,nn,ns,uunmt21,udnmt21,dunmt21,ddnmt21,atoms,sphhar,eigVecCoeffs) &
!!$OMP collapse(3)
DO lh = 1,sphhar%nlh(ns)
DO lp = 0,atoms%lmax(nn)
DO l = 0,atoms%lmax(nn)
lv = sphhar%llh(lh,ns)
IF ( MOD(lv+l+lp,2) .EQ. 0 ) THEN
cil = mi**(l-lp)
llp= lp*(atoms%lmax(nn)+1)+l+1
DO jmem = 1,sphhar%nmem(lh,ns)
mv = sphhar%mlh(jmem,lh,ns)
coef1 = cil * sphhar%clnu(jmem,lh,ns)
mp_loop: DO mp = -lp,lp
lmp = lp*(lp+1) + mp
m_loop: DO m = -l,l
coef= CONJG(coef1 * gaunt1(l,lv,lp,m,mv,mp,atoms%lmaxd))
IF (ABS(coef) .GT. 1e-12 ) THEN
lm= l*(l+1) + m
temp(:) = coef * we(:) * eigVecCoeffs%acof(:,lm,nt,1)
uunmt21(llp,lh,nn) = uunmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%acof(:,lmp,nt,2),1,temp,1)
dunmt21(llp,lh,nn) = dunmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%bcof(:,lmp,nt,2),1,temp,1)
temp(:) = coef * we(:) * eigVecCoeffs%bcof(:,lm,nt,1)
udnmt21(llp,lh,nn) = udnmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%acof(:,lmp,nt,2),1,temp,1)
ddnmt21(llp,lh,nn) = ddnmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%bcof(:,lmp,nt,2),1,temp,1)
ENDIF ! (coef >= 0)
ENDDO m_loop ! m
ENDDO mp_loop
ENDDO ! jmem
ENDIF ! ( MOD(lv+l+lp),2) == 0 )
ENDDO ! lp
ENDDO ! l
ENDDO ! lh
!!$OMP end parallel do
ENDIF ! (sym%ntypsy(nt)==ns)
ENDDO ! na
natom= natom + atoms%neq(nn)
ENDDO ! nn
ENDDO ! ns
END SUBROUTINE rhonmt21
END SUBROUTINE rhonmt21
END MODULE m_rhonmt21
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment