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, This directory contains a library of pseudopotential-related code,
extracted from the Quantum ESPRESSO distribution. This library depends only extracted from the Quantum ESPRESSO distribution. This library depends only
upon some modules and routines of the UtilXlib and devXlib libraries, upon upon module mp.f90 of UtilXlib and upon a few modules and routines of devXlib;
a few LAPACK routines, and requires a suitable `../make.inc` file in Makefile. upon a few LAPACK routines; requires a suitable `../make.inc` file in Makefile.
Other than this, it can be independently compiled. Other than this, it can be independently compiled.
Currently, it includes Currently, it includes
@ -13,7 +13,7 @@ Currently, it includes
- setup of the interpolation tables and of other basic variables - setup of the interpolation tables and of other basic variables
- interpolation of pseudopotentials - interpolation of pseudopotentials
- generation of various pseudopotentials matrix elements - 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: Old UPF specifications can be found here:
http://www.quantum-espresso.org/pseudopotentials/unified-pseudopotential-format http://www.quantum-espresso.org/pseudopotentials/unified-pseudopotential-format
The xml schema for the newer UPF definition can be found here: 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) jvl = nhtolm(jh, np)
! !
IF (nb > nbetam .OR. mb > nbetam) & 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) & 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) 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 ELSEIF ( (lp>=37) .AND. (lp<=49) ) THEN
l = 7 l = 7
ELSE ELSE
CALL errore (' dqvan2 ', ' lp.gt.49 ', lp) CALL upf_error (' dqvan2 ', ' lp.gt.49 ', lp)
ENDIF ENDIF
! !
sig = (0.d0, -1.d0)**(l - 1) 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( vq_d, npw_, istat(4) )
CALL dev_buf%lock_buffer( ylm_d, (/ npw_, (lmaxkb + 1) **2 /), istat(5) ) CALL dev_buf%lock_buffer( ylm_d, (/ npw_, (lmaxkb + 1) **2 /), istat(5) )
CALL dev_buf%lock_buffer( gk_d, (/ 3, npw_ /), istat(6) ) 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. is_gth = .false.
do nt = 1, nsp 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. 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) :: 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 INTEGER :: nqx
REAL(DP), ALLOCATABLE :: tab0(:,:), tab(:,:), beta(:,:), betas(:,:) REAL(DP), ALLOCATABLE :: tab0(:,:), tab(:,:), beta(:,:), betas(:,:)
@ -150,7 +150,7 @@ SUBROUTINE init_us_b0(ecutwfc,intra_bgrp_comm)
end do end do
nf = min(nf+1,20) ; af = 1.125D0 * ( 2 * nf + 1); error_estimate = missing_norm * filter(1.d0,af,nf)**2 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 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 :', & 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) ' 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)=='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' 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 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)%nbeta > nbetam ) CALL upf_error('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)%kkbeta > ndm ) CALL upf_error('init_us_b0','wrong ndm in write_beta_r', ndm )
DO ir = 1, upf(nt)%kkbeta DO ir = 1, upf(nt)%kkbeta
WRITE(4,'(12f16.10)') rgrid(nt)%r(ir), (beta_(ir,nb), nb=1,upf(nt)%nbeta) WRITE(4,'(12f16.10)') rgrid(nt)%r(ir), (beta_(ir,nb), nb=1,upf(nt)%nbeta)
ENDDO ENDDO

6
upflib/qvan2.f90
View File

@ -81,9 +81,9 @@ SUBROUTINE qvan2( ngy, ih, jh, np, qmod, qg, ylmk0 )
jvl = nhtolm(jh,np) jvl = nhtolm(jh,np)
! !
IF (nb > nbetam .OR. mb > nbetam) & 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) & 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 qg = 0.0_DP
! !
@ -91,7 +91,7 @@ SUBROUTINE qvan2( ngy, ih, jh, np, qmod, qg, ylmk0 )
! !
DO lm = 1, lpx(ivl,jvl) DO lm = 1, lpx(ivl,jvl)
lp = lpl(ivl,jvl,lm) 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 ! ... 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) ! 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) ivl = nhtolm(ih, np)
jvl = nhtolm(jh, np) jvl = nhtolm(jh, np)
if (nb > nbetam .OR. mb > nbetam) & 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) & 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) #if defined(__CUDA)
tBlock = dim3(256,1,1) tBlock = dim3(256,1,1)
@ -211,7 +211,7 @@ subroutine qvan2_gpu (ngy, ih, jh, np, qmod_d, qg_d, ylmk0_d)
! !
#else #else
! possibly change this to call to CPU version... ! 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 #endif
! !
end subroutine qvan2_gpu 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 (abs (q) < eps14) then
if (l == -1) 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 elseif (l == 0) then
jl(:) = 1.d0 jl(:) = 1.d0
else else
@ -52,7 +52,7 @@ subroutine sph_bes (msh, r, q, l, jl)
! case l=-1 ! case l=-1
if (l == - 1) then 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) #if defined (__MASS)
@ -240,7 +240,7 @@ subroutine sph_bes (msh, r, q, l, jl)
else else
call errore ('sph_bes', 'not implemented', abs(l)) call upf_error ('sph_bes', 'not implemented', abs(l))
endif endif
! !
@ -291,7 +291,7 @@ SUBROUTINE sph_dbes ( nr, r, xg, l, jl, djl )
call sph_bes ( nr, r, xg, l+1, djl ) call sph_bes ( nr, r, xg, l+1, djl )
djl(:) = - djl(:) * (xg * r(:) ) djl(:) = - djl(:) * (xg * r(:) )
else 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
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 if (abs (q) < eps14) then
do ir = 1, msh do ir = 1, msh
if (l == -1) 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 elseif (l == 0) then
jl(ir) = 1.d0 jl(ir) = 1.d0
else else
@ -61,7 +61,7 @@ subroutine sph_bes_gpu (msh, r, q, l, jl)
! case l=-1 ! case l=-1
if (l == - 1) then 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 do ir = 1, msh
jl(ir) = cos (q * r (ir) ) / (q * r (ir) ) jl(ir) = cos (q * r (ir) ) / (q * r (ir) )
end do end do
@ -156,10 +156,10 @@ subroutine sph_bes_gpu (msh, r, q, l, jl)
!else !else
! !
! call errore ('sph_bes', 'not implemented', abs(l)) ! call upf_error ('sph_bes', 'not implemented', abs(l))
endif 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 end do
! !
return 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 real(DP) :: j ! total angular momentum
if (spin.ne.1.and.spin.ne.2) call errore('sph_ind','spin direction unknown',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 errore('sph_ind','m not allowed',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 (abs(j-l-0.5d0).lt.1.d-8) then
if (spin.eq.1) sph_ind= m if (spin.eq.1) sph_ind= m
@ -36,7 +36,7 @@ function sph_ind(l,j,m,spin)
endif endif
else else
write(6,*) l, j 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 endif
if (sph_ind.lt.-l.or.sph_ind.gt.l) sph_ind=0 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 REAL(DP) :: denom ! denominator
! !
IF ( spin/=1 .AND. spin/=2 ) CALL errore( 'spinor', 'spin direction unknown', 1 ) IF ( spin/=1 .AND. spin/=2 ) CALL upf_error( 'spinor', 'spin direction unknown', 1 )
IF ( m<-l-1 .OR. m>l ) CALL errore( 'spinor', 'm not allowed', 1 ) IF ( m<-l-1 .OR. m>l ) CALL upf_error( 'spinor', 'm not allowed', 1 )
! !
denom = 1.d0 / (2.d0*l+1.d0) 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) IF (spin == 2) spinor = -SQRT((l+m)*denom)
ENDIF ENDIF
ELSE ELSE
CALL errore( 'spinor', 'j and l not compatible', 1 ) CALL upf_error( 'spinor', 'j and l not compatible', 1 )
ENDIF ENDIF
! !
RETURN RETURN

6
upflib/uspp.f90
View File

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

4
upflib/uspp_data.f90
View File

@ -57,8 +57,8 @@ contains
logical, intent(in) :: use_gpu logical, intent(in) :: use_gpu
integer, intent(in) :: nqxq_,nqx_,nbetam,nwfcm,lmaxq,nsp integer, intent(in) :: nqxq_,nqx_,nbetam,nwfcm,lmaxq,nsp
! !
if (nqxq_/=nqxq) call errore("allocate_uspp_data","invalid nqxq_",1) if (nqxq_/=nqxq) call upf_error("allocate_uspp_data","invalid nqxq_",1)
if (nqx_/=nqx) call errore("allocate_uspp_data","invalid nqx_",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)) if (lmaxq>0) allocate(qrad(nqxq_,nbetam*(nbetam+1)/2, lmaxq, nsp))
allocate(tab(nqx_,nbetam,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 do lmax = 0, 25
if ((lmax+1)**2 == lmax2) go to 10 if ((lmax+1)**2 == lmax2) go to 10
end do 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 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 do lmax = 0, 25
if ((lmax+1)**2 == lmax2) go to 10 if ((lmax+1)**2 == lmax2) go to 10
end do 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 10 continue
@ -178,7 +178,7 @@ subroutine ylmr2_gpu(lmax2, ng, g_d, gg_d, ylm_d)
do lmax = 0, 25 do lmax = 0, 25
if ((lmax+1)**2 == lmax2) go to 10 if ((lmax+1)**2 == lmax2) go to 10
end do 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 10 continue
! !
if (lmax == 0) then if (lmax == 0) then