- some more openmp parallelization (to speedup pseudo interpolation tables)

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@8319 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
ccavazzoni 2011-12-11 09:01:24 +00:00
parent b0f80f47c0
commit 18485aa4f8
1 changed files with 56 additions and 35 deletions

View File

@ -348,6 +348,8 @@
REAL(DP), ALLOCATABLE :: dfint(:), djl(:), fint(:), jl(:)
REAL(DP) :: xg
!
CALL start_clock('betagx')
!
IF( .NOT. ALLOCATED( rgrid ) ) &
CALL errore( ' compute_betagx_x ', ' rgrid not allocated ', 1 )
IF( .NOT. ALLOCATED( upf ) ) &
@ -363,6 +365,12 @@
!
nr = upf(is)%kkbeta
!
do iv = 1, nh(is)
!
l = nhtol(iv,is)
!
!$omp parallel default(none), private( dfint, djl, fint, jl, il, xg, ir ), &
!$omp shared( tpre, nr, mmx, refg, l, is, rgrid, upf, indv, iv, betagx, dbetagx, oldvan )
if ( tpre ) then
allocate( dfint( nr ) )
allocate( djl ( nr ) )
@ -371,11 +379,8 @@
allocate( fint ( nr ) )
allocate( jl ( nr ) )
!
do iv = 1, nh(is)
!
l = nhtol(iv,is)
!
do il = 1, mmx
!$omp do
interp_tab : do il = 1, mmx
!
xg = sqrt( refg * (il-1) )
call sph_bes ( nr, rgrid(is)%r, xg, l, jl )
@ -410,8 +415,8 @@
end if
endif
!
end do
end do
end do interp_tab
!$omp end do
!
deallocate(jl)
deallocate(fint)
@ -421,7 +426,12 @@
deallocate(dfint)
end if
!
!$omp end parallel
!
end do
!
end do
CALL stop_clock('betagx')
RETURN
END SUBROUTINE compute_betagx_x
@ -457,6 +467,8 @@
REAL(DP), ALLOCATABLE :: dfint(:), djl(:), fint(:), jl(:), qrl(:,:,:)
REAL(DP) :: xg
CALL start_clock('qradx')
IF( .NOT. ALLOCATED( rgrid ) ) &
CALL errore( ' compute_qradx_x ', ' rgrid not allocated ', 1 )
IF( .NOT. ALLOCATED( upf ) ) &
@ -479,6 +491,14 @@
!
nr = upf(is)%kkbeta
!
ALLOCATE( qrl( nr, upf(is)%nbeta*(upf(is)%nbeta+1)/2, upf(is)%nqlc) )
!
call fill_qrl ( is, qrl )
!
do l = 1, upf(is)%nqlc
!
!$omp parallel default(none), private( djl, dfint, fint, jl, il, iv, jv, ijv, xg, ir ), &
!$omp shared( tpre, nr, mmx, refg, rgrid, l, upf, qrl, oldvan, qradx, dqradx, is )
IF ( tpre ) THEN
ALLOCATE( djl ( nr ) )
ALLOCATE( dfint( nr ) )
@ -486,13 +506,8 @@
!
ALLOCATE( fint( nr ) )
ALLOCATE( jl ( nr ) )
ALLOCATE( qrl( nr, upf(is)%nbeta*(upf(is)%nbeta+1)/2, upf(is)%nqlc) )
!
call fill_qrl ( is, qrl )
!
do l = 1, upf(is)%nqlc
!
do il = 1, mmx
!$omp do
interp_tab : do il = 1, mmx
!
xg = sqrt( refg * DBLE(il-1) )
!
@ -539,11 +554,10 @@
end do
!
!
end do
end do
end do interp_tab
!$omp end do
!
DEALLOCATE ( jl )
DEALLOCATE ( qrl )
DEALLOCATE ( fint )
!
if ( tpre ) then
@ -551,6 +565,11 @@
DEALLOCATE ( dfint )
end if
!
!$omp end parallel
!
end do
!
DEALLOCATE ( qrl )
WRITE( stdout,*)
WRITE( stdout,'(20x,a)') ' qqq '
!
@ -561,6 +580,8 @@
!
end do
CALL stop_clock('qradx')
RETURN
END SUBROUTINE compute_qradx_x