TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-12-23 04:44:03 +01:00
Code Issues Projects Releases Wiki Activity

Removed DIR$

Browse Source
This commit is contained in:
Anthony Scemama 2021-12-12 11:20:11 +01:00
parent e45325e25a
commit 60356cdbbb
1 changed files with 3 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
org/qmckl_blas.org
View File

@ -434,24 +434,18 @@ integer function qmckl_adjoint_f(context, ma, na, LDA, A, det_l) &
select case (na) select case (na)
case default case default
!DIR$ forceinline
print *," TODO: Implement general adjoint" print *," TODO: Implement general adjoint"
stop 0 stop 0
case (5) case (5)
!DIR$ forceinline
call adjoint5(a,LDA,na,det_l) call adjoint5(a,LDA,na,det_l)
case (4) case (4)
!DIR$ forceinline
call adjoint4(a,LDA,na,det_l) call adjoint4(a,LDA,na,det_l)
case (3) case (3)
!DIR$ forceinline
call adjoint3(a,LDA,na,det_l) call adjoint3(a,LDA,na,det_l)
case (2) case (2)
!DIR$ forceinline
call adjoint2(a,LDA,na,det_l) call adjoint2(a,LDA,na,det_l)
case (1) case (1)
!DIR$ forceinline
call adjoint1(a,LDA,na,det_l) call adjoint1(a,LDA,na,det_l)
case (0) case (0)
det_l=1.d0 det_l=1.d0
@ -668,7 +662,6 @@ subroutine cofactor3(a,LDA,na,det_l)
integer*8, intent(in) :: na integer*8, intent(in) :: na
double precision, intent(inout) :: det_l double precision, intent(inout) :: det_l
double precision :: b(4,3) double precision :: b(4,3)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: b
integer :: i integer :: i
det_l = a(1,1)*(a(2,2)*a(3,3)-a(2,3)*a(3,2)) & det_l = a(1,1)*(a(2,2)*a(3,3)-a(2,3)*a(3,2)) &
-a(1,2)*(a(2,1)*a(3,3)-a(2,3)*a(3,1)) & -a(1,2)*(a(2,1)*a(3,3)-a(2,3)*a(3,1)) &
@ -677,7 +670,7 @@ subroutine cofactor3(a,LDA,na,det_l)
b(i,1) = a(i,1) b(i,1) = a(i,1)
b(i,2) = a(i,2) b(i,2) = a(i,2)
b(i,3) = a(i,3) b(i,3) = a(i,3)
enddo end do
a(1,1) = b(2,2)*b(3,3) - b(2,3)*b(3,2) a(1,1) = b(2,2)*b(3,3) - b(2,3)*b(3,2)
a(2,1) = b(2,3)*b(3,1) - b(2,1)*b(3,3) a(2,1) = b(2,3)*b(3,1) - b(2,1)*b(3,3)
a(3,1) = b(2,1)*b(3,2) - b(2,2)*b(3,1) a(3,1) = b(2,1)*b(3,2) - b(2,2)*b(3,1)
@ -699,7 +692,6 @@ subroutine cofactor4(a,LDA,na,det_l)
integer*8, intent(in) :: na integer*8, intent(in) :: na
double precision, intent(inout) :: det_l double precision, intent(inout) :: det_l
double precision :: b(4,4) double precision :: b(4,4)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: b
integer :: i,j integer :: i,j
det_l = a(1,1)*(a(2,2)*(a(3,3)*a(4,4)-a(3,4)*a(4,3)) & det_l = a(1,1)*(a(2,2)*(a(3,3)*a(4,4)-a(3,4)*a(4,3)) &
-a(2,3)*(a(3,2)*a(4,4)-a(3,4)*a(4,2)) & -a(2,3)*(a(3,2)*a(4,4)-a(3,4)*a(4,2)) &
@ -718,7 +710,7 @@ subroutine cofactor4(a,LDA,na,det_l)
b(2,i) = a(2,i) b(2,i) = a(2,i)
b(3,i) = a(3,i) b(3,i) = a(3,i)
b(4,i) = a(4,i) b(4,i) = a(4,i)
enddo end do
a(1,1) = b(2,2)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(2,3)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))+b(2,4)*(b(3,2)*b(4,3)-b(3,3)*b(4,2)) a(1,1) = b(2,2)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))-b(2,3)*(b(3,2)*b(4,4)-b(3,4)*b(4,2))+b(2,4)*(b(3,2)*b(4,3)-b(3,3)*b(4,2))
a(2,1) = -b(2,1)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))+b(2,3)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))-b(2,4)*(b(3,1)*b(4,3)-b(3,3)*b(4,1)) a(2,1) = -b(2,1)*(b(3,3)*b(4,4)-b(3,4)*b(4,3))+b(2,3)*(b(3,1)*b(4,4)-b(3,4)*b(4,1))-b(2,4)*(b(3,1)*b(4,3)-b(3,3)*b(4,1))
@ -749,7 +741,6 @@ subroutine cofactor5(a,LDA,na,det_l)
integer*8, intent(in) :: na integer*8, intent(in) :: na
double precision, intent(inout) :: det_l double precision, intent(inout) :: det_l
double precision :: b(5,5) double precision :: b(5,5)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: b
integer :: i,j integer :: i,j
det_l = a(1,1)*(a(2,2)*(a(3,3)*(a(4,4)*a(5,5)-a(4,5)*a(5,4))-a(3,4)*( & det_l = a(1,1)*(a(2,2)*(a(3,3)*(a(4,4)*a(5,5)-a(4,5)*a(5,4))-a(3,4)*( &
a(4,3)*a(5,5)-a(4,5)*a(5,3))+a(3,5)*(a(4,3)*a(5,4)-a(4,4)*a(5,3)))- & a(4,3)*a(5,5)-a(4,5)*a(5,3))+a(3,5)*(a(4,3)*a(5,4)-a(4,4)*a(5,3)))- &
@ -795,7 +786,7 @@ subroutine cofactor5(a,LDA,na,det_l)
b(3,i) = a(3,i) b(3,i) = a(3,i)
b(4,i) = a(4,i) b(4,i) = a(4,i)
b(5,i) = a(5,i) b(5,i) = a(5,i)
enddo end do
a(1,1) = & a(1,1) = &
(b(2,2)*(b(3,3)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))+b(3,5)*(b(4,3)*b(5,4)-b(4,4)*b(5,3)))-b(2,3)* & (b(2,2)*(b(3,3)*(b(4,4)*b(5,5)-b(4,5)*b(5,4))-b(3,4)*(b(4,3)*b(5,5)-b(4,5)*b(5,3))+b(3,5)*(b(4,3)*b(5,4)-b(4,4)*b(5,3)))-b(2,3)* &