comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-28 22:25:32 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

Revised #4233

Browse source
This commit is contained in:
Hans Pabst 2025-06-05 11:46:16 +02:00 • committed by GitHub
parent e5b196819d
commit d3e36fe426
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 36 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

42
src/fm/cp_cfm_basic_linalg.F
View file

@ -1263,14 +1263,15 @@ CONTAINS
COMPLEX(KIND=dp) :: sn_cmplx
#if defined(__parallel)
INTEGER :: info, lwork, nloc
INTEGER :: info, lwork
INTEGER, DIMENSION(9) :: desc
REAL(dp), DIMENSION(:), ALLOCATABLE :: work
#endif
CALL timeset(routineN, handle)
CALL cp_cfm_get_info(matrix, ncol_global=ncol, ncol_local=nloc)
CALL cp_cfm_get_info(matrix, ncol_global=ncol)
sn_cmplx = CMPLX(sn, 0.0_dp, dp)
IF (ncol /= nloc) THEN
#if defined(__parallel)
IF (1 /= matrix%matrix_struct%context%n_pid) THEN
lwork = 2*ncol + 1
ALLOCATE (work(lwork))
desc(:) = matrix%matrix_struct%descriptor(:)
@ -1281,15 +1282,11 @@ CONTAINS
CPASSERT(info == 0)
DEALLOCATE (work)
ELSE
CALL zrot(ncol, matrix%local_data(irow, 1), ncol, matrix%local_data(jrow, 1), ncol, cs, sn_cmplx)
END IF
#else
CALL timeset(routineN, handle)
CALL cp_cfm_get_info(matrix, ncol_global=ncol)
sn_cmplx = CMPLX(sn, 0.0_dp, dp)
CALL zrot(ncol, matrix%local_data(irow, 1), ncol, matrix%local_data(jrow, 1), ncol, cs, sn_cmplx)
#endif
CALL zrot(ncol, matrix%local_data(irow, 1), ncol, matrix%local_data(jrow, 1), ncol, cs, sn_cmplx)
#if defined(__parallel)
END IF
#endif
CALL timestop(handle)
END SUBROUTINE cp_cfm_rot_rows
@ -1312,14 +1309,15 @@ CONTAINS
COMPLEX(KIND=dp) :: sn_cmplx
#if defined(__parallel)
INTEGER :: info, lwork, nloc
INTEGER :: info, lwork
INTEGER, DIMENSION(9) :: desc
REAL(dp), DIMENSION(:), ALLOCATABLE :: work
#endif
CALL timeset(routineN, handle)
CALL cp_cfm_get_info(matrix, nrow_global=nrow, nrow_local=nloc)
CALL cp_cfm_get_info(matrix, nrow_global=nrow)
sn_cmplx = CMPLX(sn, 0.0_dp, dp)
IF (nrow /= nloc) THEN
#if defined(__parallel)
IF (1 /= matrix%matrix_struct%context%n_pid) THEN
lwork = 2*nrow + 1
ALLOCATE (work(lwork))
desc(:) = matrix%matrix_struct%descriptor(:)
@ -1330,15 +1328,11 @@ CONTAINS
CPASSERT(info == 0)
DEALLOCATE (work)
ELSE
CALL zrot(nrow, matrix%local_data(1, icol), 1, matrix%local_data(1, jcol), 1, cs, sn_cmplx)
END IF
#else
CALL timeset(routineN, handle)
CALL cp_cfm_get_info(matrix, nrow_global=nrow)
sn_cmplx = CMPLX(sn, 0.0_dp, dp)
CALL zrot(nrow, matrix%local_data(1, icol), 1, matrix%local_data(1, jcol), 1, cs, sn_cmplx)
#endif
CALL zrot(nrow, matrix%local_data(1, icol), 1, matrix%local_data(1, jcol), 1, cs, sn_cmplx)
#if defined(__parallel)
END IF
#endif
CALL timestop(handle)
END SUBROUTINE cp_cfm_rot_cols

40
src/fm/cp_fm_basic_linalg.F
View file

@ -2417,13 +2417,14 @@ CONTAINS
INTEGER :: handle, ncol
#if defined(__parallel)
INTEGER :: info, lwork, nloc
INTEGER :: info, lwork
INTEGER, DIMENSION(9) :: desc
REAL(dp), DIMENSION(:), ALLOCATABLE :: work
#endif
CALL timeset(routineN, handle)
CALL cp_fm_get_info(matrix, ncol_global=ncol, ncol_local=nloc)
IF (ncol /= nloc) THEN
CALL cp_fm_get_info(matrix, ncol_global=ncol)
#if defined(__parallel)
IF (1 /= matrix%matrix_struct%context%n_pid) THEN
lwork = 2*ncol + 1
ALLOCATE (work(lwork))
desc(:) = matrix%matrix_struct%descriptor(:)
@ -2434,14 +2435,11 @@ CONTAINS
CPASSERT(info == 0)
DEALLOCATE (work)
ELSE
CALL drot(ncol, matrix%local_data(irow, 1), ncol, matrix%local_data(jrow, 1), ncol, cs, sn)
END IF
#else
CALL timeset(routineN, handle)
CALL cp_fm_get_info(matrix, ncol_global=ncol)
CALL drot(ncol, matrix%local_data(irow, 1), ncol, matrix%local_data(jrow, 1), ncol, cs, sn)
#endif
CALL drot(ncol, matrix%local_data(irow, 1), ncol, matrix%local_data(jrow, 1), ncol, cs, sn)
#if defined(__parallel)
END IF
#endif
CALL timestop(handle)
END SUBROUTINE cp_fm_rot_rows
@ -2463,13 +2461,14 @@ CONTAINS
INTEGER :: handle, nrow
#if defined(__parallel)
INTEGER :: info, lwork, nloc
INTEGER :: info, lwork
INTEGER, DIMENSION(9) :: desc
REAL(dp), DIMENSION(:), ALLOCATABLE :: work
#endif
CALL timeset(routineN, handle)
CALL cp_fm_get_info(matrix, nrow_global=nrow, nrow_local=nloc)
IF (nrow /= nloc) THEN
CALL cp_fm_get_info(matrix, nrow_global=nrow)
#if defined(__parallel)
IF (1 /= matrix%matrix_struct%context%n_pid) THEN
lwork = 2*nrow + 1
ALLOCATE (work(lwork))
desc(:) = matrix%matrix_struct%descriptor(:)
@ -2480,14 +2479,11 @@ CONTAINS
CPASSERT(info == 0)
DEALLOCATE (work)
ELSE
CALL drot(nrow, matrix%local_data(1, icol), 1, matrix%local_data(1, jcol), 1, cs, sn)
END IF
#else
CALL timeset(routineN, handle)
CALL cp_fm_get_info(matrix, nrow_global=nrow)
CALL drot(nrow, matrix%local_data(1, icol), 1, matrix%local_data(1, jcol), 1, cs, sn)
#endif
CALL drot(nrow, matrix%local_data(1, icol), 1, matrix%local_data(1, jcol), 1, cs, sn)
#if defined(__parallel)
END IF
#endif
CALL timestop(handle)
END SUBROUTINE cp_fm_rot_cols