Commit b974b6da authored by Pietro's avatar Pietro

Merge branch 'develop' into gpu-develop

parents bb5b0321 bb672f62
Pipeline #173993632 passed with stage
in 271 minutes and 49 seconds
......@@ -299,7 +299,9 @@ SUBROUTINE laxlib_cdiaghg_gpu( n, m, h_d, s_d, ldh, e_d, v_d, me_bgrp, root_bgrp
IF( info /= 0 ) CALL lax_error__( ' cdiaghg_gpu ', ' cannot allocate h_bkp_d or s_bkp_d ', ABS( info ) )
#else
CALL dev%lock_buffer( h_bkp_d, (/ n, n /), info )
IF( info /= 0 ) CALL lax_error__( ' cdiaghg_gpu ', ' cannot allocate h_bkp_d ', ABS( info ) )
CALL dev%lock_buffer( s_bkp_d, (/ n, n /), info )
IF( info /= 0 ) CALL lax_error__( ' cdiaghg_gpu ', ' cannot allocate s_bkp_d ', ABS( info ) )
#endif
!
!$cuf kernel do(2)
......@@ -363,7 +365,9 @@ SUBROUTINE laxlib_cdiaghg_gpu( n, m, h_d, s_d, ldh, e_d, v_d, me_bgrp, root_bgrp
CALL pin%lock_buffer( e_h, n, info )
!
CALL dev%lock_buffer( h_diag_d, n, info )
IF( info /= 0 ) CALL lax_error__( ' cdiaghg_gpu ', ' cannot allocate h_bkp_d ', ABS( info ) )
CALL dev%lock_buffer( s_diag_d, n, info )
IF( info /= 0 ) CALL lax_error__( ' cdiaghg_gpu ', ' cannot allocate s_bkp_d ', ABS( info ) )
#endif
!
lwork = n
......@@ -386,7 +390,9 @@ SUBROUTINE laxlib_cdiaghg_gpu( n, m, h_d, s_d, ldh, e_d, v_d, me_bgrp, root_bgrp
CALL pin%lock_buffer(rwork, lrwork, info)
CALL pin%lock_buffer(iwork, liwork, info)
CALL dev%lock_buffer( work_d, lwork_d, info)
IF( info /= 0 ) CALL lax_error__( ' cdiaghg_gpu ', ' cannot allocate work_d ', ABS( info ) )
CALL dev%lock_buffer( rwork_d, lrwork_d, info)
IF( info /= 0 ) CALL lax_error__( ' cdiaghg_gpu ', ' cannot allocate rwork_d ', ABS( info ) )
#endif
!
!$cuf kernel do(1) <<<*,*>>>
......
......@@ -290,6 +290,7 @@ SUBROUTINE laxlib_rdiaghg_gpu( n, m, h_d, s_d, ldh, e_d, v_d, me_bgrp, root_bgrp
ALLOCATE(work_d(1*lwork_d), STAT = info)
#else
CALL dev%lock_buffer( work_d, lwork_d, info )
IF( info /= 0 ) CALL lax_error__( ' rdiaghg_gpu ', ' cannot allocate work_d ', ABS( info ) )
#endif
IF( info /= 0 ) CALL lax_error__( ' rdiaghg_gpu ', ' allocate work_d ', ABS( info ) )
!
......@@ -330,7 +331,9 @@ SUBROUTINE laxlib_rdiaghg_gpu( n, m, h_d, s_d, ldh, e_d, v_d, me_bgrp, root_bgrp
IF( info /= 0 ) CALL lax_error__( ' rdiaghg_gpu ', ' cannot allocate h_bkp_d or s_bkp_d ', ABS( info ) )
#else
CALL dev%lock_buffer( h_bkp_d, (/ n, n /), info )
IF( info /= 0 ) CALL lax_error__( ' rdiaghg_gpu ', ' cannot allocate h_bkp_d ', ABS( info ) )
CALL dev%lock_buffer( s_bkp_d, (/ n, n /), info )
IF( info /= 0 ) CALL lax_error__( ' rdiaghg_gpu ', ' cannot allocate s_bkp_d ', ABS( info ) )
#endif
!$cuf kernel do(2)
......@@ -354,6 +357,7 @@ SUBROUTINE laxlib_rdiaghg_gpu( n, m, h_d, s_d, ldh, e_d, v_d, me_bgrp, root_bgrp
IF( info /= 0 ) CALL lax_error__( ' rdiaghg_gpu ', ' cannot allocate work_d ', ABS( info ) )
#else
CALL dev%lock_buffer( work_d, lwork_d, info )
IF( info /= 0 ) CALL lax_error__( ' rdiaghg_gpu ', ' allocate work_d ', ABS( info ) )
#endif
info = cusolverDnDsygvdx(cuSolverHandle, CUSOLVER_EIG_TYPE_1, CUSOLVER_EIG_MODE_VECTOR, &
CUSOLVER_EIG_RANGE_I, CUBLAS_FILL_MODE_UPPER, &
......
......@@ -285,6 +285,7 @@ USE mp, ONLY : mp_sum
USE mp_global, ONLY : intra_bgrp_comm
USE noncollin_module, ONLY : noncolin, npol
USE matrix_inversion, ONLY : invmat
USE spin_orb, ONLY : lspinorb
IMPLICIT NONE
!
......@@ -370,6 +371,7 @@ DO ik1 = 1, nksq
psr(ikb,ii) = psr(ikb,ii) + bbg(jkb,ii) &
* qq_nt(ih,jh,nt)
ELSEIF(noncolin) THEN
IF (lspinorb) THEN
ijs=0
DO ipol=1, npol
ikbs = ikb + nkb * ( ipol - 1 )
......@@ -380,6 +382,10 @@ DO ik1 = 1, nksq
bbnc_aux(jkb,ii)*qq_so(ih,jh,ijs,nt)
ENDDO
ENDDO
ELSE
CALL errore( 'lr_sm1_initialize', &
& 'noncolin=.true. and lspinorb=.false. is not implemented', 1 )
ENDIF
ELSE
ps(ikb,ii) = ps(ikb,ii) + bbk(jkb,ii,ik1) &
* qq_nt(ih,jh,nt)
......@@ -452,6 +458,7 @@ DO ik1 = 1, nksq
- psr(ii,ikb) * qq_nt(ih,jh,nt)
ELSEIF (noncolin) THEN
IF (lspinorb) THEN
kjs = 0
DO kpol=1,npol
ikbs = ikb + nkb * (kpol-1)
......@@ -463,6 +470,10 @@ DO ik1 = 1, nksq
ps(ii,ikbs)*qq_so(ih,jh,kjs,nt)
ENDDO
ENDDO
ELSE
CALL errore( 'lr_sm1_initialize', &
& 'noncolin=.true. and lspinorb=.false. is not implemented', 1 )
ENDIF
ELSE
bbk(ii,jkb,ik1) = bbk(ii,jkb,ik1) - &
ps(ii,ikb) * qq_nt(ih,jh,nt)
......
......@@ -65,7 +65,7 @@ END FUNCTION make_emended_upf_copy
FUNCTION check(in) RESULT (out)
CHARACTER (LEN = *) :: in
#if defined(__PGI)
INTEGER, PARAMETER :: length = 255
INTEGER, PARAMETER :: length = 1024
CHARACTER(LEN=length ) :: out
#else
CHARACTER(LEN = LEN(in) ) :: out
......@@ -83,5 +83,7 @@ FUNCTION check(in) RESULT (out)
out(o:o) = in (i:i)
END IF
END DO
IF (o > len(in)) CALL upf_error('emend_upf/check', &
'BEWARE !!! Possible out of bounds while fixing pseudo', -1 )
END FUNCTION check
END MODULE emend_upf_module
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