Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion Libraries/Modules/mymats_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1340,10 +1340,11 @@ Complex (Kind=Kind(0.d0)) Function DET_C(Mat,N)
Complex(Kind=Kind(0.d0)), intent(inout) :: mat(:,:)

integer :: i, info, LDmat
integer :: ipiv(N)
integer, allocatable :: ipiv(:)

integer :: sgn

allocate(ipiv(N))
ipiv = 0

!Lapack LU decomposition
Expand Down
5 changes: 4 additions & 1 deletion Prog/Hamiltonians/Hamiltonian_Hubbard_smod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -657,7 +657,8 @@ subroutine Obser(GR,Phase,Ntau, Mc_step_weight)
Real (Kind=Kind(0.d0)), INTENT(IN) :: Mc_step_weight

!Local
Complex (Kind=Kind(0.d0)) :: GRC(Ndim,Ndim,N_FL), ZK
Complex (Kind=Kind(0.d0)), allocatable :: GRC(:,:,:)
Complex (Kind=Kind(0.d0)) :: ZK
Complex (Kind=Kind(0.d0)) :: Zrho, Zkin, ZPot, Z, ZP,ZS, ZZ, ZXY
Integer :: I,J, imj, nf, dec, I1, J1, no_I, no_J,n
Real (Kind=Kind(0.d0)) :: X
Expand All @@ -666,6 +667,8 @@ subroutine Obser(GR,Phase,Ntau, Mc_step_weight)
ZS = Real(Phase, kind(0.D0))/Abs(Real(Phase, kind(0.D0)))

ZS = ZS*Mc_step_weight

allocate(GRC(Ndim,Ndim,N_FL))

Do nf = 1,N_FL
Do I = 1,Ndim
Expand Down
11 changes: 7 additions & 4 deletions Prog/cgr1_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ SUBROUTINE CGR(PHASE,NVAR, GRUP, udvr, udvl)
!Local
Logical, save :: Scale_warning_message = .true.
TYPE(UDV_State) :: udvlocal
COMPLEX (Kind=Kind(0.d0)), Dimension(:,:), Allocatable :: TPUP, TPUP1, TPUPM1
COMPLEX (Kind=Kind(0.d0)), Dimension(:,:), Allocatable :: TPUP, TPUP1, TPUPM1, TPUP_temp
INTEGER, Dimension(:), Allocatable :: IPVT
COMPLEX (Kind=Kind(0.d0)) :: ZDUP1, ZDDO1, ZDUP2, ZDDO2, Z1, ZUP, ZDO, alpha, beta
Integer :: I,J, N_size, NCON, info
Expand Down Expand Up @@ -187,7 +187,7 @@ SUBROUTINE CGR(PHASE,NVAR, GRUP, udvr, udvl)

!Local
Logical, save :: Scale_warning_message = .true.
COMPLEX (Kind=Kind(0.d0)), Dimension(:,:), Allocatable :: TPUP, RHS
COMPLEX (Kind=Kind(0.d0)), Dimension(:,:), Allocatable :: TPUP, RHS, TPUP_temp
COMPLEX (Kind=Kind(0.d0)), Dimension(:) , Allocatable :: DUP
INTEGER, Dimension(:), Allocatable :: IPVT, VISITED
COMPLEX (Kind=Kind(0.d0)) :: alpha, beta, Z, DLJ
Expand Down Expand Up @@ -301,7 +301,10 @@ SUBROUTINE CGR(PHASE,NVAR, GRUP, udvr, udvl)
PHASE = PHASE/ABS(PHASE)
IPVT = 0
IF (NVAR .NE. 1) THEN
TPUP = CONJG(TRANSPOSE(TPUP))
Allocate(TPUP_temp(N_size,N_size))
TPUP_temp = CONJG(TRANSPOSE(TPUP))
TPUP = TPUP_temp
Deallocate(TPUP_temp)
ENDIF
call QDRP_decompose(N_size, udvl%N_part, TPUP, DUP, IPVT, TAU, WORK, LWORK)
ALLOCATE(VISITED(N_size))
Expand Down Expand Up @@ -345,7 +348,7 @@ SUBROUTINE CGR(PHASE,NVAR, GRUP, udvr, udvl)
! This is supposed to solve the system
! URUP U D V P^dagger ULUP G = 1
! initialize the rhs with CT(URUP)
RHS = CT(udvr%U)
RHS = conjg(transpose(udvr%U))
#if (defined(STAB3) || defined(STABLOG))
!scale RHS=R_+^-1*RHS
do J=1,N_size
Expand Down
15 changes: 10 additions & 5 deletions Prog/cgr2_2_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -234,11 +234,13 @@ SUBROUTINE CGR2_2(GRT0, GR00, GRTT, GR0T, udv2, udv1, LQ)
Complex (Kind=Kind(0.d0)), intent(inout) :: GRT0(LQ,LQ), GR0T(LQ,LQ), GR00(LQ,LQ), GRTT(LQ,LQ)

! Local::
Complex (Kind=Kind(0.d0)) :: V1INV(LQ,LQ)
Complex (Kind=Kind(0.d0)) :: D3B(2*LQ)
Complex (Kind=Kind(0.d0)), allocatable :: V1INV(:,:)
Complex (Kind=Kind(0.d0)), allocatable :: D3B(:)
Complex (Kind=Kind(0.d0)) :: Z, alpha, beta
Complex(Kind = Kind(0.D0)), allocatable, Dimension(:, :) :: MYU2, HLPB1, HLPB2, U3B, V3B
Integer :: LQ2, I,J, NCON

allocate( V1INV(LQ,LQ), D3B(2*LQ) )

if(udv1%side .ne. "L" .and. udv1%side .ne. "l" ) then
write(*,*) "calling wrong decompose"
Expand Down Expand Up @@ -302,7 +304,8 @@ SUBROUTINE CGR2_2(GRT0, GR00, GRTT, GR0T, udv2, udv1, LQ)
HLPB2(I+LQ, J ) = udv1%D(I)*conjg(udv1%U(J,I))!udv1%U(I,J)
ENDDO
ENDDO
HLPB1 = CT(HLPB2)
! HLPB1 = CT(HLPB2)
HLPB1 = conjg(transpose(HLPB2))

!CALL UDV_wrap(HLPB1,U3B,D3B,V3B,NCON)
CALL UDV_wrap_Pivot(HLPB1,U3B,D3B,V3B,NCON,LQ2,LQ2)
Expand Down Expand Up @@ -396,7 +399,8 @@ SUBROUTINE CGR2_2(GRT0, GR00, GRTT, GR0T, udv2, udv1, LQ)
HLPB2(I+LQ, J ) = -D2m(I)*udv2%V(I,J)
ENDDO
ENDDO
HLPB1 = CT(HLPB2)
! HLPB1 = CT(HLPB2)
HLPB1 = conjg(transpose(HLPB2))
call QDRP_decompose(LQ2, LQ2, HLPB1, D3, IPVT, TAU, WORK, LWORK)
call solve_extended_System(HLPB2, V1INV, MYU2, HLPB1, D3, TAU, IPVT, LQ, WORK, LWORK)
call get_blocks(GR00, GR0T, GRT0, GRTT, HLPB2, LQ)
Expand All @@ -410,7 +414,8 @@ SUBROUTINE CGR2_2(GRT0, GR00, GRTT, GR0T, udv2, udv1, LQ)
HLPB2(I+LQ, J ) = D1m(I)*conjg(udv1%U(J,I))!udv1%U(I,J)
ENDDO
ENDDO
HLPB1 = CT(HLPB2)
! HLPB1 = CT(HLPB2)
HLPB1 = conjg(transpose(HLPB2))
call QDRP_decompose(LQ2, LQ2, HLPB1, D3, IPVT, TAU, WORK, LWORK)
call solve_extended_System(HLPB2, MYU2, V1INV, HLPB1, D3, TAU, IPVT, LQ, WORK, LWORK)
call get_blocks(GRTT, GRT0, GR0T, GR00, HLPB2, LQ)
Expand Down
6 changes: 4 additions & 2 deletions Prog/tau_m_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -65,15 +65,17 @@ SUBROUTINE TAU_M(udvst, GR, PHASE, NSTM, NWRAP, STAB_NT, LOBS_ST, LOBS_EN)

! Local
! This could be placed as private for the module
Complex (Kind=Kind(0.d0)) :: GT0(NDIM,NDIM,N_FL), G00(NDIM,NDIM,N_FL), GTT(NDIM,NDIM,N_FL), G0T(NDIM,NDIM,N_FL)
Complex (Kind=Kind(0.d0)), Dimension(:,:,:), Allocatable :: GT0, G00, GTT, G0T
Complex (Kind=Kind(0.d0)), Dimension(:,:,:), Allocatable :: GT0_T, G00_T, GTT_T, G0T_T
CLASS(UDV_State), DIMENSION(:), ALLOCATABLE :: udvr
Complex (Kind=Kind(0.d0)) :: HLP4(Ndim,Ndim), HLP5(Ndim,Ndim), HLP6(Ndim,Ndim)
Complex (Kind=Kind(0.d0)), Dimension(:,:), Allocatable :: HLP4, HLP5, HLP6

Complex (Kind=Kind(0.d0)) :: Z
Integer :: I, J, nf, nf_eff, NT, NT1, NTST, NST, N, N_type
Real (Kind=Kind(0.d0)) :: spin, Mc_step_Weight

Allocate( HLP4(Ndim,Ndim), HLP5(Ndim,Ndim), HLP6(Ndim,Ndim) )
Allocate( G00(Ndim,Ndim,N_FL), G0T(Ndim,Ndim,N_FL), GT0(Ndim,Ndim,N_FL), GTT(Ndim,Ndim,N_FL) )
If (Symm) Then
Allocate ( G00_T(Ndim,Ndim,N_FL), G0T_T(Ndim,Ndim,N_FL), GT0_T(Ndim,Ndim,N_FL), GTT_T(Ndim,Ndim,N_FL) )
endif
Expand Down
2 changes: 1 addition & 1 deletion configure.sh
Original file line number Diff line number Diff line change
Expand Up @@ -193,7 +193,7 @@ INTELDEVFLAGS="-warn all -check all -g -traceback"
INTELUSEFULFLAGS="-std08"

INTELLLVMOPTFLAGS="-cpp -O3"
INTELLLVMOPTFLAGS="-cpp -O3 -fp-model=fast=2 -no-prec-div -static -xHost -unroll -finline-functions -heap-arrays 1024 -no-wrap-margin"
INTELLLVMOPTFLAGS="-cpp -O3 -fp-model=fast=2 -no-prec-div -static -xHost -unroll -finline-functions -no-wrap-margin"
# uncomment the next line if you want to use additional openmp parallelization
# INTELLLVMOPTFLAGS="${INTELLLVMOPTFLAGS} -qopenmp"
INTELLLVMDEVFLAGS="-warn all -check all,nouninit -g -traceback"
Expand Down