diff --git a/src/m_common/upwinv.f90 b/src/m_common/upwinv.f90
index b3abd1f..457529f 100644
--- a/src/m_common/upwinv.f90
+++ b/src/m_common/upwinv.f90
@@ -16,8 +16,15 @@
subroutine upwinv(nel, jel, indt, nelorb, winv, v, psi)
use constants, only: yes_ontarget
implicit none
- integer nel, indt, i, j, jel, nelorb
- real*8 winv(nel, indt), psi(indt, nel), v(nel)
+
+ ! argument parameters
+ integer, intent(in) :: nel, indt, jel, nelorb
+ real*8, intent(in) :: psi(indt, nel), v(nel)
+ real*8, intent(inout) :: winv(nel, indt)
+
+ ! local variables
+ integer i, j
+
#ifdef _OFFLOAD
!$omp target teams distribute parallel do collapse(2) if(yes_ontarget)
#endif
@@ -43,11 +50,18 @@ subroutine upwinv(nel, jel, indt, nelorb, winv, v, psi)
end do
return
end
+
subroutine upwinv_complex(nel, jel, indt, nelorb, winv, v, psi)
use constants, only: yes_ontarget
implicit none
- integer nel, indt, i, j, jel, nelorb
- complex*16 winv(nel, indt), psi(indt, nel), v(nel)
+
+ ! argument parameters
+ integer, intent(in) :: nel, indt, jel, nelorb
+ complex*16, intent(in) :: psi(indt, nel), v(nel)
+ complex*16, intent(inout) :: winv(nel, indt)
+
+ ! local variables
+ integer i, j
#ifdef _OFFLOAD
!$omp target teams distribute parallel do collapse(2) if(yes_ontarget)
#endif
diff --git a/src/m_common/upwinvp.f90 b/src/m_common/upwinvp.f90
index 3062009..fe835f2 100644
--- a/src/m_common/upwinvp.f90
+++ b/src/m_common/upwinvp.f90
@@ -13,11 +13,19 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see .
+!> subroutine to update the matrix winv, for real(8)
subroutine upwinvp(nel, indt, winv, ainv, ainvn, psi)
use constants, only: yes_ontarget
implicit none
- integer nel, indt, i, j
- real*8 winv(nel, indt), psi(indt, nel, 2), ainv(nel), ainvn(nel)
+
+ ! argument parameters
+ integer, intent(in) :: nel, indt
+ real*8, intent(in) :: psi(indt, nel, 2), ainv(nel), ainvn(nel)
+ real*8, intent(inout) :: winv(nel, indt)
+
+ ! local variables
+ integer :: i, j
+
#ifdef _OFFLOAD
if (yes_ontarget) then
!$omp target teams distribute parallel do collapse(2)
@@ -42,12 +50,48 @@ subroutine upwinvp(nel, indt, winv, ainv, ainvn, psi)
#endif
return
end
+
+!> subroutine to update the matrix winv, for complex(16)
+subroutine upwinvp_complex(nel, indt, winv, ainv, ainvn, psi)
+ use constants, only: yes_ontarget
+ implicit none
+
+ ! argument parameters
+ integer, intent(in) :: nel, indt
+ complex*16, intent(in) :: psi(indt, nel, 2), ainv(nel), ainvn(nel)
+ complex*16, intent(inout) :: winv(nel, indt)
+
+ ! local variables
+ integer i, j
+
+#ifdef _OFFLOAD
+!$omp target teams distribute parallel do collapse(2) if(yes_ontarget)
+#endif
+ do i = 1, indt
+ do j = 1, nel
+ winv(j, i) = winv(j, i) + ainv(j)*psi(i, j, 1) + ainvn(j)*psi(i, j, 2)
+ end do
+ end do
+#ifdef _OFFLOAD
+!$omp end target teams distribute parallel do
+#endif
+ return
+end
+
+!> subroutine to update the matrix winv of Pfaffian, for real(8)
subroutine upwinvp_pfaff(nelc, nelup, neldo, nmol, nmolipf, nmolshift, indt, winvup, winvdo, psi, ainv)
use constants, only: yes_ontarget
implicit none
- integer nelc, nelcdo, nelup, neldo, nmol, nmolipf, nmolshift, indt, i, j
- real*8 winvup(nelup, indt), winvdo(neldo, indt), psi(nmolipf, indt), ainv(nmol)
+
+ ! argument parameters
+ integer, intent(in) :: nelc, nelup, neldo, nmol, nmolipf, nmolshift, indt
+ real*8, intent(in) :: psi(nmolipf, indt), ainv(nmol)
+ real*8, intent(inout) :: winvup(nelup, indt), winvdo(neldo, indt)
+
+ ! local variables
+ integer i, j, nelcdo
real*8 csum
+
if (yes_ontarget) then
if (nelc .le. nelup) then
#ifdef _OFFLOAD
@@ -116,11 +160,19 @@ subroutine upwinvp_pfaff(nelc, nelup, neldo, nmol, nmolipf, nmolshift, indt, win
end if
return
end
+
+!> subroutine to update the matrix winv of Pfaffian, for complex(16)
subroutine upwinvp_pfaff_complex(nelc, nelup, neldo, nmol, nmolipf, nmolshift, indt, winvup, winvdo, psi, ainv)
use constants, only: yes_ontarget
implicit none
- integer nelc, nelcdo, nelup, neldo, nmol, nmolipf, nmolshift, indt, i, j
- complex*16 winvup(nelup, indt), winvdo(neldo, indt), psi(nmolipf, indt), ainv(nmol)
+
+ ! argument parameters
+ integer, intent(in) :: nelc, nelup, neldo, nmol, nmolipf, nmolshift, indt
+ complex*16, intent(in) :: psi(nmolipf, indt), ainv(nmol)
+ complex*16, intent(inout) :: winvup(nelup, indt), winvdo(neldo, indt)
+
+ ! local variables
+ integer i, j, nelcdo
complex*16 csum
if (yes_ontarget) then
if (nelc .le. nelup) then
@@ -194,21 +246,3 @@ subroutine upwinvp_pfaff_complex(nelc, nelup, neldo, nmol, nmolipf, nmolshift, i
end if
return
end
-subroutine upwinvp_complex(nel, indt, winv, ainv, ainvn, psi)
- use constants, only: yes_ontarget
- implicit none
- integer nel, indt, i, j
- complex*16 winv(nel, indt), psi(indt, nel, 2), ainv(nel), ainvn(nel)
-#ifdef _OFFLOAD
-!$omp target teams distribute parallel do collapse(2) if(yes_ontarget)
-#endif
- do i = 1, indt
- do j = 1, nel
- winv(j, i) = winv(j, i) + ainv(j)*psi(i, j, 1) + ainvn(j)*psi(i, j, 2)
- end do
- end do
-#ifdef _OFFLOAD
-!$omp end target teams distribute parallel do
-#endif
- return
-end
diff --git a/src/m_common/write_type_orb.f90 b/src/m_common/write_type_orb.f90
index 1702557..0fbd79f 100644
--- a/src/m_common/write_type_orb.f90
+++ b/src/m_common/write_type_orb.f90
@@ -13,9 +13,15 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see .
+!> This subroutine returns typeorb for jastrow orbitals
subroutine write_type_orb(nshellj, multij, ioccj, typeorb)
implicit none
- integer nshellj, multij(*), ioccj(*), typeorb(*)
+
+ ! argument parameters
+ integer, intent(in) :: nshellj, multij(*), ioccj(*)
+ integer, intent(out) :: typeorb(*)
+
+ ! local variables
integer i, ii, j, ind_type
ii = 0
diff --git a/src/m_common/zgemm_my.f90 b/src/m_common/zgemm_my.f90
index ba3baa0..571c505 100644
--- a/src/m_common/zgemm_my.f90
+++ b/src/m_common/zgemm_my.f90
@@ -13,6 +13,7 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see .
+!> This subroutine is a wrapper for the LAPACK zgemm routine
subroutine ZGEMM_MY(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA&
&, B, LDB, BETA, C, LDC, nproc, rank, comm_mpi)
implicit none
diff --git a/src/m_common/zsktri.f90 b/src/m_common/zsktri.f90
index 4281420..855b12d 100644
--- a/src/m_common/zsktri.f90
+++ b/src/m_common/zsktri.f90
@@ -13,19 +13,29 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see .
+!> This subroutine manipulates a skewsymmetric matrix A.
subroutine zsktri(uplo, n, a, lda, ainv, ldinv, ipiv, work, info)
implicit none
- character uplo
- integer n, i, j, lda, ldinv, info, lwork, ipiv(*)
- complex*16 a(lda, *), ainv(ldinv, *), work(*)
+
+ ! argument parameters
+ character, intent(in) :: uplo
+ integer, intent(in) :: n, lda, ldinv, ipiv(*)
+ complex*16, intent(in out) :: a(lda, *), work(*)
+ complex*16, intent(out) :: ainv(ldinv, *)
+ integer, intent(out) :: info
+
+ ! local variables
+ integer i, j
real*8 rcond
logical yeslap
+
! First factorization assumed
- ! lwork=3*n
+ ! lwork=3*n
! CALL ZSKTRF( UPLO, 'N', N, A, LDA, IPIV, WORK, LWORK, INFO)
! Identity matrix
! ipiv dimension required 3n
! work dimension required n^2+12*n-2
+ info = 0
yeslap = .false. ! if false the homemade algorithm is done.
do i = 1, n
do j = 1, i - 1
@@ -36,13 +46,13 @@ subroutine zsktri(uplo, n, a, lda, ainv, ldinv, ipiv, work, info)
ainv(j, i) = dcmplx(0.d0, 0.d0)
end do
end do
- ! fisrt permutation of ainv
+ ! fisrt permutation of ainv
do i = n, 1, -1
work(1:n) = ainv(i, 1:n)
ainv(i, 1:n) = ainv(ipiv(i), 1:n)
ainv(ipiv(i), 1:n) = work(1:n)
end do
- ! SECOND
+ ! second
if (UPLO .eq. 'u' .or. UPLO .eq. 'U') then
do i = 1, N - 1
work(i) = a(i, i + 1)
@@ -63,7 +73,7 @@ subroutine zsktri(uplo, n, a, lda, ainv, ldinv, ipiv, work, info)
a(2:n, 1) = dcmplx(0.d0, 0.d0)
end if
work(2*N - 1:3*N - 2) = dcmplx(0.d0, 0.d0) ! diagonal elements of skew matrix , obviously set to zero.
- call ZTRTRS(UPLO, 'N', 'U', N, N, A, LDA, ainv, LDINV, INFO)
+ call ZTRTRS(UPLO, 'N', 'U', N, N, A, LDA, ainv, LDINV, INFO) ! ainv = A^-1
! USE STANDARD LAPACK DGTSVX or the simples DGTSV?
if (yeslap) then
call ZGTSVX('N', 'N', N, N, work(N), work(2*N - 1), work, work(3*N)&
@@ -83,7 +93,6 @@ subroutine zsktri(uplo, n, a, lda, ainv, ldinv, ipiv, work, info)
ainv(i, 1:n) = ainv(ipiv(i), 1:n)
ainv(ipiv(i), 1:n) = work(1:n)
end do
-
return
end
diff --git a/src/m_common/zsktrs.f90 b/src/m_common/zsktrs.f90
index 2effe03..638a85e 100644
--- a/src/m_common/zsktrs.f90
+++ b/src/m_common/zsktrs.f90
@@ -1,4 +1,4 @@
-! Copyright (C) 2022 TurboRVB group
+! Copyright (C) 2023- TurboRVB group
!
! This program is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
@@ -13,11 +13,22 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see .
+!> This subroutine solves A X = B
+!> To be deleted!
subroutine zsktrs(uplo, n, nhrs, a, b, ldb, x, info)
implicit none
- integer n, nhrs, ldb, info, i, j
- complex*16 a(*), b(ldb, nhrs), x(nhrs, *)
- character uplo
+
+ ! argument parameters
+ integer, intent(in) :: n, nhrs, ldb
+ integer, intent(out) :: info
+ complex*16, intent(in out) :: a(*), b(ldb, nhrs)
+ complex*16, intent(out) :: x(nhrs, *)
+ character, intent(in) :: uplo
+
+ ! local variables
+ integer i, j
+
+ info = 0
if (uplo .eq. 'l' .or. uplo .eq. 'L') then
a(1:n - 1) = -a(1:n - 1)
end if
diff --git a/src/m_common/zsktrs_qp.f90 b/src/m_common/zsktrs_qp.f90
index aa0c9f9..272d47a 100644
--- a/src/m_common/zsktrs_qp.f90
+++ b/src/m_common/zsktrs_qp.f90
@@ -13,16 +13,31 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see .
+!> This subroutine solves A * X = B.
+!> Our homemade algorithm to solve A * X = B (No transpose)
+!> where A is a skewsymmetric matrix, X and B are rectanglar matrices.
+!> The input vector a stores the elements of A such that
+!> A(i+1,i)=a(i) and A(i,i+1)=-a(i) for i=1,..,n-1
+!> a(n), b(ldb, n), x(n)
subroutine zsktrs(uplo, n, nhrs, a, b, ldb, x, info)
implicit none
- integer n, nhrs, ldb, info, i, j
- complex*16 a(*), b(ldb, *), x(*)
+
+ ! argument variables
+ integer, intent(in) :: n, nhrs, ldb
+ integer, intent(out) :: info
+ complex*16, intent(inout) :: a(*), b(ldb, *)
+ complex*16, intent(out) :: x(*)
+ character, intent(in) :: uplo
+
+ ! local variables
+ integer i, j
#ifdef __PORT
complex*16 aq, a2q, xo
#else
complex*32 aq, a2q, xo
#endif
- character uplo
+
+ info = 0
if (uplo .eq. 'l' .or. uplo .eq. 'L') then
a(1:n - 1) = -a(1:n - 1)
end if