mirror of https://gitlab.com/QEF/q-e.git
adding device_helper.f90 to collect miscellaneous helper subroutines
This commit is contained in:
carcava
parent
2f4ede91b7
commit
8fe16a7bfe
|
|
@ -144,6 +144,7 @@ SUBROUTINE from_scratch( )
|
|||
!
|
||||
if( iverbosity > 1 ) CALL dotcsc( eigr, cm_bgrp, ngw, nbsp )
|
||||
!
|
||||
!
|
||||
! ... initialize bands
|
||||
!
|
||||
CALL occn_info( f )
|
||||
|
|
|
|||
|
|
@ -1238,22 +1238,3 @@ subroutine nlfq_bgrp_x( c_bgrp, eigr, bec_bgrp, becdr_bgrp, fion )
|
|||
!
|
||||
return
|
||||
end subroutine nlfq_bgrp_x
|
||||
|
||||
! In principle this can go away .......
|
||||
SUBROUTINE MYDGEMM( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC )
|
||||
#if defined(__CUDA)
|
||||
use cudafor
|
||||
use cublas
|
||||
#endif
|
||||
CHARACTER*1, INTENT(IN) :: TRANSA, TRANSB
|
||||
INTEGER, INTENT(IN) :: M, N, K, LDA, LDB, LDC
|
||||
DOUBLE PRECISION, INTENT(IN) :: ALPHA, BETA
|
||||
DOUBLE PRECISION :: A( LDA, * ), B( LDB, * ), C( LDC, * )
|
||||
#if defined(__CUDA)
|
||||
attributes(device) :: A, B, C
|
||||
CALL cublasdgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
|
||||
#else
|
||||
CALL dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
|
||||
#endif
|
||||
|
||||
END SUBROUTINE MYDGEMM
|
||||
|
|
|
|||
|
|
@ -632,18 +632,3 @@ END MODULE local_ortho_memory
|
|||
100 FORMAT(3X,'diff = ',D18.10,' iter = ', I5 )
|
||||
!
|
||||
END SUBROUTINE ortho_x
|
||||
|
||||
|
||||
|
||||
|
||||
SUBROUTINE qe_sync()
|
||||
#if defined(__CUDA)
|
||||
USE cudafor
|
||||
#endif
|
||||
INTEGER :: info
|
||||
#if defined (__CUDA)
|
||||
info = cudaDeviceSynchronize()
|
||||
IF( info /= 0 ) CALL errore('qe_sync',' error ',ABS(info))
|
||||
#endif
|
||||
RETURN
|
||||
END SUBROUTINE
|
||||
|
|
|
|||
|
|
@ -1312,22 +1312,3 @@ CONTAINS
|
|||
END SUBROUTINE bec_bgrp2ortho
|
||||
|
||||
END MODULE orthogonalize_base
|
||||
|
||||
|
||||
! In principle this can go away .......
|
||||
SUBROUTINE MYDGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
|
||||
#if defined(__CUDA)
|
||||
use cudafor
|
||||
use cublas
|
||||
#endif
|
||||
! .. Scalar Arguments ..
|
||||
DOUBLE PRECISION :: ALPHA
|
||||
INTEGER :: INCX, INCY, LDA, M, N
|
||||
! .. Array Arguments ..
|
||||
DOUBLE PRECISION :: A( LDA, * ), X( * ), Y( * )
|
||||
#if defined(__CUDA)
|
||||
attributes(device) :: A, X, Y
|
||||
#endif
|
||||
CALL DGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
|
||||
|
||||
END SUBROUTINE MYDGER
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@ include ../make.inc
|
|||
MODFLAGS=$(MOD_FLAG).
|
||||
|
||||
UTIL = clocks_handler.o \
|
||||
device_helper.o \
|
||||
device_util.o \
|
||||
divide.o \
|
||||
data_buffer.o \
|
||||
|
|
|
|||
|
|
@ -0,0 +1,67 @@
|
|||
!
|
||||
! Copyright (C) 2003-2020 Quantum ESPRESSO group
|
||||
! This file is distributed under the terms of the
|
||||
! GNU General Public License. See the file `License'
|
||||
! in the root directory of the present distribution,
|
||||
! or http://www.gnu.org/copyleft/gpl.txt .
|
||||
!
|
||||
! This file initiated by Carlo Cavazzoni 2020
|
||||
!
|
||||
! Purpose: collect miscellaneus subroutines to help dealing with
|
||||
! accelerator devices
|
||||
|
||||
|
||||
!=----------------------------------------------------------------------------=!
|
||||
|
||||
SUBROUTINE qe_device_sync()
|
||||
#if defined(__CUDA)
|
||||
USE cudafor
|
||||
#endif
|
||||
INTEGER :: info
|
||||
#if defined (__CUDA)
|
||||
info = cudaDeviceSynchronize()
|
||||
IF( info /= 0 ) CALL errore('qe_sync',' error ',ABS(info))
|
||||
#endif
|
||||
RETURN
|
||||
END SUBROUTINE
|
||||
|
||||
!=----------------------------------------------------------------------------=!
|
||||
|
||||
! In principle this can go away .......
|
||||
SUBROUTINE MYDGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
|
||||
#if defined(__CUDA)
|
||||
use cudafor
|
||||
use cublas
|
||||
#endif
|
||||
! .. Scalar Arguments ..
|
||||
DOUBLE PRECISION :: ALPHA
|
||||
INTEGER :: INCX, INCY, LDA, M, N
|
||||
! .. Array Arguments ..
|
||||
DOUBLE PRECISION :: A( LDA, * ), X( * ), Y( * )
|
||||
#if defined(__CUDA)
|
||||
attributes(device) :: A, X, Y
|
||||
#endif
|
||||
CALL DGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
|
||||
|
||||
END SUBROUTINE MYDGER
|
||||
|
||||
!=----------------------------------------------------------------------------=!
|
||||
|
||||
! In principle this can go away .......
|
||||
SUBROUTINE MYDGEMM( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
|
||||
#if defined(__CUDA)
|
||||
use cudafor
|
||||
use cublas
|
||||
#endif
|
||||
CHARACTER*1, INTENT(IN) :: TRANSA, TRANSB
|
||||
INTEGER, INTENT(IN) :: M, N, K, LDA, LDB, LDC
|
||||
DOUBLE PRECISION, INTENT(IN) :: ALPHA, BETA
|
||||
DOUBLE PRECISION :: A( LDA, * ), B( LDB, * ), C( LDC, * )
|
||||
#if defined(__CUDA)
|
||||
attributes(device) :: A, B, C
|
||||
CALL cublasdgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
|
||||
#else
|
||||
CALL dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
|
||||
#endif
|
||||
|
||||
END SUBROUTINE MYDGEMM
|
||||
Loading…
Reference in New Issue