scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

errore => upf_error

This commit is contained in:
Paolo Giannozzi 2021-04-09 07:57:24 +02:00
parent 1be78cba17
commit 29b8eb1bc2
14 changed files with 39 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
upflib/README.md
View File

@ -3,8 +3,8 @@
This directory contains a library of pseudopotential-related code,
extracted from the Quantum ESPRESSO distribution. This library depends only
upon some modules and routines of the UtilXlib and devXlib libraries, upon
a few LAPACK routines, and requires a suitable `../make.inc` file in Makefile.
upon module mp.f90 of UtilXlib and upon a few modules and routines of devXlib;
upon a few LAPACK routines; requires a suitable `../make.inc` file in Makefile.
Other than this, it can be independently compiled.
Currently, it includes
@ -13,7 +13,7 @@ Currently, it includes
- setup of the interpolation tables and of other basic variables
- interpolation of pseudopotentials
- generation of various pseudopotentials matrix elements
- utilities: speherical harmonics, integration routines, etc.
- utilities: spherical harmonics and Bessel functions, integration routines
Old UPF specifications can be found here:
http://www.quantum-espresso.org/pseudopotentials/unified-pseudopotential-format
The xml schema for the newer UPF definition can be found here:

6
upflib/dqvan2.f90
View File

@ -87,9 +87,9 @@ SUBROUTINE dqvan2( ih, jh, np, ipol, ngy, g, tpiba, qmod, ylmk0, dylmk0, dqg )
jvl = nhtolm(jh, np)
!
IF (nb > nbetam .OR. mb > nbetam) &
CALL errore (' dqvan2 ', ' wrong dimensions (1)', MAX(nb,mb))
CALL upf_error (' dqvan2 ', ' wrong dimensions (1)', MAX(nb,mb))
IF (ivl > nlx .OR. jvl > nlx) &
CALL errore (' dqvan2 ', ' wrong dimensions (2)', MAX(ivl,jvl))
CALL upf_error (' dqvan2 ', ' wrong dimensions (2)', MAX(ivl,jvl))
!
dqg(:) = (0.d0,0.d0)
!
@ -115,7 +115,7 @@ SUBROUTINE dqvan2( ih, jh, np, ipol, ngy, g, tpiba, qmod, ylmk0, dylmk0, dqg )
ELSEIF ( (lp>=37) .AND. (lp<=49) ) THEN
l = 7
ELSE
CALL errore (' dqvan2 ', ' lp.gt.49 ', lp)
CALL upf_error (' dqvan2 ', ' lp.gt.49 ', lp)
ENDIF
!
sig = (0.d0, -1.d0)**(l - 1)

2
upflib/init_us_2_base_gpu.f90
View File

@ -98,7 +98,7 @@ SUBROUTINE init_us_2_base_gpu( npw_, npwx, igk__d, q_, nat, tau, ityp, &
CALL dev_buf%lock_buffer( vq_d, npw_, istat(4) )
CALL dev_buf%lock_buffer( ylm_d, (/ npw_, (lmaxkb + 1) **2 /), istat(5) )
CALL dev_buf%lock_buffer( gk_d, (/ 3, npw_ /), istat(6) )
IF (ANY(istat /= 0)) CALL errore( 'init_us_2_gpu', 'cannot allocate buffers', -1 )
IF (ANY(istat /= 0)) CALL upf_error( 'init_us_2_gpu', 'cannot allocate buffers', -1 )
is_gth = .false.
do nt = 1, nsp

8
upflib/init_us_b0.f90
View File

@ -31,7 +31,7 @@ SUBROUTINE init_us_b0(ecutwfc,intra_bgrp_comm)
LOGICAL, PARAMETER :: tprint=.FALSE. ! Whether the beta_l(r) and its relatives are printed or not.
REAL(DP) :: rcut, drcut ! beta function cutoff radius and its estimated increase due to the filtering
REAL(DP), PARAMETER :: eps = 1.d-9 ! error tollerance for intergrals, norms etc.
REAL(DP), PARAMETER :: eps = 1.d-9 ! error tolerance for integrals, norms etc.
!
INTEGER :: nqx
REAL(DP), ALLOCATABLE :: tab0(:,:), tab(:,:), beta(:,:), betas(:,:)
@ -150,7 +150,7 @@ SUBROUTINE init_us_b0(ecutwfc,intra_bgrp_comm)
end do
nf = min(nf+1,20) ; af = 1.125D0 * ( 2 * nf + 1); error_estimate = missing_norm * filter(1.d0,af,nf)**2
WRITE ( stdout, '(5x,"Smoothing truncation error estimate in Q",1pe12.4," < eps")' ) error_estimate
IF (error_estimate > eps ) CALL errore( 'init_us_b0','R and Q norms of beta are too different',nt)
IF (error_estimate > eps ) CALL upf_error( 'init_us_b0','R and Q norms of beta are too different',nt)
WRITE(6,'(5X,a,a,f6.2,a,i4,2(a,f11.8))') 'FILTER parameters :', &
' a=',af,', nn=',nf,', filter(1.0/3)=', filter(1.d0/3,af,nf), ', filter(1.0)=', filter(1.d0,af,nf)
!
@ -282,8 +282,8 @@ SUBROUTINE init_us_b0(ecutwfc,intra_bgrp_comm)
if (filename(1:3)=='br_') WRITE(4,*) '# the radial beta_l(r) as defined in the pseudopotential'
if (filename(1:3)=='brq') WRITE(4,*) '# the back radial fourier transform of beta_l in real space'
WRITE(4,*) '# nbeta :', upf(nt)%nbeta,' kkbeta :',upf(nt)%kkbeta
if ( upf(nt)%nbeta > nbetam ) CALL errore('init_us_b0','wrong nbetam in write_beta_r', nbetam )
if ( upf(nt)%kkbeta > ndm ) CALL errore('init_us_b0','wrong ndm in write_beta_r', ndm )
if ( upf(nt)%nbeta > nbetam ) CALL upf_error('init_us_b0','wrong nbetam in write_beta_r', nbetam )
if ( upf(nt)%kkbeta > ndm ) CALL upf_error('init_us_b0','wrong ndm in write_beta_r', ndm )
DO ir = 1, upf(nt)%kkbeta
WRITE(4,'(12f16.10)') rgrid(nt)%r(ir), (beta_(ir,nb), nb=1,upf(nt)%nbeta)
ENDDO

6
upflib/qvan2.f90
View File

@ -81,9 +81,9 @@ SUBROUTINE qvan2( ngy, ih, jh, np, qmod, qg, ylmk0 )
jvl = nhtolm(jh,np)
!
IF (nb > nbetam .OR. mb > nbetam) &
CALL errore( ' qvan2 ', ' wrong dimensions (1)', MAX(nb,mb) )
CALL upf_error( ' qvan2 ', ' wrong dimensions (1)', MAX(nb,mb) )
IF (ivl > nlx .OR. jvl > nlx) &
CALL errore( ' qvan2 ', ' wrong dimensions (2)', MAX(ivl,jvl) )
CALL upf_error( ' qvan2 ', ' wrong dimensions (2)', MAX(ivl,jvl) )
!
qg = 0.0_DP
!
@ -91,7 +91,7 @@ SUBROUTINE qvan2( ngy, ih, jh, np, qmod, qg, ylmk0 )
!
DO lm = 1, lpx(ivl,jvl)
lp = lpl(ivl,jvl,lm)
IF ( lp < 1 .OR. lp > 49 ) CALL errore( 'qvan2', ' lp wrong ', MAX(lp,1) )
IF ( lp < 1 .OR. lp > 49 ) CALL upf_error( 'qvan2', ' lp wrong ', MAX(lp,1) )
!
! ... finds angular momentum l corresponding to combined index lp (l is
! actually l+1 because this is the way qrad is stored, check init_us_1)

6
upflib/qvan2_gpu.f90
View File

@ -200,9 +200,9 @@ subroutine qvan2_gpu (ngy, ih, jh, np, qmod_d, qg_d, ylmk0_d)
ivl = nhtolm(ih, np)
jvl = nhtolm(jh, np)
if (nb > nbetam .OR. mb > nbetam) &
call errore (' qvan2 ', ' wrong dimensions (1)', MAX(nb,mb))
call upf_error (' qvan2 ', ' wrong dimensions (1)', MAX(nb,mb))
if (ivl > nlx .OR. jvl > nlx) &
call errore (' qvan2 ', ' wrong dimensions (2)', MAX(ivl,jvl))
call upf_error (' qvan2 ', ' wrong dimensions (2)', MAX(ivl,jvl))
!
#if defined(__CUDA)
tBlock = dim3(256,1,1)
@ -211,7 +211,7 @@ subroutine qvan2_gpu (ngy, ih, jh, np, qmod_d, qg_d, ylmk0_d)
!
#else
! possibly change this to call to CPU version...
CALL errore('qvan2_gpu', 'Trying to use device subroutine but code was not compiled with device support!', 1)
CALL upf_error('qvan2_gpu', 'Trying to use device subroutine but code was not compiled with device support!', 1)
#endif
!
end subroutine qvan2_gpu

8
upflib/sph_bes.f90
View File

@ -40,7 +40,7 @@ subroutine sph_bes (msh, r, q, l, jl)
if (abs (q) < eps14) then
if (l == -1) then
call errore ('sph_bes', 'j_{-1}(0) ?!?', 1)
call upf_error ('sph_bes', 'j_{-1}(0) ?!?', 1)
elseif (l == 0) then
jl(:) = 1.d0
else
@ -52,7 +52,7 @@ subroutine sph_bes (msh, r, q, l, jl)
! case l=-1
if (l == - 1) then
if (abs (q * r (1) ) < eps14) call errore ('sph_bes', 'j_{-1}(0) ?!?',1)
if (abs (q * r (1) ) < eps14) call upf_error ('sph_bes', 'j_{-1}(0) ?!?',1)
#if defined (__MASS)
@ -240,7 +240,7 @@ subroutine sph_bes (msh, r, q, l, jl)
else
call errore ('sph_bes', 'not implemented', abs(l))
call upf_error ('sph_bes', 'not implemented', abs(l))
endif
!
@ -291,7 +291,7 @@ SUBROUTINE sph_dbes ( nr, r, xg, l, jl, djl )
call sph_bes ( nr, r, xg, l+1, djl )
djl(:) = - djl(:) * (xg * r(:) )
else
call errore('sph_dbes','l < 0 not implemented', abs(l) )
call upf_error('sph_dbes','l < 0 not implemented', abs(l) )
end if
end if
!

8
upflib/sph_bes_gpu.f90
View File

@ -48,7 +48,7 @@ subroutine sph_bes_gpu (msh, r, q, l, jl)
if (abs (q) < eps14) then
do ir = 1, msh
if (l == -1) then
!call errore ('sph_bes', 'j_{-1}(0) ?!?', 1)
!call upf_error ('sph_bes', 'j_{-1}(0) ?!?', 1)
elseif (l == 0) then
jl(ir) = 1.d0
else
@ -61,7 +61,7 @@ subroutine sph_bes_gpu (msh, r, q, l, jl)
! case l=-1
if (l == - 1) then
! if (abs (q * r (1) ) < eps14) call errore ('sph_bes', 'j_{-1}(0) ?!?',1)
! if (abs (q * r (1) ) < eps14) call upf_error ('sph_bes', 'j_{-1}(0) ?!?',1)
do ir = 1, msh
jl(ir) = cos (q * r (ir) ) / (q * r (ir) )
end do
@ -156,10 +156,10 @@ subroutine sph_bes_gpu (msh, r, q, l, jl)
!else
!
! call errore ('sph_bes', 'not implemented', abs(l))
! call upf_error ('sph_bes', 'not implemented', abs(l))
endif
!if (l > 6 ) call errore ('sph_bes', 'not implemented', abs(l))
!if (l > 6 ) call upf_error ('sph_bes', 'not implemented', abs(l))
end do
!
return

6
upflib/sph_ind.f90
View File

@ -21,8 +21,8 @@ function sph_ind(l,j,m,spin)
real(DP) :: j ! total angular momentum
if (spin.ne.1.and.spin.ne.2) call errore('sph_ind','spin direction unknown',1)
if (m.lt.-l-1.or.m.gt.l) call errore('sph_ind','m not allowed',1)
if (spin.ne.1.and.spin.ne.2) call upf_error('sph_ind','spin direction unknown',1)
if (m.lt.-l-1.or.m.gt.l) call upf_error('sph_ind','m not allowed',1)
if (abs(j-l-0.5d0).lt.1.d-8) then
if (spin.eq.1) sph_ind= m
@ -36,7 +36,7 @@ function sph_ind(l,j,m,spin)
endif
else
write(6,*) l, j
call errore('sph_ind','l and j not compatible',1)
call upf_error('sph_ind','l and j not compatible',1)
endif
if (sph_ind.lt.-l.or.sph_ind.gt.l) sph_ind=0

6
upflib/spinor.f90
View File

@ -32,8 +32,8 @@ FUNCTION spinor( l, j, m, spin )
!
REAL(DP) :: denom ! denominator
!
IF ( spin/=1 .AND. spin/=2 ) CALL errore( 'spinor', 'spin direction unknown', 1 )
IF ( m<-l-1 .OR. m>l ) CALL errore( 'spinor', 'm not allowed', 1 )
IF ( spin/=1 .AND. spin/=2 ) CALL upf_error( 'spinor', 'spin direction unknown', 1 )
IF ( m<-l-1 .OR. m>l ) CALL upf_error( 'spinor', 'm not allowed', 1 )
!
denom = 1.d0 / (2.d0*l+1.d0)
!
@ -48,7 +48,7 @@ FUNCTION spinor( l, j, m, spin )
IF (spin == 2) spinor = -SQRT((l+m)*denom)
ENDIF
ELSE
CALL errore( 'spinor', 'j and l not compatible', 1 )
CALL upf_error( 'spinor', 'j and l not compatible', 1 )
ENDIF
!
RETURN

6
upflib/uspp.f90
View File

@ -414,8 +414,8 @@ CONTAINS
logical, intent(in) :: noncolin,lspinorb,tqr
integer, intent(in) :: nhm,nsp,nat,nspin
!
!if (nhm_/=nhm) call errore("allocate_uspp","invalid nhm",1)
!if (nsp_/=nsp) call errore("allocate_uspp","invalid nsp",1)
!if (nhm_/=nhm) call upf_error("allocate_uspp","invalid nhm",1)
!if (nsp_/=nsp) call upf_error("allocate_uspp","invalid nsp",1)
!
allocate( indv(nhm,nsp) )
allocate( nhtol(nhm,nsp) )
@ -561,7 +561,7 @@ CONTAINS
ENDIF
IF (intento > 0) vkb_ood = .true.
#else
CALL errore('using_vkb_d', 'no GPU support', 1)
CALL upf_error('using_vkb_d', 'no GPU support', 1)
#endif
END SUBROUTINE using_vkb_d
!

4
upflib/uspp_data.f90
View File

@ -57,8 +57,8 @@ contains
logical, intent(in) :: use_gpu
integer, intent(in) :: nqxq_,nqx_,nbetam,nwfcm,lmaxq,nsp
!
if (nqxq_/=nqxq) call errore("allocate_uspp_data","invalid nqxq_",1)
if (nqx_/=nqx) call errore("allocate_uspp_data","invalid nqx_",1)
if (nqxq_/=nqxq) call upf_error("allocate_uspp_data","invalid nqxq_",1)
if (nqx_/=nqx) call upf_error("allocate_uspp_data","invalid nqx_",1)
!
if (lmaxq>0) allocate(qrad(nqxq_,nbetam*(nbetam+1)/2, lmaxq, nsp))
allocate(tab(nqx_,nbetam,nsp))

2
upflib/ylmr2.f90
View File

@ -40,7 +40,7 @@ subroutine ylmr2 (lmax2, ng, g, gg, ylm)
do lmax = 0, 25
if ((lmax+1)**2 == lmax2) go to 10
end do
call errore (' ylmr', 'l > 25 or wrong number of Ylm required',lmax2)
call upf_error (' ylmr', 'l > 25 or wrong number of Ylm required',lmax2)
10 continue
!

4
upflib/ylmr2_gpu.f90
View File

@ -154,7 +154,7 @@ subroutine ylmr2_gpu(lmax2, ng, g_d, gg_d, ylm_d)
do lmax = 0, 25
if ((lmax+1)**2 == lmax2) go to 10
end do
call errore (' ylmr', 'l > 25 or wrong number of Ylm required',lmax2)
call upf_error (' ylmr', 'l > 25 or wrong number of Ylm required',lmax2)
10 continue
@ -178,7 +178,7 @@ subroutine ylmr2_gpu(lmax2, ng, g_d, gg_d, ylm_d)
do lmax = 0, 25
if ((lmax+1)**2 == lmax2) go to 10
end do
call errore (' ylmr', 'l > 25 or wrong number of Ylm required',lmax2)
call upf_error (' ylmr', 'l > 25 or wrong number of Ylm required',lmax2)
10 continue
!
if (lmax == 0) then