Commit 43e8131c authored by Matthias Redies's avatar Matthias Redies

introduce OMP to loop

parent 3e2f7cc8
......@@ -67,7 +67,7 @@ CONTAINS
INTEGER :: ic, ic1, ic2, ic3, ic4
INTEGER :: igpt, igpt1, igpt2, igptp, igptp1, igptp2
INTEGER :: isym, isym1, isym2, igpt0
INTEGER :: ok
INTEGER :: ok, iatm1, iatm2
INTEGER :: m, im
INTEGER :: maxfac
......@@ -666,50 +666,48 @@ CONTAINS
! (1) igpt1 > 1 , igpt2 > 1 (finite G vectors)
call timestart("add corrections from higher orders")
rdum = (fpi_const)**(1.5)/fi%cell%vol**2*gmat(1, 1)
!$OMP PARALLEL DO default(none) schedule(dynamic) &
!$OMP private(igpt0, igpt2, ix, iqnrm2, igptp2, q2, qnorm2, igpt1, iy)&
!$OMP private(iqnrm1,igptp1,q1,qnorm1,rdum1,iatm1,itype1,iatm2,itype2,cdum)&
!$OMP shared(ngptm1, pgptm1, hybdat, mpdata, coulomb, sphbesmoment,pqnrm,fi,rdum)
DO igpt0 = 1, ngptm1(1)
igpt2 = pgptm1(igpt0, 1); IF (igpt2 == 1) CYCLE
igpt2 = pgptm1(igpt0, 1)
IF (igpt2 == 1) CYCLE
ix = hybdat%nbasp + igpt2
iqnrm2 = pqnrm(igpt2, 1)
igptp2 = mpdata%gptm_ptr(igpt2, 1)
q2 = MATMUL(mpdata%g(:, igptp2), fi%cell%bmat)
qnorm2 = norm2(q2)
iy = hybdat%nbasp + 1
DO igpt1 = 2, igpt2
iy = iy + 1
idum = ix*(ix - 1)/2 + iy
iy = hybdat%nbasp + igpt1
iqnrm1 = pqnrm(igpt1, 1)
igptp1 = mpdata%gptm_ptr(igpt1, 1)
q1 = MATMUL(mpdata%g(:, igptp1), fi%cell%bmat)
qnorm1 = norm2(q1)
rdum1 = dot_PRODUCT(q1, q2)/(qnorm1*qnorm2)
ic1 = 0
DO itype1 = 1, fi%atoms%ntype
DO ineq1 = 1, fi%atoms%neq(itype1)
ic1 = ic1 + 1
ic2 = 0
DO itype2 = 1, fi%atoms%ntype
DO ineq2 = 1, fi%atoms%neq(itype2)
ic2 = ic2 + 1
cdum = EXP(CMPLX(0.0, 1.0)*tpi_const* &
(-dot_PRODUCT(mpdata%g(:, igptp1), fi%atoms%taual(:, ic1)) &
+ dot_PRODUCT(mpdata%g(:, igptp2), fi%atoms%taual(:, ic2))))
coulomb(1)%data_c(iy, ix) = coulomb(1)%data_c(iy, ix) + rdum*cdum*( &
-sphbesmoment(1, itype1, iqnrm1) &
*sphbesmoment(1, itype2, iqnrm2)*rdum1/3 &
- sphbesmoment(0, itype1, iqnrm1) &
*sphbesmoment(2, itype2, iqnrm2)/6 &
- sphbesmoment(2, itype1, iqnrm1) &
*sphbesmoment(0, itype2, iqnrm2)/6 &
+ sphbesmoment(0, itype1, iqnrm1) &
*sphbesmoment(1, itype2, iqnrm2)/qnorm2/2 &
+ sphbesmoment(1, itype1, iqnrm1) &
*sphbesmoment(0, itype2, iqnrm2)/qnorm1/2)
END DO
END DO
do iatm1 = 1,fi%atoms%nat
itype1 = fi%atoms%itype(iatm1)
do iatm2 = 1,fi%atoms%nat
itype2 = fi%atoms%itype(iatm2)
cdum = EXP(CMPLX(0.0, 1.0)*tpi_const* &
(-dot_PRODUCT(mpdata%g(:, igptp1), fi%atoms%taual(:, iatm1)) &
+ dot_PRODUCT(mpdata%g(:, igptp2), fi%atoms%taual(:, iatm2))))
coulomb(1)%data_c(iy, ix) = coulomb(1)%data_c(iy, ix) + rdum*cdum*( &
-sphbesmoment(1, itype1, iqnrm1) &
*sphbesmoment(1, itype2, iqnrm2)*rdum1/3 &
- sphbesmoment(0, itype1, iqnrm1) &
*sphbesmoment(2, itype2, iqnrm2)/6 &
- sphbesmoment(2, itype1, iqnrm1) &
*sphbesmoment(0, itype2, iqnrm2)/6 &
+ sphbesmoment(0, itype1, iqnrm1) &
*sphbesmoment(1, itype2, iqnrm2)/qnorm2/2 &
+ sphbesmoment(1, itype1, iqnrm1) &
*sphbesmoment(0, itype2, iqnrm2)/qnorm1/2)
END DO
END DO
END DO
END DO
!$OMP END PARALLEL DO
call coulomb(1)%u2l()
......
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