hs_int.F90 3.64 KB
 Daniel Wortmann committed Feb 26, 2018 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 ``````!-------------------------------------------------------------------------------- ! Copyright (c) 2016 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_hs_int CONTAINS !Subroutine to construct the interstitial Hamiltonian and overlap matrix SUBROUTINE hs_int(input,noco,stars,lapw,mpi,cell,isp,vpw,& smat,hmat) USE m_types IMPLICIT NONE TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco TYPE(t_stars),INTENT(IN) :: stars TYPE(t_cell),INTENT(IN) :: cell TYPE(t_lapw),INTENT(IN) :: lapw TYPE(t_mpi),INTENT(IN) :: mpi INTEGER,INTENT(IN) :: isp COMPLEX,INTENT(IN) :: vpw(:,:) CLASS(t_mat),INTENT(INOUT) :: smat(:,:),hmat(:,:) `````` 25 `````` INTEGER :: ispin,jspin !spin indices `````` Daniel Wortmann committed Feb 26, 2018 26 27 28 29 30 31 32 33 34 35 `````` INTEGER :: i,j,ii(3),iispin,jjspin,i0 INTEGER :: in COMPLEX :: th,ts,phase REAL :: b1(3),b2(3),r2 IF (noco%l_noco.AND.isp==2) RETURN !was done already DO ispin=MERGE(1,isp,noco%l_noco),MERGE(2,isp,noco%l_noco) iispin=MIN(ispin,SIZE(smat,1)) DO jspin=MERGE(1,isp,noco%l_noco),MERGE(2,isp,noco%l_noco) jjspin=MIN(jspin,SIZE(smat,1)) `````` 36 `````` `````` Daniel Wortmann committed Feb 26, 2018 37 38 `````` !\$OMP PARALLEL DO SCHEDULE(dynamic) DEFAULT(none) & !\$OMP SHARED(mpi,lapw,stars,input,cell,vpw) & `````` 39 `````` !\$OMP SHARED(jjspin,iispin,ispin,jspin)& `````` Daniel Wortmann committed Feb 26, 2018 40 41 42 43 44 45 `````` !\$OMP SHARED(hmat,smat)& !\$OMP PRIVATE(ii,i0,i,j,in,phase,b1,b2,r2,th,ts) DO i = mpi%n_rank+1,lapw%nv(ispin),mpi%n_size i0=(i-1)/mpi%n_size+1 !---> loop over (k+g) DO j = 1,i `````` 46 47 48 49 50 51 52 53 54 55 56 57 `````` ii = lapw%gvec(:,i,jspin) - lapw%gvec(:,j,ispin) IF (ispin==1.AND.jspin==2) THEN in = stars%ig(ii(1),ii(2),ii(3)) IF (in.EQ.0) CYCLE th = stars%rgphs(ii(1),ii(2),ii(3))*vpw(in,3) ts=0.0 ELSEIF(ispin==2.and.jspin==1) THEN ii = -1*ii in = stars%ig(ii(1),ii(2),ii(3)) IF (in.EQ.0) CYCLE th = stars%rgphs(ii(1),ii(2),ii(3))*CONJG(vpw(in,3)) ts=0.0 `````` Daniel Wortmann committed Feb 26, 2018 58 `````` ELSE `````` 59 60 61 62 63 64 65 66 67 68 `````` !--> determine index and phase factor in = stars%ig(ii(1),ii(2),ii(3)) IF (in.EQ.0) CYCLE phase = stars%rgphs(ii(1),ii(2),ii(3)) ts = phase*stars%ustep(in) IF (input%l_useapw) THEN b1=lapw%bkpt+lapw%gvec(:,i,ispin) b2=lapw%bkpt+lapw%gvec(:,j,jspin) r2 = DOT_PRODUCT(MATMUL(b2,cell%bbmat),b1) th = phase*(0.5*r2*stars%ustep(in)+vpw(in,ispin)) `````` Daniel Wortmann committed Feb 26, 2018 69 `````` ELSE `````` 70 `````` th = phase* (0.25* (lapw%rk(i,ispin)**2+lapw%rk(j,jspin)**2)*stars%ustep(in) + vpw(in,ispin)) `````` Daniel Wortmann committed Feb 26, 2018 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 `````` ENDIF ENDIF !---> determine matrix element and store IF (hmat(1,1)%l_real) THEN hmat(jjspin,iispin)%data_r(j,i0) = REAL(th) smat(jjspin,iispin)%data_r(j,i0) = REAL(ts) else hmat(jjspin,iispin)%data_c(j,i0) = th smat(jjspin,iispin)%data_c(j,i0) = ts endif ENDDO ENDDO !\$OMP END PARALLEL DO ENDDO ENDDO END SUBROUTINE hs_int END MODULE m_hs_int``````