From c7f5a80894d2a3b30c3fd41b4fdc867bd25c3522 Mon Sep 17 00:00:00 2001 From: Pietro Bonfa Date: Mon, 3 Aug 2020 13:21:30 +0200 Subject: [PATCH 1/3] Always check GPU allocations to avoid misleading error messages in accelerated subroutines --- LAXlib/cdiaghg.f90 | 6 ++++++ LAXlib/rdiaghg.f90 | 4 ++++ 2 files changed, 10 insertions(+) diff --git a/LAXlib/cdiaghg.f90 b/LAXlib/cdiaghg.f90 index cb02a95dfc..7ab9bdb139 100644 --- a/LAXlib/cdiaghg.f90 +++ b/LAXlib/cdiaghg.f90 @@ -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) <<<*,*>>> diff --git a/LAXlib/rdiaghg.f90 b/LAXlib/rdiaghg.f90 index d10e4d3c92..30e575d012 100644 --- a/LAXlib/rdiaghg.f90 +++ b/LAXlib/rdiaghg.f90 @@ -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, & From b950fe0200c9fa00e0e341060e5536ac8d08bdf6 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Mon, 3 Aug 2020 17:17:10 +0200 Subject: [PATCH 2/3] Minor changes: documentation, error message --- Doc/release-notes | 2 +- Modules/io_files.f90 | 7 ++++--- PW/src/makov_payne.f90 | 9 ++++++--- 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/Doc/release-notes b/Doc/release-notes index 0cc1e7359e..6796113150 100644 --- a/Doc/release-notes +++ b/Doc/release-notes @@ -39,7 +39,7 @@ New in v. 6.6: Fixed in v.6.6: * PW: Restart from interrupted calculations simplified. As a side effect, NEB restart now works again - * A few LIBXC glitches + * Various LIBXC glitches, missing check on metaGGA+USPP/PAW not implemented * Fermi energy incorrectly written to xml file in 'bands' calculation (did not affect results, just Fermi energy position in band plotting) Also: Fermi energy always written to xml file, also for insulators diff --git a/Modules/io_files.f90 b/Modules/io_files.f90 index 1845fe563d..9ff4df5451 100644 --- a/Modules/io_files.f90 +++ b/Modules/io_files.f90 @@ -185,7 +185,8 @@ SUBROUTINE check_tempdir ( tmp_dir, exst, pfs ) IF ( ionode ) ios = f_mkdir_safe( tmp_dir(1:length) ) CALL mp_bcast ( ios, ionode_id, intra_image_comm ) exst = ( ios == -1 ) - IF ( ios > 0 ) CALL errore ('check_tempdir','tmp_dir cannot be opened',1) + IF ( ios > 0 ) CALL errore ('check_tempdir', 'temporary directory ' & + & // tmp_dir(1:length) // ' cannot be created or accessed',1) ! ! ... let us check now if tmp_dir is visible on all nodes ! ... if not, a local tmp_dir is created on each node @@ -591,13 +592,13 @@ SUBROUTINE davcio( vect, nword, unit, nrec, io ) ! READ( UNIT = unit, REC = nrec, IOSTAT = ios ) vect IF ( ios /= 0 ) CALL errore( 'davcio', & - & 'error while reading from file "' // TRIM(name) // '"', unit ) + & 'error reading file "' // TRIM(name) // '"', unit ) ! ELSE IF ( io > 0 ) THEN ! WRITE( UNIT = unit, REC = nrec, IOSTAT = ios ) vect IF ( ios /= 0 ) CALL errore( 'davcio', & - & 'error while writing from file "' // TRIM(name) // '"', unit ) + & 'error writing file "' // TRIM(name) // '"', unit ) ! END IF ! diff --git a/PW/src/makov_payne.f90 b/PW/src/makov_payne.f90 index a1ea9bc94c..2bdfafac07 100644 --- a/PW/src/makov_payne.f90 +++ b/PW/src/makov_payne.f90 @@ -86,9 +86,12 @@ SUBROUTINE write_dipole( etot, x0, dipole_el, quadrupole_el, qq ) REAL(DP) :: corr1, corr2, aa, bb INTEGER :: ia, ip ! - ! ... Note that the definition of the Madelung constant used here - ! ... differs from the "traditional" one found in the literature. See - ! ... Lento, Mozos, Nieminen, J. Phys.: Condens. Matter 14 (2002), 2637-2645 + ! Note that the definition of the Madelung constant used here: + ! Lento, Mozos, Nieminen, J. Phys.: Condens. Matter 14 (2002), 2637-2645 + ! differs from the "traditional" one found in the literature, e.g.: + ! Leslie and Gillam https://doi.org/10.1088/0022-3719/18/5/005, + ! Dabo et al. at https://doi.org/10.1103/PhysRevB.77.115139: + ! because different definitions of the length parameter L are adopted ! REAL(DP), PARAMETER :: madelung(3) = (/ 2.8373D0, 2.8883D0, 2.8885D0 /) ! From e5cff91a5d41824397f96316a56ac5d60c20abe8 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Mon, 3 Aug 2020 19:20:31 +0200 Subject: [PATCH 3/3] Incorrect detection of inversion symmetry in phonons fixed (Phil Wang, JHU). I think a better fix would be to move the detection of the inversion symmetry into function "copy_sym" (not making assumptions on which operation is the inversion, and transforming the function into a subroutine) but this must be done with care and far from a release. The current fix seem to be 100% safe. --- LR_Modules/set_small_group_of_q.f90 | 15 ++++++++++----- TDDFPT/src/lr_smallgq.f90 | 13 +++++++++---- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/LR_Modules/set_small_group_of_q.f90 b/LR_Modules/set_small_group_of_q.f90 index 5f5bc2068a..0d91969246 100644 --- a/LR_Modules/set_small_group_of_q.f90 +++ b/LR_Modules/set_small_group_of_q.f90 @@ -30,7 +30,7 @@ SUBROUTINE set_small_group_of_q(nsymq, invsymq, minus_q) LOGICAL, INTENT(INOUT) :: minus_q, invsymq ! REAL(DP), ALLOCATABLE :: rtau(:,:,:) - + INTEGER :: isym LOGICAL :: sym(48) ! sym(1:nsym)=.true. @@ -55,11 +55,16 @@ SUBROUTINE set_small_group_of_q(nsymq, invsymq, minus_q) ! CALL inverse_s ( ) ! - ! check if inversion (I) is a symmetry. If so, there should be nsymq/2 - ! symmetries without inversion, followed by nsymq/2 with inversion - ! Since identity is always s(:,:,1), inversion should be s(:,:,1+nsymq/2) + ! Check if inversion (I) is a symmetry + ! Note that the first symmetry operation is always the identity (E) ! - invsymq = ALL ( s(:,:,nsymq/2+1) == -s(:,:,1) ) + invsymq =.FALSE. + DO isym = 1, nsymq + IF ( ALL ( s(:,:,isym) == -s(:,:,1) ) ) THEN + invsymq = .TRUE. + EXIT + END IF + END DO ! ! Since the order of the s matrices is changed we need to recalculate: ! diff --git a/TDDFPT/src/lr_smallgq.f90 b/TDDFPT/src/lr_smallgq.f90 index 70c0c220a3..30b38740d9 100644 --- a/TDDFPT/src/lr_smallgq.f90 +++ b/TDDFPT/src/lr_smallgq.f90 @@ -139,12 +139,17 @@ SUBROUTINE lr_smallgq (xq) ! ENDDO ! - ! Check if inversion (I) is a symmetry. If so, there should be nsymq/2 - ! symmetries without inversion, followed by nsymq/2 with inversion - ! Since identity is always s(:,:,1), inversion should be s(:,:,1+nsymq/2) + ! Check if inversion (I) is a symmetry + ! Note that the first symmetry operation is always the identity (E) ! IT: it seems that invsymq is useless (used nowhere)... ! - invsymq = ALL ( s(:,:,nsymq/2+1) == -s(:,:,1) ) + invsymq =.FALSE. + DO isym = 1, nsymq + IF ( ALL ( s(:,:,isym) == -s(:,:,1) ) ) THEN + invsymq = .TRUE. + EXIT + END IF + END DO ! ! The order of the s matrices has changed. ! Transform symmetry matrices s from crystal to cartesian axes.