mirror of https://gitlab.com/QEF/q-e.git
331 lines
11 KiB
Fortran
331 lines
11 KiB
Fortran
!this module contains objected derived and contracted
|
|
MODULE derived_objects
|
|
|
|
USE kinds, ONLY : DP
|
|
|
|
TYPE prod_proj
|
|
!terms <\mathcal{E}_\alpha|u_{k,c}u_{k,v}^*>
|
|
!k ponits distributed on MPI tasks as bands object
|
|
INTEGER :: numv !number of valence states (those considered for excitons only)
|
|
INTEGER :: numc !number of conduction states
|
|
INTEGER :: nk!total number of k, points
|
|
INTEGER :: nk_loc!local number of k points
|
|
INTEGER :: ik_first!first local k point
|
|
INTEGER :: ik_last!last local k point
|
|
INTEGER :: ntot_e!dimension of global to all k, basis for KS states
|
|
INTEGER :: nprod_e!number of product terms
|
|
COMPLEX(kind=DP), DIMENSION(:,:,:,:), POINTER :: javc! (nprod_e,numv,numc,nk_loc)
|
|
END TYPE prod_proj
|
|
|
|
TYPE prod_mix
|
|
!terms <\mathcal{E}_\alpha|(u_{k,v}u_{k',v'}^*)>
|
|
!and terms <\mathcal{E}_\alpha|(u_{k,c}u_{k',c'}^*)>
|
|
!k' distributed over MPI tasks
|
|
!k NOT distributed
|
|
INTEGER :: numv !number of valence states (those considered for excitons only)
|
|
INTEGER :: numc !number of conduction states
|
|
INTEGER :: nk!total number of k, points
|
|
INTEGER :: nk_loc!local number of k points
|
|
INTEGER :: ik_first!first local k point
|
|
INTEGER :: ik_last!last local k point
|
|
INTEGER :: ntot_e!dimension of global to all k, basis for KS states
|
|
INTEGER :: nprod_e!number of product terms
|
|
COMPLEX(kind=DP), DIMENSION(:,:,:,:,:), POINTER :: gvv! (nprod_e,numv,nk,numv',nk_loc)! ' means relative to nk_loc
|
|
COMPLEX(kind=DP), DIMENSION(:,:,:,:,:), POINTER :: gcc! (nprod_e,numc,nk,numc',nk_loc)
|
|
|
|
|
|
END TYPE prod_mix
|
|
|
|
|
|
CONTAINS
|
|
|
|
SUBROUTINE initialize_prod_proj(pp)
|
|
implicit none
|
|
TYPE(prod_proj) :: pp
|
|
|
|
nullify(pp%javc)
|
|
|
|
return
|
|
END SUBROUTINE initialize_prod_proj
|
|
|
|
|
|
|
|
SUBROUTINE deallocate_prod_proj(pp)
|
|
implicit none
|
|
TYPE(prod_proj) :: pp
|
|
if(associated(pp%javc)) deallocate(pp%javc)
|
|
nullify(pp%javc)
|
|
return
|
|
END SUBROUTINE deallocate_prod_proj
|
|
|
|
|
|
|
|
|
|
|
|
|
|
SUBROUTINE initialize_prod_mix(pm)
|
|
implicit none
|
|
TYPE(prod_mix) :: pm
|
|
|
|
nullify(pm%gvv)
|
|
nullify(pm%gcc)
|
|
|
|
return
|
|
END SUBROUTINE initialize_prod_mix
|
|
|
|
|
|
|
|
SUBROUTINE deallocate_prod_mix(pm)
|
|
implicit none
|
|
TYPE(prod_mix) :: pm
|
|
if(associated(pm%gvv)) deallocate(pm%gvv)
|
|
nullify(pm%gvv)
|
|
if(associated(pm%gcc)) deallocate(pm%gcc)
|
|
nullify(pm%gcc)
|
|
return
|
|
END SUBROUTINE deallocate_prod_mix
|
|
|
|
|
|
SUBROUTINE build_prod_proj(bd,pd,pp)
|
|
!this subroutine constructs the prod_proj object
|
|
USE simple_objects, ONLY : bands,product
|
|
|
|
|
|
|
|
implicit none
|
|
TYPE(bands), INTENT(in) :: bd
|
|
TYPE(product), INTENT(in) :: pd
|
|
TYPE(prod_proj), INTENT(out) :: pp
|
|
|
|
|
|
INTEGER :: ik,iv,ic
|
|
COMPLEX(kind=DP), ALLOCATABLE :: tmp_mat(:,:,:),tmp_mat2(:,:),tmp_mat3(:,:)
|
|
COMPLEX(kind=DP), ALLOCATABLE :: zmat(:,:,:,:),zmat0(:,:),zmat1(:,:,:,:)
|
|
LOGICAL, parameter :: debug = .false.
|
|
|
|
|
|
pp%numv=bd%numv
|
|
pp%numc=bd%numc
|
|
pp%ntot_e=bd%ntot_e
|
|
pp%nk=bd%nk
|
|
pp%nk_loc=bd%nk_loc
|
|
pp%ik_first=bd%ik_first
|
|
pp%ik_last=bd%ik_last
|
|
pp%nprod_e=pd%nprod_e
|
|
|
|
if(pp%nk_loc>0) then
|
|
allocate(pp%javc(pp%nprod_e,pp%numv, pp%numc,pp%nk_loc))
|
|
allocate(tmp_mat(pp%nprod_e,pp%ntot_e,pp%numc))
|
|
allocate(tmp_mat2(pp%ntot_e,pp%numv))
|
|
allocate(tmp_mat3(pp%ntot_e,pp%numc))
|
|
do ik=1,pp%nk_loc
|
|
tmp_mat2(1:pp%ntot_e,1:pp%numv)=conjg(bd%omat(1:pp%ntot_e,1:pp%numv,ik))
|
|
tmp_mat3(1:pp%ntot_e,1:pp%numc)=bd%omat(1:pp%ntot_e,pp%numv+1:pp%numv+pp%numc,ik)
|
|
call ZGEMM('N','N',pp%nprod_e*pp%ntot_e,pp%numc,pp%ntot_e,(1.d0,0.d0),pd%fij,&
|
|
&pp%nprod_e*pp%ntot_e,tmp_mat3,pp%ntot_e,(0.d0,0.d0),tmp_mat,pp%nprod_e*pp%ntot_e)
|
|
do ic=1,pp%numc
|
|
call ZGEMM('N','N',pp%nprod_e,pp%numv,pp%ntot_e,(1.d0,0.d0),tmp_mat(1,1,ic),pp%nprod_e,tmp_mat2,pp%ntot_e,&
|
|
&(0.d0,0.d0),pp%javc(1,1,ic,ik),pp%nprod_e)
|
|
enddo
|
|
enddo
|
|
deallocate(tmp_mat,tmp_mat2,tmp_mat3)
|
|
else
|
|
nullify(pp%javc)
|
|
endif
|
|
if(debug) then
|
|
!test for consistency
|
|
allocate(zmat(pp%numc,pp%numv,pp%numv,pp%numc))
|
|
allocate(zmat0(bd%num,bd%num))
|
|
allocate(zmat1(pd%ntot_e,pd%ntot_e,pd%ntot_e,pd%ntot_e))
|
|
do ik=1,bd%nk_loc
|
|
call ZGEMM('C','N',bd%num,bd%num,bd%ntot_e,(1.d0,0.d0),bd%omat(1,1,ik),bd%ntot_e,bd%omat(1,1,ik),bd%ntot_e,&
|
|
&(0.d0,0.d0),zmat0,bd%num)
|
|
|
|
do iv=1,bd%num
|
|
do ic=1,bd%num
|
|
write(*,*) 'CHECK OMAT ik, ic,iv', ik, ic, iv, zmat0(ic,iv)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
call ZGEMM('C','N',pd%ntot_e*pd%ntot_e,pd%ntot_e*pd%ntot_e,pd%nprod_e,(1.d0,0.d0),pd%fij,&
|
|
pd%nprod_e,pd%fij,pd%nprod_e,(0.d0,0.d0),zmat1,pd%ntot_e*pd%ntot_e)
|
|
do iv=1,pd%ntot_e
|
|
do ic=1,pd%ntot_e
|
|
write(*,*) 'CHECK FIJ ic,iv', ic, iv, zmat1(iv,ic,iv,ic)
|
|
enddo
|
|
enddo
|
|
|
|
do ik=1,pp%nk_loc
|
|
call ZGEMM('C','N',pp%numc*pp%numv,pp%numc*pp%numv,pp%nprod_e,(1.d0,0.d0),pp%javc(1,1,1,ik),pp%nprod_e,&
|
|
& pp%javc(1,1,1,ik),pp%nprod_e,(0.d0,0.0),zmat, pp%numc*pp%numv)
|
|
do iv=1,pp%numv
|
|
do ic=1,pp%numc
|
|
write(*,*) 'CHECK JAVC ik, ic,iv', ik, ic, iv, zmat(iv,ic,iv,ic)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
deallocate(zmat,zmat0,zmat1)
|
|
endif
|
|
return
|
|
END SUBROUTINE build_prod_proj
|
|
|
|
SUBROUTINE build_prod_mix(sin,bd,pd,pm,pt)
|
|
!this subroutine constructs the prod_mix object
|
|
!COMPLEX(kind=DP), DIMENSION(:,:,:,:,:), POINTER :: gvv! (nprod_e,numv,nk,numv,nk_loc)
|
|
!COMPLEX(kind=DP), DIMENSION(:,:,:,:,:), POINTER :: gcc! (nprod_e,numc,nk,numc,nk_loc)
|
|
|
|
USE input_simple_exc
|
|
USE simple_objects, ONLY : bands,product,potential
|
|
USE mp_world, ONLY : mpime, world_comm
|
|
USE mp, ONLY : mp_sum, mp_bcast
|
|
USE io_global, ONLY : stdout
|
|
|
|
implicit none
|
|
|
|
TYPE(input_options) :: sin
|
|
TYPE(bands), INTENT(in) :: bd
|
|
TYPE(product), INTENT(in) :: pd
|
|
TYPE(prod_mix), INTENT(out) :: pm
|
|
TYPE(potential) :: pt
|
|
|
|
INTEGER :: ik,iv,ic
|
|
COMPLEX(kind=DP), ALLOCATABLE :: tmp_mat(:,:,:),tmp_mat2(:,:),tmp_mat3(:,:,:)
|
|
LOGICAL, parameter :: debug = .true.
|
|
COMPLEX(kind=DP), ALLOCATABLE :: emat(:,:)
|
|
INTEGER :: is_mine
|
|
INTEGER :: jk
|
|
COMPLEX(kind=DP), ALLOCATABLE :: tmp_pot(:,:),tmp_fij(:,:,:)
|
|
INTEGER :: ii,jj,kk
|
|
|
|
pm%numv=bd%numv
|
|
pm%numc=bd%numc
|
|
pm%ntot_e=bd%ntot_e
|
|
pm%nk=bd%nk
|
|
pm%nk_loc=bd%nk_loc
|
|
pm%ik_first=bd%ik_first
|
|
pm%ik_last=bd%ik_last
|
|
pm%nprod_e=pd%nprod_e
|
|
if(pm%nk_loc>0) then
|
|
allocate( pm%gvv(pm%nprod_e,pm%numv,pm%nk,pm%numv,pm%nk_loc))
|
|
allocate( pm%gcc(pm%nprod_e,pm%numc,pm%nk,pm%numc,pm%nk_loc))
|
|
else
|
|
nullify(pm%gcc)
|
|
nullify(pm%gvv)
|
|
endif
|
|
!now do gvv
|
|
!loop on nk
|
|
!if ik is my distribute to others
|
|
!loop on nk_loc
|
|
!calculate terms
|
|
allocate(emat(pm%ntot_e,pm%numv))
|
|
allocate(tmp_mat2(pm%ntot_e,pm%numv))
|
|
allocate(tmp_mat(pm%nprod_e,pm%ntot_e,pm%numv))
|
|
allocate(tmp_mat3(pm%nprod_e,pm%numv,pm%numv))
|
|
allocate(tmp_pot(pm%nprod_e,pm%nprod_e))
|
|
allocate(tmp_fij(pm%nprod_e,pm%ntot_e,pm%ntot_e))
|
|
|
|
|
|
|
|
|
|
|
|
do ik=1,pm%nk
|
|
if(ik>=pm%ik_first.and.ik<=pm%ik_last) then
|
|
emat(1:pm%ntot_e,1:pm%numv)=bd%omat(1:pm%ntot_e,1:pm%numv,ik-pm%ik_first+1)
|
|
is_mine=mpime+1
|
|
else
|
|
is_mine=0
|
|
endif
|
|
call mp_sum(is_mine,world_comm)
|
|
is_mine=is_mine-1
|
|
call mp_bcast( emat,is_mine, world_comm )
|
|
|
|
do jk=1,pm%nk_loc!on k' local
|
|
|
|
!find out q=k_i-k_j
|
|
ii=pt%ijk(1,ik,jk+pm%ik_first-1)
|
|
jj=pt%ijk(2,ik,jk+pm%ik_first-1)
|
|
kk=pt%ijk(3,ik,jk+pm%ik_first-1)
|
|
tmp_pot(1:pm%nprod_e,1:pm%nprod_e)= pt%vpotq(1:pm%nprod_e,1:pm%nprod_e,ii,jj,kk)
|
|
|
|
|
|
|
|
!tmp_pot(1:pm%nprod_e,1:pm%nprod_e)=1.d0!DEBUG
|
|
if(sin%h_level >= 3) then
|
|
tmp_pot(1:pm%nprod_e,1:pm%nprod_e)= tmp_pot(1:pm%nprod_e,1:pm%nprod_e) +&
|
|
&pt%wpotq(1:pm%nprod_e,1:pm%nprod_e,ii,jj,kk)
|
|
endif
|
|
call ZGEMM('N','N',pm%nprod_e,pm%ntot_e*pm%ntot_e,pm%nprod_e,(-1.d0,0.d0),&
|
|
&tmp_pot,pm%nprod_e,pd%fij,pm%nprod_e,(0.d0,0.d0),tmp_fij,pm%nprod_e)
|
|
|
|
|
|
tmp_mat2(1:pm%ntot_e,1:pm%numv)=conjg(bd%omat(1:pm%ntot_e,1:pm%numv,jk))
|
|
!call ZGEMM('N','N',pm%nprod_e*pm%ntot_e,pm%numv,pm%ntot_e,(1.d0,0.d0),pd%fij,&
|
|
! &pm%nprod_e*pm%ntot_e,emat,pm%ntot_e,(0.d0,0.d0),tmp_mat,pm%nprod_e*pm%ntot_e)
|
|
|
|
call ZGEMM('N','N',pm%nprod_e*pm%ntot_e,pm%numv,pm%ntot_e,(1.d0,0.d0),tmp_fij,&
|
|
&pm%nprod_e*pm%ntot_e,emat,pm%ntot_e,(0.d0,0.d0),tmp_mat,pm%nprod_e*pm%ntot_e)
|
|
|
|
|
|
do iv=1,pm%numv
|
|
call ZGEMM('N','N',pm%nprod_e,pm%numv,pm%ntot_e,(1.d0,0.d0),tmp_mat(1,1,iv),pm%nprod_e,tmp_mat2,pm%ntot_e,&
|
|
&(0.d0,0.d0),tmp_mat3(1,1,iv),pm%nprod_e)
|
|
|
|
enddo
|
|
do iv=1,pm%numv
|
|
pm%gvv(1:pm%nprod_e,1:pm%numv,ik,iv,jk)=tmp_mat3(1:pm%nprod_e,iv,1:pm%numv)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
|
|
deallocate(emat)
|
|
deallocate(tmp_mat2)
|
|
deallocate(tmp_mat)
|
|
deallocate(tmp_mat3)
|
|
deallocate(tmp_pot)
|
|
deallocate(tmp_fij)
|
|
|
|
allocate(emat(pm%ntot_e,pm%numc))
|
|
allocate(tmp_mat2(pm%ntot_e,pm%numc))
|
|
allocate(tmp_mat(pm%nprod_e,pm%ntot_e,pm%numc))
|
|
allocate(tmp_mat3(pm%nprod_e,pm%numc,pm%numc))
|
|
|
|
do ik=1,pm%nk
|
|
if(ik>=pm%ik_first.and.ik<=pm%ik_last) then
|
|
emat(1:pm%ntot_e,1:pm%numc)=bd%omat(1:pm%ntot_e,pm%numv+1:pm%numv+pm%numc,ik-pm%ik_first+1)
|
|
is_mine=mpime+1
|
|
else
|
|
is_mine=0
|
|
endif
|
|
call mp_sum(is_mine,world_comm)
|
|
is_mine=is_mine-1
|
|
call mp_bcast( emat,is_mine, world_comm )
|
|
|
|
do jk=1,pm%nk_loc!on k' local
|
|
tmp_mat2(1:pm%ntot_e,1:pm%numc)=conjg(bd%omat(1:pm%ntot_e,pm%numv+1:pm%numv+pm%numc,jk))
|
|
call ZGEMM('N','N',pm%nprod_e*pm%ntot_e,pm%numc,pm%ntot_e,(1.d0,0.d0),pd%fij,&
|
|
&pm%nprod_e*pm%ntot_e,emat,pm%ntot_e,(0.d0,0.d0),tmp_mat,pm%nprod_e*pm%ntot_e)
|
|
do ic=1,pm%numc
|
|
call ZGEMM('N','N',pm%nprod_e,pm%numc,pm%ntot_e,(1.d0,0.d0),tmp_mat(1,1,ic),pm%nprod_e,tmp_mat2,pm%ntot_e,&
|
|
&(0.d0,0.d0),tmp_mat3(1,1,ic),pm%nprod_e)
|
|
|
|
enddo
|
|
do ic=1,pm%numc
|
|
pm%gcc(1:pm%nprod_e,1:pm%numc,ik,ic,jk)=tmp_mat3(1:pm%nprod_e,ic,1:pm%numc)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
|
|
deallocate(emat)
|
|
deallocate(tmp_mat2)
|
|
deallocate(tmp_mat)
|
|
deallocate(tmp_mat3)
|
|
|
|
|
|
|
|
|
|
END SUBROUTINE build_prod_mix
|
|
|
|
|
|
|
|
END MODULE derived_objects
|