2021-02-17 14:59:25 +01:00
|
|
|
module cfunctions
|
|
|
|
|
use, intrinsic :: ISO_C_BINDING
|
|
|
|
|
interface
|
|
|
|
|
subroutine printcfglist(nint, ncfgs, cfglist) bind(C, name='printCFGList')
|
|
|
|
|
import C_INT32_T, C_INT64_T
|
|
|
|
|
integer(kind=C_INT32_T) :: nint
|
|
|
|
|
integer(kind=C_INT32_T) :: ncfgs
|
|
|
|
|
integer(kind=C_INT64_T) :: cfglist(nint,2,ncfgs)
|
|
|
|
|
end subroutine printcfglist
|
|
|
|
|
end interface
|
|
|
|
|
interface
|
|
|
|
|
subroutine getApqIJMatrixDims(Isomo, Jsomo, MS, rowsout, colsout) &
|
|
|
|
|
bind(C, name='getApqIJMatrixDims')
|
|
|
|
|
import C_INT32_T, C_INT64_T
|
|
|
|
|
integer(kind=C_INT64_T),value,intent(in) :: Isomo ! CSFI
|
|
|
|
|
integer(kind=C_INT64_T),value,intent(in) :: Jsomo ! CSFJ
|
|
|
|
|
integer(kind=C_INT64_T),value,intent(in) :: MS ! Ms = 2*Spin
|
|
|
|
|
integer(kind=C_INT32_T),intent(out):: rowsout
|
|
|
|
|
integer(kind=C_INT32_T),intent(out):: colsout
|
|
|
|
|
end subroutine getApqIJMatrixDims
|
|
|
|
|
end interface
|
|
|
|
|
interface
|
|
|
|
|
subroutine getApqIJMatrixDriver(Isomo, Jsomo, orbp, orbq, &
|
|
|
|
|
MS, NMO, CSFICSFJApqIJ, rowsmax, colsmax) bind(C, name='getApqIJMatrixDriverArrayInp')
|
|
|
|
|
import C_INT32_T, C_INT64_T, C_DOUBLE
|
|
|
|
|
integer(kind=C_INT64_T),value,intent(in) :: Isomo
|
|
|
|
|
integer(kind=C_INT64_T),value,intent(in) :: Jsomo
|
|
|
|
|
integer(kind=C_INT32_T),value,intent(in) :: orbp
|
|
|
|
|
integer(kind=C_INT32_T),value,intent(in) :: orbq
|
|
|
|
|
integer(kind=C_INT64_T),value,intent(in) :: MS
|
|
|
|
|
integer(kind=C_INT64_T),value,intent(in) :: NMO
|
|
|
|
|
integer(kind=C_INT32_T),intent(in) :: rowsmax
|
|
|
|
|
integer(kind=C_INT32_T),intent(in) :: colsmax
|
|
|
|
|
real (kind=C_DOUBLE ),intent(out) :: CSFICSFJApqIJ(rowsmax,colsmax)
|
|
|
|
|
!integer(kind=C_INT32_T),dimension(rowApqIJ,colApqIJ) :: ApqIJ
|
|
|
|
|
end subroutine getApqIJMatrixDriver
|
|
|
|
|
end interface
|
|
|
|
|
interface
|
|
|
|
|
subroutine getCSFtoDETTransformationMatrix(Isomo,&
|
|
|
|
|
MS, rowsmax, colsmax, csftodetmatrix) bind(C, name='convertCSFtoDetBasis')
|
|
|
|
|
import C_INT32_T, C_INT64_T, C_DOUBLE
|
|
|
|
|
integer(kind=C_INT64_T),value,intent(in) :: Isomo
|
|
|
|
|
integer(kind=C_INT64_T),value,intent(in) :: MS
|
|
|
|
|
integer(kind=C_INT32_T),intent(in) :: rowsmax
|
|
|
|
|
integer(kind=C_INT32_T),intent(in) :: colsmax
|
|
|
|
|
real (kind=C_DOUBLE ),intent(out) :: csftodetmatrix(rowsmax,colsmax)
|
|
|
|
|
end subroutine getCSFtoDETTransformationMatrix
|
|
|
|
|
end interface
|
2022-07-09 09:00:29 +02:00
|
|
|
interface
|
|
|
|
|
subroutine gramSchmidt(A, m, n, B) bind(C, name='gramSchmidt')
|
|
|
|
|
import C_INT32_T, C_INT64_T, C_DOUBLE
|
|
|
|
|
integer(kind=C_INT32_T),value,intent(in) :: m
|
|
|
|
|
integer(kind=C_INT32_T),value,intent(in) :: n
|
|
|
|
|
real (kind=C_DOUBLE ),intent(in) :: A(m,n)
|
|
|
|
|
real (kind=C_DOUBLE ),intent(out) :: B(m,n)
|
|
|
|
|
end subroutine gramSchmidt
|
|
|
|
|
end interface
|
|
|
|
|
interface
|
|
|
|
|
subroutine gramSchmidt_qp(A, m, n, B) bind(C, name='gramSchmidt_qp')
|
|
|
|
|
import C_INT32_T, C_INT64_T, C_DOUBLE
|
|
|
|
|
integer(kind=C_INT32_T),value,intent(in) :: m
|
|
|
|
|
integer(kind=C_INT32_T),value,intent(in) :: n
|
|
|
|
|
real (kind=C_DOUBLE ),intent(in) :: A(m,n)
|
|
|
|
|
real (kind=C_DOUBLE ),intent(out) :: B(m,n)
|
|
|
|
|
end subroutine gramSchmidt_qp
|
|
|
|
|
end interface
|
2021-04-28 00:19:46 +02:00
|
|
|
end module cfunctions
|
|
|
|
|
|
|
|
|
|
subroutine f_dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC) &
|
|
|
|
|
bind(C, name='f_dgemm')
|
|
|
|
|
use iso_c_binding
|
|
|
|
|
implicit none
|
|
|
|
|
character, intent(in), value :: TRANSA, TRANSB
|
|
|
|
|
integer, intent(in), value :: M,N,K,LDA,LDB,LDC
|
|
|
|
|
double precision, intent(in), value :: ALPHA, BETA
|
|
|
|
|
double precision, intent(in) :: A(LDA,*), B(LDB,*)
|
|
|
|
|
double precision, intent(out) :: C(LDC,*)
|
|
|
|
|
call dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
|
|
|
|
|
end subroutine
|
|
|
|
|
|
|
|
|
|
|
