Skip to content

fleur
fleur
Commit d970cdc8 authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files
Options

More subroutines for the t_force type

parent 74cf9fcc
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 307 additions and 236 deletions
cdn/cdnval.F90
View file @ d970cdc8
This diff is collapsed.
cmake/Files_and_Targets.txt
View file @ d970cdc8
......@@ -55,7 +55,8 @@ eigen/vec_for_lo.f90 eigen/orthoglo.F90 juDFT/usage_data.F90
global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 inpgen/inpgen_help.f90 io/rw_inp.f90 juDFT/juDFT.F90 global/find_enpara.f90
juDFT/info.F90 juDFT/stop.F90 juDFT/args.F90 juDFT/time.F90 juDFT/init.F90 juDFT/sysinfo.F90 io/w_inpXML.f90 init/julia.f90 global/utility.F90
init/compile_descr.F90 init/kpoints.f90 io/xmlOutput.F90 init/brzone2.f90 cdn/slab_dim.f90 cdn/slabgeom.f90 dos/nstm3.f90 cdn/int_21.f90
cdn/int_21lo.f90 cdn_mt/rhomt21.f90 cdn_mt/rhonmt21.f90)
cdn/int_21lo.f90 cdn_mt/rhomt21.f90 cdn_mt/rhonmt21.f90 force/force_a21.F90 force/force_a21_lo.f90 force/force_a21_U.f90 force/force_a12.f90
eigen/tlmplm_store.F90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
......
eigen/tlmplm_store.F90
View file @ d970cdc8
......@@ -9,7 +9,7 @@ MODULE m_tlmplm_store
! used to transfer the results from tlmplm&density matrix in case of lda+u from eigen
! into force_a21
! D.W 2014
USE m_types
USE m_types_tlmplm
IMPLICIT NONE
PRIVATE
TYPE(t_tlmplm) :: td_stored
......
force/force_a12.f90
View file @ d970cdc8
......@@ -6,13 +6,15 @@ MODULE m_forcea12
!
CONTAINS
SUBROUTINE force_a12(atoms,nobd,sym, DIMENSION, cell,oneD,&
we,jsp,ne,usdus,eigVecCoeffs,force,results)
USE m_types
we,jsp,ne,usdus,eigVecCoeffs,acoflo,bcoflo,e1cof,e2cof,f_a12,results)
USE m_types_setup
USE m_types_misc
USE m_types_usdus
USE m_types_cdnval
USE m_constants
USE m_juDFT
IMPLICIT NONE
TYPE(t_force),INTENT(INOUT) :: force
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_oneD),INTENT(IN) :: oneD
......@@ -27,7 +29,12 @@ CONTAINS
INTEGER, INTENT (IN) :: ne ,jsp
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: we(nobd)
REAL, INTENT(IN) :: we(nobd)
COMPLEX, INTENT(IN) :: acoflo(-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat)
COMPLEX, INTENT(IN) :: bcoflo(-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat)
COMPLEX, INTENT(IN) :: e1cof(ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
COMPLEX, INTENT(IN) :: e2cof(ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
COMPLEX, INTENT(INOUT) :: f_a12(3,atoms%ntype)
! ..
! .. Local Scalars ..
COMPLEX a12,cil1,cil2
......@@ -87,8 +94,8 @@ CONTAINS
DO m1 = -l1,l1
lm1 = l1* (l1+1) + m1
DO ie = 1,ne
acof_flapw(ie,lm1) = acof_flapw(ie,lm1) - force%acoflo(m1,ie,ilo,natrun)
bcof_flapw(ie,lm1) = bcof_flapw(ie,lm1) - force%bcoflo(m1,ie,ilo,natrun)
acof_flapw(ie,lm1) = acof_flapw(ie,lm1) - acoflo(m1,ie,ilo,natrun)
bcof_flapw(ie,lm1) = bcof_flapw(ie,lm1) - bcoflo(m1,ie,ilo,natrun)
ENDDO
ENDDO
ENDDO
......@@ -107,7 +114,7 @@ CONTAINS
!
a12 = a12 + CONJG(cil1*&
(acof_flapw(ie,lm1)*usdus%us(l1,n,jsp) + bcof_flapw(ie,lm1)*usdus%uds(l1,n,jsp) ))*cil2*&
(force%e1cof(ie,lm2,natrun)*usdus%us(l2,n,jsp)+ force%e2cof(ie,lm2,natrun)*usdus%uds(l2,n,jsp))*we(ie)
(e1cof(ie,lm2,natrun)*usdus%us(l2,n,jsp)+ e2cof(ie,lm2,natrun)*usdus%uds(l2,n,jsp))*we(ie)
END DO
aaa(1) = alpha(l1,m1)*krondel(l2,l1-1)* krondel(m2,m1+1)
......@@ -224,7 +231,7 @@ CONTAINS
! is also a solution of Schr. equ. if psi is one.
DO i = 1,3
results%force(i,n,jsp) = results%force(i,n,jsp) + REAL(forc_a12(i))
force%f_a12(i,n) = force%f_a12(i,n) + forc_a12(i)
f_a12(i,n) = f_a12(i,n) + forc_a12(i)
END DO
!
! write result moved to force_a8
......
force/force_a21.F90
View file @ d970cdc8
MODULE m_forcea21
CONTAINS
SUBROUTINE force_a21(input,atoms,DIMENSION,nobd,sym,oneD,cell,&
we,jsp,epar,ne,eig,usdus,eigVecCoeffs,force,results)
SUBROUTINE force_a21(input,atoms,DIMENSION,sym,oneD,cell,&
we,jsp,epar,ne,eig,usdus,eigVecCoeffs,aveccof,bveccof,cveccof,f_a21,f_b4,results)
! ************************************************************
! Pulay 2nd and 3rd (A17+A20) term force contribution a la Rici
......@@ -24,12 +24,15 @@ CONTAINS
USE m_forcea21lo
USE m_forcea21U
USE m_tlmplm_store
USE m_types
USE m_types_setup
USE m_types_misc
USE m_types_usdus
USE m_types_tlmplm
USE m_types_cdnval
USE m_constants
USE m_juDFT
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_force),INTENT(INOUT) :: force
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_oneD),INTENT(IN) :: oneD
......@@ -40,12 +43,16 @@ CONTAINS
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: ne,jsp
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: we(nobd),epar(0:atoms%lmaxd,atoms%ntype)
REAL, INTENT (IN) :: eig(DIMENSION%neigd)
REAL, INTENT(IN) :: we(ne),epar(0:atoms%lmaxd,atoms%ntype)
REAL, INTENT(IN) :: eig(DIMENSION%neigd)
COMPLEX, INTENT(IN) :: aveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
COMPLEX, INTENT(IN) :: bveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
COMPLEX, INTENT(IN) :: cveccof(3,-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat)
COMPLEX, INTENT(INOUT) :: f_a21(3,atoms%ntype)
COMPLEX, INTENT(INOUT) :: f_b4(3,atoms%ntype)
! ..
! .. Local Scalars ..
COMPLEX dtd,dtu,utd,utu
......@@ -145,10 +152,10 @@ CONTAINS
END IF
DO i = 1,3
a21(i,natrun) = a21(i,natrun) + 2.0*&
AIMAG( CONJG(eigVecCoeffs%acof(ie,lm1,natrun,jsp)) *utu*force%aveccof(i,ie,lm2,natrun)&
+CONJG(eigVecCoeffs%acof(ie,lm1,natrun,jsp)) *utd*force%bveccof(i,ie,lm2,natrun)&
+CONJG(eigVecCoeffs%bcof(ie,lm1,natrun,jsp)) *dtu*force%aveccof(i,ie,lm2,natrun)&
+CONJG(eigVecCoeffs%bcof(ie,lm1,natrun,jsp)) *dtd*force%bveccof(i,ie,lm2,natrun))*we(ie)/atoms%neq(n)
AIMAG( CONJG(eigVecCoeffs%acof(ie,lm1,natrun,jsp)) *utu*aveccof(i,ie,lm2,natrun)&
+CONJG(eigVecCoeffs%acof(ie,lm1,natrun,jsp)) *utd*bveccof(i,ie,lm2,natrun)&
+CONJG(eigVecCoeffs%bcof(ie,lm1,natrun,jsp)) *dtu*aveccof(i,ie,lm2,natrun)&
+CONJG(eigVecCoeffs%bcof(ie,lm1,natrun,jsp)) *dtd*bveccof(i,ie,lm2,natrun))*we(ie)/atoms%neq(n)
! END i loop
END DO
END IF
......@@ -175,10 +182,10 @@ CONTAINS
DO i = 1,3
DO natrun = natom,natom + atoms%neq(n) - 1
a21(i,natrun) = a21(i,natrun) + 2.0*&
AIMAG(CONJG(eigVecCoeffs%acof(ie,lm1,natrun,jsp)) *utu*force%aveccof(i,ie,lm1,natrun)&
+CONJG(eigVecCoeffs%acof(ie,lm1,natrun,jsp)) *utd*force%bveccof(i,ie,lm1,natrun)&
+CONJG(eigVecCoeffs%bcof(ie,lm1,natrun,jsp)) *dtu*force%aveccof(i,ie,lm1,natrun)&
+CONJG(eigVecCoeffs%bcof(ie,lm1,natrun,jsp)) *dtd*force%bveccof(i,ie,lm1,natrun)&
AIMAG(CONJG(eigVecCoeffs%acof(ie,lm1,natrun,jsp)) *utu*aveccof(i,ie,lm1,natrun)&
+CONJG(eigVecCoeffs%acof(ie,lm1,natrun,jsp)) *utd*bveccof(i,ie,lm1,natrun)&
+CONJG(eigVecCoeffs%bcof(ie,lm1,natrun,jsp)) *dtu*aveccof(i,ie,lm1,natrun)&
+CONJG(eigVecCoeffs%bcof(ie,lm1,natrun,jsp)) *dtd*bveccof(i,ie,lm1,natrun)&
)*we(ie) /atoms%neq(n)
END DO
!
......@@ -194,10 +201,10 @@ CONTAINS
!
!---> add the local orbital and U contribution to a21
!
CALL force_a21_lo(nobd,atoms,jsp,n,we,eig,ne,eigVecCoeffs,force,tlmplm,usdus,a21)
CALL force_a21_lo(atoms,jsp,n,we,eig,ne,eigVecCoeffs,aveccof,bveccof,cveccof,tlmplm,usdus,a21)
IF ((atoms%n_u.GT.0).AND.(i_u.LE.atoms%n_u)) THEN
CALL force_a21_U(nobd,atoms,i_u,n,jsp,we,ne,usdus,v_mmp,eigVecCoeffs,force,a21)
CALL force_a21_U(atoms,i_u,n,jsp,we,ne,usdus,v_mmp,eigVecCoeffs,aveccof,bveccof,cveccof,a21)
END IF
IF (input%l_useapw) THEN
! -> B4 force
......@@ -212,10 +219,10 @@ CONTAINS
we(ie)/atoms%neq(n)*atoms%rmt(n)**2*AIMAG(&
CONJG(eigVecCoeffs%acof(ie,lm1,natrun,jsp)*usdus%us(l1,n,jsp)&
+eigVecCoeffs%bcof(ie,lm1,natrun,jsp)*usdus%uds(l1,n,jsp))*&
(force%aveccof(i,ie,lm1,natrun)*usdus%dus(l1,n,jsp)&
+force%bveccof(i,ie,lm1,natrun)*usdus%duds(l1,n,jsp) )&
-CONJG(force%aveccof(i,ie,lm1,natrun)*usdus%us(l1,n,jsp)&
+force%bveccof(i,ie,lm1,natrun)*usdus%uds(l1,n,jsp) )*&
(aveccof(i,ie,lm1,natrun)*usdus%dus(l1,n,jsp)&
+bveccof(i,ie,lm1,natrun)*usdus%duds(l1,n,jsp) )&
-CONJG(aveccof(i,ie,lm1,natrun)*usdus%us(l1,n,jsp)&
+bveccof(i,ie,lm1,natrun)*usdus%uds(l1,n,jsp) )*&
(eigVecCoeffs%acof(ie,lm1,natrun,jsp)*usdus%dus(l1,n,jsp)&
+eigVecCoeffs%bcof(ie,lm1,natrun,jsp)*usdus%duds(l1,n,jsp)) )
END DO
......@@ -232,15 +239,15 @@ CONTAINS
we(ie)/atoms%neq(n)*atoms%rmt(n)**2*AIMAG(&
CONJG( eigVecCoeffs%acof(ie,lm1,natrun,jsp)* usdus%us(l1,n,jsp)&
+ eigVecCoeffs%bcof(ie,lm1,natrun,jsp)* usdus%uds(l1,n,jsp) ) *&
force%cveccof(i,m,ie,lo,natrun)*usdus%dulos(lo,n,jsp)&
cveccof(i,m,ie,lo,natrun)*usdus%dulos(lo,n,jsp)&
+ CONJG(eigVecCoeffs%ccof(m,ie,lo,natrun,jsp)*usdus%ulos(lo,n,jsp)) *&
( force%aveccof(i,ie,lm1,natrun)* usdus%dus(l1,n,jsp)&
+ force%bveccof(i,ie,lm1,natrun)* usdus%duds(l1,n,jsp)&
+ force%cveccof(i,m,ie,lo,natrun)*usdus%dulos(lo,n,jsp) ) &
- (CONJG( force%aveccof(i,ie,lm1,natrun) *usdus%us(l1,n,jsp)&
+ force%bveccof(i,ie,lm1,natrun) *usdus%uds(l1,n,jsp) ) *&
( aveccof(i,ie,lm1,natrun)* usdus%dus(l1,n,jsp)&
+ bveccof(i,ie,lm1,natrun)* usdus%duds(l1,n,jsp)&
+ cveccof(i,m,ie,lo,natrun)*usdus%dulos(lo,n,jsp) ) &
- (CONJG( aveccof(i,ie,lm1,natrun) *usdus%us(l1,n,jsp)&
+ bveccof(i,ie,lm1,natrun) *usdus%uds(l1,n,jsp) ) *&
eigVecCoeffs%ccof(m,ie,lo,natrun,jsp) *usdus%dulos(lo,n,jsp)&
+ CONJG(force%cveccof(i,m,ie,lo,natrun)*usdus%ulos(lo,n,jsp)) *&
+ CONJG(cveccof(i,m,ie,lo,natrun)*usdus%ulos(lo,n,jsp)) *&
( eigVecCoeffs%acof(ie,lm1,natrun,jsp)*usdus%dus(l1,n,jsp)&
+ eigVecCoeffs%bcof(ie,lm1,natrun,jsp)*usdus%duds(l1,n,jsp)&
+ eigVecCoeffs%ccof(m,ie,lo,natrun,jsp)*usdus%dulos(lo,n,jsp) ) ) )
......@@ -347,8 +354,8 @@ CONTAINS
! IS ALSO A SOLUTION OF SCHR. EQU. IF PSI IS ONE.
DO i = 1,3
results%force(i,n,jsp) = results%force(i,n,jsp) + REAL(forc_a21(i) + forc_b4(i))
force%f_a21(i,n) = force%f_a21(i,n) + forc_a21(i)
force%f_b4(i,n) = force%f_b4(i,n) + forc_b4(i)
f_a21(i,n) = f_a21(i,n) + forc_a21(i)
f_b4(i,n) = f_b4(i,n) + forc_b4(i)
END DO
!
! write result moved to force_a8
......
force/force_a21_U.f90
View file @ d970cdc8
MODULE m_forcea21U
CONTAINS
SUBROUTINE force_a21_U(nobd,atoms,i_u,itype,isp,we,ne,usdus,v_mmp,eigVecCoeffs,force,a21)
SUBROUTINE force_a21_U(atoms,i_u,itype,isp,we,ne,usdus,v_mmp,eigVecCoeffs,aveccof,bveccof,cveccof,a21)
!
!***********************************************************************
! This subroutine calculates the lda+U contribution to the HF forces,
......@@ -9,24 +9,27 @@ CONTAINS
!***********************************************************************
!
USE m_constants
USE m_types
USE m_types_setup
USE m_types_usdus
USE m_types_cdnval
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
TYPE(t_force),INTENT(IN) :: force
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: itype,isp,ne
INTEGER, INTENT (INOUT) :: i_u ! on input: index for the first U for atom type "itype or higher"
! on exit: index for the first U for atom type "itype+1 or higher"
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: we(nobd)
COMPLEX, INTENT (IN) :: v_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
REAL, INTENT (INOUT) :: a21(3,atoms%nat)
REAL, INTENT(IN) :: we(ne)
COMPLEX, INTENT(IN) :: v_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
COMPLEX, INTENT(IN) :: aveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
COMPLEX, INTENT(IN) :: bveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
COMPLEX, INTENT(IN) :: cveccof(3,-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat)
REAL, INTENT(INOUT) :: a21(3,atoms%nat)
! ..
! .. Local Scalars ..
COMPLEX v_a,v_b,v_c,p1,p2,p3
......@@ -59,8 +62,8 @@ CONTAINS
DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
DO ie = 1,ne
DO i = 1,3
p1 = (CONJG(eigVecCoeffs%acof(ie,lm,iatom,isp)) * v_a) * force%aveccof(i,ie,lmp,iatom)
p2 = (CONJG(eigVecCoeffs%bcof(ie,lm,iatom,isp)) * v_b) * force%bveccof(i,ie,lmp,iatom)
p1 = (CONJG(eigVecCoeffs%acof(ie,lm,iatom,isp)) * v_a) * aveccof(i,ie,lmp,iatom)
p2 = (CONJG(eigVecCoeffs%bcof(ie,lm,iatom,isp)) * v_b) * bveccof(i,ie,lmp,iatom)
a21(i,iatom) = a21(i,iatom) + 2.0*AIMAG(p1 + p2) * we(ie)/atoms%neq(itype)
END DO
END DO
......@@ -84,11 +87,11 @@ CONTAINS
DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
DO ie = 1,ne
DO i = 1,3
p1 = v_a * (CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp)) * force%cveccof(i,mp,ie,lo,iatom))
p2 = v_b * (CONJG(eigVecCoeffs%acof(ie,lm,iatom,isp)) * force%cveccof(i,mp,ie,lo,iatom) + &
CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp)) * force%aveccof(i,ie,lmp,iatom))
p3 = v_c * (CONJG(eigVecCoeffs%bcof(ie,lm,iatom,isp)) * force%cveccof(i,mp,ie,lo,iatom) + &
CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp)) * force%bveccof(i,ie,lmp,iatom))
p1 = v_a * (CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp)) * cveccof(i,mp,ie,lo,iatom))
p2 = v_b * (CONJG(eigVecCoeffs%acof(ie,lm,iatom,isp)) * cveccof(i,mp,ie,lo,iatom) + &
CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp)) * aveccof(i,ie,lmp,iatom))
p3 = v_c * (CONJG(eigVecCoeffs%bcof(ie,lm,iatom,isp)) * cveccof(i,mp,ie,lo,iatom) + &
CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp)) * bveccof(i,ie,lmp,iatom))
a21(i,iatom) = a21(i,iatom) + 2.0*AIMAG(p1 + p2 + p3)*we(ie)/atoms%neq(itype)
END DO
END DO
......
force/force_a21_lo.f90
View file @ d970cdc8
......@@ -6,7 +6,8 @@
MODULE m_forcea21lo
CONTAINS
SUBROUTINE force_a21_lo(nobd,atoms,isp,itype,we,eig,ne,eigVecCoeffs,force,tlmplm,usdus,a21)
SUBROUTINE force_a21_lo(atoms,isp,itype,we,eig,ne,eigVecCoeffs,&
aveccof,bveccof,cveccof,tlmplm,usdus,a21)
!
!***********************************************************************
! This subroutine calculates the local orbital contribution to A21,
......@@ -15,21 +16,25 @@ CONTAINS
! p.kurz nov. 1997
!***********************************************************************
!
USE m_types
USE m_types_setup
USE m_types_usdus
USE m_types_tlmplm
USE m_types_cdnval
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_tlmplm),INTENT(IN) :: tlmplm
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
TYPE(t_force),INTENT(IN) :: force
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: itype,ne,isp
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: we(nobd),eig(:)!(dimension%neigd)
REAL, INTENT (INOUT) :: a21(3,atoms%nat)
REAL, INTENT(IN) :: we(ne),eig(:)!(dimension%neigd)
REAL, INTENT(INOUT) :: a21(3,atoms%nat)
COMPLEX, INTENT(IN) :: aveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
COMPLEX, INTENT(IN) :: bveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
COMPLEX, INTENT(IN) :: cveccof(3,-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat)
! ..
! .. Local Scalars ..
COMPLEX utulo,dtulo,cutulo,cdtulo,ulotulo
......@@ -68,13 +73,13 @@ CONTAINS
DO i = 1,3
a21(i,iatom)=a21(i,iatom)+2.0*aimag(&
conjg(eigVecCoeffs%acof(ie,lmp,iatom,isp))*utulo&
*force%cveccof(i,m,ie,lo,iatom)&
*cveccof(i,m,ie,lo,iatom)&
+ conjg(eigVecCoeffs%bcof(ie,lmp,iatom,isp))*dtulo&
*force%cveccof(i,m,ie,lo,iatom)&
*cveccof(i,m,ie,lo,iatom)&
+ conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))&
*cutulo*force%aveccof(i,ie,lmp,iatom)&
*cutulo*aveccof(i,ie,lmp,iatom)&
+ conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))&
*cdtulo*force%bveccof(i,ie,lmp,iatom)&
*cdtulo*bveccof(i,ie,lmp,iatom)&
)*we(ie)/atoms%neq(itype)
ENDDO
ENDDO
......@@ -102,7 +107,7 @@ CONTAINS
DO i = 1,3
a21(i,iatom)=a21(i,iatom)+2.0*aimag(&
+ conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))&
*ulotulo*force%cveccof(i,mp,ie,lop,iatom)&
*ulotulo*cveccof(i,mp,ie,lop,iatom)&
)*we(ie)/atoms%neq(itype)
ENDDO
ENDDO
......@@ -115,10 +120,10 @@ CONTAINS
DO i = 1,3
a21(i,iatom)=a21(i,iatom)&
-2.0*aimag(&
(conjg(eigVecCoeffs%acof(ie,lm,iatom,isp))*force%cveccof(i,m,ie,lo,iatom)+&
conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*force%aveccof(i,ie,lm,iatom))*usdus%uulon(lo,itype,isp)+&
(conjg(eigVecCoeffs%bcof(ie,lm,iatom,isp))*force%cveccof(i,m,ie,lo,iatom)+&
conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*force%bveccof(i,ie,lm,iatom))*&
(conjg(eigVecCoeffs%acof(ie,lm,iatom,isp))*cveccof(i,m,ie,lo,iatom)+&
conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*aveccof(i,ie,lm,iatom))*usdus%uulon(lo,itype,isp)+&
(conjg(eigVecCoeffs%bcof(ie,lm,iatom,isp))*cveccof(i,m,ie,lo,iatom)+&
conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*bveccof(i,ie,lm,iatom))*&
usdus%dulon(lo,itype,isp))*eig(ie)*we(ie)/atoms%neq(itype)
ENDDO
ENDDO
......@@ -130,7 +135,7 @@ CONTAINS
DO i = 1,3
a21(i,iatom)=a21(i,iatom)-2.0*aimag(&
conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*&
force%cveccof(i,m,ie,lop,iatom)*&
cveccof(i,m,ie,lop,iatom)*&
usdus%uloulopn(lo,lop,itype,isp))*&
eig(ie)*we(ie)/atoms%neq(itype)
......
types/CMakeLists.txt
View file @ d970cdc8
......@@ -19,6 +19,7 @@ types/types_cdnval.f90
types/types_field.F90
types/types_regionCharges.f90
types/types_denCoeffsOffdiag.f90
types/types_force.f90
)
set(inpgen_F90 ${inpgen_F90}
......@@ -40,4 +41,5 @@ types/types_usdus.F90
types/types_cdnval.f90
types/types_regionCharges.f90
types/types_denCoeffsOffdiag.f90
types/types_force.f90
)
types/types.F90
View file @ d970cdc8
......@@ -23,5 +23,6 @@ MODULE m_types
USE m_types_field
USE m_types_regionCharges
USE m_types_denCoeffsOffdiag
USE m_types_force
END MODULE m_types
types/types_cdnval.f90
View file @ d970cdc8
......@@ -60,26 +60,6 @@ PRIVATE
PROCEDURE,PASS :: init => denCoeffs_init
END TYPE t_denCoeffs
TYPE t_force
COMPLEX, ALLOCATABLE :: f_a12(:,:)
COMPLEX, ALLOCATABLE :: f_a21(:,:)
COMPLEX, ALLOCATABLE :: f_b4(:,:)
COMPLEX, ALLOCATABLE :: f_b8(:,:)
COMPLEX, ALLOCATABLE :: e1cof(:,:,:)
COMPLEX, ALLOCATABLE :: e2cof(:,:,:)
COMPLEX, ALLOCATABLE :: aveccof(:,:,:,:)
COMPLEX, ALLOCATABLE :: bveccof(:,:,:,:)
COMPLEX, ALLOCATABLE :: cveccof(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: acoflo(:,:,:,:)
COMPLEX, ALLOCATABLE :: bcoflo(:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init1 => force_init1
PROCEDURE,PASS :: init2 => force_init2
END TYPE t_force
TYPE t_slab
INTEGER :: nsld, nsl
......@@ -162,7 +142,7 @@ PRIVATE
PROCEDURE,PASS :: init => gVacMap_init
END TYPE t_gVacMap
PUBLIC t_orb, t_denCoeffs, t_force, t_slab, t_eigVecCoeffs
PUBLIC t_orb, t_denCoeffs, t_slab, t_eigVecCoeffs
PUBLIC t_mcd, t_moments, t_orbcomp, t_cdnvalKLoop, t_gVacMap
CONTAINS
......@@ -298,82 +278,6 @@ SUBROUTINE denCoeffs_init(thisDenCoeffs, atoms, sphhar, jsp_start, jsp_end)
END SUBROUTINE denCoeffs_init
SUBROUTINE force_init1(thisForce,input,atoms)
USE m_types_setup
IMPLICIT NONE
CLASS(t_force), INTENT(INOUT) :: thisForce
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
IF (input%l_f) THEN
ALLOCATE (thisForce%f_a12(3,atoms%ntype))
ALLOCATE (thisForce%f_a21(3,atoms%ntype))
ALLOCATE (thisForce%f_b4(3,atoms%ntype))
ALLOCATE (thisForce%f_b8(3,atoms%ntype))
ELSE
ALLOCATE (thisForce%f_a12(1,1))
ALLOCATE (thisForce%f_a21(1,1))
ALLOCATE (thisForce%f_b4(1,1))
ALLOCATE (thisForce%f_b8(1,1))
END IF
thisForce%f_a12 = CMPLX(0.0,0.0)
thisForce%f_a21 = CMPLX(0.0,0.0)
thisForce%f_b4 = CMPLX(0.0,0.0)
thisForce%f_b8 = CMPLX(0.0,0.0)
END SUBROUTINE force_init1
SUBROUTINE force_init2(thisForce,noccbd,input,atoms)
USE m_types_setup
IMPLICIT NONE
CLASS(t_force), INTENT(INOUT) :: thisForce
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
INTEGER, INTENT(IN) :: noccbd
IF (ALLOCATED(thisForce%e1cof)) DEALLOCATE(thisForce%e1cof)
IF (ALLOCATED(thisForce%e2cof)) DEALLOCATE(thisForce%e2cof)
IF (ALLOCATED(thisForce%acoflo)) DEALLOCATE(thisForce%acoflo)
IF (ALLOCATED(thisForce%bcoflo)) DEALLOCATE(thisForce%bcoflo)
IF (ALLOCATED(thisForce%aveccof)) DEALLOCATE(thisForce%aveccof)
IF (ALLOCATED(thisForce%bveccof)) DEALLOCATE(thisForce%bveccof)
IF (ALLOCATED(thisForce%cveccof)) DEALLOCATE(thisForce%cveccof)
IF (input%l_f) THEN
ALLOCATE (thisForce%e1cof(noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat))
ALLOCATE (thisForce%e2cof(noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat))
ALLOCATE (thisForce%acoflo(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat))
ALLOCATE (thisForce%bcoflo(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat))
ALLOCATE (thisForce%aveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat))
ALLOCATE (thisForce%bveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat))
ALLOCATE (thisForce%cveccof(3,-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat))
ELSE
ALLOCATE (thisForce%e1cof(1,1,1))
ALLOCATE (thisForce%e2cof(1,1,1))
ALLOCATE (thisForce%acoflo(1,1,1,1))
ALLOCATE (thisForce%bcoflo(1,1,1,1))
ALLOCATE (thisForce%aveccof(1,1,1,1))
ALLOCATE (thisForce%bveccof(1,1,1,1))
ALLOCATE (thisForce%cveccof(1,1,1,1,1))
END IF
thisForce%e1cof = CMPLX(0.0,0.0)
thisForce%e2cof = CMPLX(0.0,0.0)
thisForce%acoflo = CMPLX(0.0,0.0)
thisForce%bcoflo = CMPLX(0.0,0.0)
thisForce%aveccof = CMPLX(0.0,0.0)
thisForce%bveccof = CMPLX(0.0,0.0)
thisForce%cveccof = CMPLX(0.0,0.0)
END SUBROUTINE force_init2
SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell)
USE m_types_setup
......
types/types_force.f90 0 → 100644
View file @ d970cdc8
!--------------------------------------------------------------------------------
! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_types_force
IMPLICIT NONE
PRIVATE
TYPE t_force
COMPLEX, ALLOCATABLE :: f_a12(:,:)
COMPLEX, ALLOCATABLE :: f_a21(:,:)
COMPLEX, ALLOCATABLE :: f_b4(:,:)
COMPLEX, ALLOCATABLE :: f_b8(:,:)
COMPLEX, ALLOCATABLE :: e1cof(:,:,:)
COMPLEX, ALLOCATABLE :: e2cof(:,:,:)
COMPLEX, ALLOCATABLE :: aveccof(:,:,:,:)
COMPLEX, ALLOCATABLE :: bveccof(:,:,:,:)
COMPLEX, ALLOCATABLE :: cveccof(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: acoflo(:,:,:,:)
COMPLEX, ALLOCATABLE :: bcoflo(:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init1 => force_init1
PROCEDURE,PASS :: init2 => force_init2
PROCEDURE :: addContribsA21A12
END TYPE t_force
PUBLIC t_force
CONTAINS
SUBROUTINE force_init1(thisForce,input,atoms)
USE m_types_setup
IMPLICIT NONE
CLASS(t_force), INTENT(INOUT) :: thisForce
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
IF (input%l_f) THEN
ALLOCATE (thisForce%f_a12(3,atoms%ntype))
ALLOCATE (thisForce%f_a21(3,atoms%ntype))
ALLOCATE (thisForce%f_b4(3,atoms%ntype))
ALLOCATE (thisForce%f_b8(3,atoms%ntype))
ELSE
ALLOCATE (thisForce%f_a12(1,1))
ALLOCATE (thisForce%f_a21(1,1))
ALLOCATE (thisForce%f_b4(1,1))
ALLOCATE (thisForce%f_b8(1,1))
END IF
thisForce%f_a12 = CMPLX(0.0,0.0)
thisForce%f_a21 = CMPLX(0.0,0.0)
thisForce%f_b4 = CMPLX(0.0,0.0)
thisForce%f_b8 = CMPLX(0.0,0.0)
END SUBROUTINE force_init1
SUBROUTINE force_init2(thisForce,noccbd,input,atoms)
USE m_types_setup
IMPLICIT NONE
CLASS(t_force), INTENT(INOUT) :: thisForce
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
INTEGER, INTENT(IN) :: noccbd
IF (ALLOCATED(thisForce%e1cof)) DEALLOCATE(thisForce%e1cof)
IF (ALLOCATED(thisForce%e2cof)) DEALLOCATE(thisForce%e2cof)
IF (ALLOCATED(thisForce%acoflo)) DEALLOCATE(thisForce%acoflo)
IF (ALLOCATED(thisForce%bcoflo)) DEALLOCATE(thisForce%bcoflo)
IF (ALLOCATED(thisForce%aveccof)) DEALLOCATE(thisForce%aveccof)
IF (ALLOCATED(thisForce%bveccof)) DEALLOCATE(thisForce%bveccof)
IF (ALLOCATED(thisForce%cveccof)) DEALLOCATE(thisForce%cveccof)
IF (input%l_f) THEN
ALLOCATE (thisForce%e1cof(noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat))
ALLOCATE (thisForce%e2cof(noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat))
ALLOCATE (thisForce%acoflo(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat))
ALLOCATE (thisForce%bcoflo(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat))
ALLOCATE (thisForce%aveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat))
ALLOCATE (thisForce%bveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat))
ALLOCATE (thisForce%cveccof(3,-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat))
ELSE
ALLOCATE (thisForce%e1cof(1,1,1))
ALLOCATE (thisForce%e2cof(1,1,1))
ALLOCATE (thisForce%acoflo(1,1,1,1))
ALLOCATE (thisForce%bcoflo(1,1,1,1))
ALLOCATE (thisForce%aveccof(1,1,1,1))
ALLOCATE (thisForce%bveccof(1,1,1,1))
ALLOCATE (thisForce%cveccof(1,1,1,1,1))
END IF
thisForce%e1cof = CMPLX(0.0,0.0)
thisForce%e2cof = CMPLX(0.0,0.0)
thisForce%acoflo = CMPLX(0.0,0.0)
thisForce%bcoflo = CMPLX(0.0,0.0)
thisForce%aveccof = CMPLX(0.0,0.0)
thisForce%bveccof = CMPLX(0.0,0.0)
thisForce%cveccof = CMPLX(0.0,0.0)
END SUBROUTINE force_init2
SUBROUTINE addContribsA21A12(thisForce,input,atoms,dimension,sym,cell,oneD,enpara,&
usdus,eigVecCoeffs,noccbd,ispin,eig,we,results)
USE m_types_setup
USE m_types_usdus
USE m_types_enpara
USE m_types_cdnval
USE m_types_misc
USE m_forcea12
USE m_forcea21
IMPLICIT NONE
CLASS(t_force), INTENT(INOUT) :: thisForce