LCPQ/DEHam
2
0
Fork 0
mirror of https://github.com/LCPQ/DEHam synced 2024-12-22 04:13:44 +01:00
Code Issues Releases Wiki Activity

Merge pull request #3 from v1j4y/master

Browse Source 
Merge
This commit is contained in:
Anthony Scemama 2020-03-17 17:48:41 +01:00 committed by GitHub
commit 77544920f2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
25 changed files with 988 additions and 191 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
README.md
View File

@ -33,6 +33,9 @@ export C_INCLUDE_PATH+=:$PETSC_DIR/include/:$SLEPC_DIR/include:$PETSC_DIR/arch-l
make ex1
```
[![asciicast](https://asciinema.org/a/Ng3tSNDoWBkV5C9ZYvbxCW43B.png)](https://asciinema.org/a/Ng3tSNDoWBkV5C9ZYvbxCW43B)
_Using DEHam_
---------------
@ -53,16 +56,42 @@ true # Restrict the hole to the 1'st (i.e. half of natom) Family of states.
.1430,-0.20,0.0000 # The three types of links this line gives J, K
.1430,-0.20,0.0000 #
-1.00,0.0,0.00 # This line gives t
1 # Currently unused (Perhaps can be used for potential energy per site in the future.)
1 # The total number of roots
0.,0.,0.,0.,0.,0.,0.,0.,0. # Energy of each orbital + one extra term
2 # The total number of roots
1 # I The position of the first
1 # I SBox
1 # I
1 # I
1 # II The positions of the second
1 # II SBox
1 # II
1 # II
1 # III
1 # III The positions of the third
1 # III SBox
1 # III
1 # positio of the hole
0 # fix the position of the first hole during the CI
0 # fix the position of the second hole during the CI
0 # Print the wavefunction. It is stored in the FIL666 file after the run
```
2. running DEHam
```shell
mpiexec -n [nprocs] ./ex1 inpfile
mpiexec -n [nprocs] ./bin/ex1 input_file.inp
```
_Sample Application_
--------------------
A 2D t-J model Hamiltonian description and setup for using DEHam to solve for few low lying states
is provided in the notbooks folder. Please have a look about the details of using DEHam to study
t-J Hamiltonians.
![](https://raw.githubusercontent.com/v1j4y/DEHam/master/notebooks/graph.png)
_Publications using this code_
-------------------------------

30
examples/eight.inp Normal file
View File

@ -0,0 +1,30 @@
16
77
4
4
0
true
1,2,3,4,5,6,7, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,12,13,14,15
2,3,4,5,6,7,8,16,15,14,13,12,11,10, 9,10, 11, 12,13,14,15,16
1,1,1,1,1,1,1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3
.1430,-0.20,0.0000
.1430,-0.20,0.0000
-1.00,0.0,0.00
0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
2
1
1
1
1
1
1
1
1
1
1
1
1
1
0
0
0

30
examples/seven.inp Normal file
View File

@ -0,0 +1,30 @@
14
15
2
3
0
true
1,2,3,4,5,6, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13
2,3,4,5,6,7,14,13,12,11,10, 9, 8, 9,10,11,12,13,14
1,1,1,1,1,1, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3
.1430,-0.20,0.0000
.1430,-0.20,0.0000
-1.00,0.0,0.00
0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
2
1
1
1
1
1
1
1
1
1
1
1
1
1
0
0
0

22
examples/small.inp
View File

@ -1,6 +1,6 @@
8
140
1
35
4
1
0
true
@ -10,5 +10,21 @@ true
.1430,-0.20,0.0000
.1430,-0.20,0.0000
-1.00,0.0,0.00
1
0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
2
1
1
1
1
1
1
1
1
1
1
1
1
1
0
0
0

30
examples/tJ_2x2.inp Normal file
View File

@ -0,0 +1,30 @@
4
1
1
1
0
false
1,1,2,3
2,3,4,4
1,1,1,1
0.1430,0.0,0.00
0.1430,0.0,0.00
-1.000,0.0,0.00
0.0,0.0,0.0,0.0,0.0
2
1
1
1
1
1
1
1
1
1
1
1
1
1
0
0
0

30
examples/tJ_3x3.inp Normal file
View File

@ -0,0 +1,30 @@
9
7
1
1
0
false
1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9
2,3,1,5,6,4,8,9,7,4,5,6,7,8,9,1,2,3
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
0.1430,0.0,0.00
0.1430,0.0,0.00
-1.000,0.0,0.00
0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
2
1
1
1
1
1
1
1
1
1
1
1
1
1
0
0
0

30
examples/tJ_4x4.inp Normal file
View File

@ -0,0 +1,30 @@
16
33
4
1
0
false
1,2,3,4,5,6,7,8, 9,10,11,12,13,14,15,16, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16
2,3,4,1,6,7,8,5,10,11,12, 9,14,15,16,13, 5, 6, 7, 8, 9,10,11,12,13,14,15,16, 1, 2, 3, 4
1,1,1,1,1,1,1,1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
0.1430,0.0,0.00
0.1430,0.0,0.00
-1.000,0.0,0.00
0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
2
1
1
1
1
1
1
1
1
1
1
1
1
1
0
0
0

16
examples/three.inp
View File

@ -10,5 +10,21 @@ true
.1430,-0.20,0.0000
.1430,-0.20,0.0000
-1.00,0.0,0.00
0.0,0.0,0.0,0.0,0.0,0.0
1
1
1
1
1
1
1
1
1
1
1
1
1
1
0
0
0

30
examples/twenty.inp Normal file
View File

@ -0,0 +1,30 @@
20
77
4
3
0
true
1,2,3,4,5,6,7,8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,12,13,14,15,16,17,18,19
2,3,4,5,6,7,8,9,10,20,19,18,17,16,15,14,13,12, 11, 12,13,14,15,16,17,18,19,20
1,1,1,1,1,1,1,1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3
.1430,-0.20,0.0000
.1430,-0.20,0.0000
-1.00,0.0,0.00
0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
2
1
1
1
1
1
1
1
1
1
1
1
1
1
0
0
0

BIN
notebooks/graph.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 332 KiB

501
notebooks/t_J_Model.ipynb Normal file
View File

File diff suppressed because one or more lines are too long

8
src/elem_diag.irp.f
View File

@ -18,10 +18,10 @@
! if(.not.redo)write(6,*)'vijayyves'
do i=1,nlientot
if(yalt(i))then
! xmatd=-(xj1+xeneJ(i)*xbJ)+xmatd
xmatd= -(xjz(i))+xmatd
if(yw)write(6,*)xmatd,'xmatd'
if(yw)write(6,*)'xjz',xjz(i)
! xmatd=-(xj1+xeneJ(i)*xbJ)+xmatd
xmatd= -(xjz(i))+xmatd
if(yw)write(6,*)xmatd,'xmatd'
if(yw)write(6,*)'xjz',xjz(i)
endif
! if(yrep1(i))then
! xmat=xv1+xmat

7
src/ex1.c
View File

@ -121,6 +121,7 @@ int main(int argc,char **argv)
&getdata.fix_trou1,
&getdata.fix_trou2,
&getdata.FAM1,
&mpiid,
tcol,
val);
// if(i%getdata.npar == 0 && mpiid==0){
@ -128,9 +129,11 @@ int main(int argc,char **argv)
// }
for(ll=0;ll<getdata.nnz;ll++){
// printf("%d) ll=%d countcol=%d\n",i,ll,tcountcol[ll]+1);
for(kk=0;kk<tcountcol[ll]+1;kk++){
value[kk] = val[kk+tcountcol2];
col[kk] = tcol[kk+tcountcol2]-1;
// printf("%d) kk=%d col=%d val=%1.4f\n",i,kk,col[kk],value[kk]);
}
for(kk=tcountcol2+tcountcol[ll]+1;kk<natomax;kk++){
value[kk] = 0.0;
@ -211,8 +214,8 @@ int main(int argc,char **argv)
if (nconv>0) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/||kx|| <S^2>\n"
" ----------------- ----------------- ------------------\n");CHKERRQ(ierr);
" k ||Ax-kx||/||kx|| <S>\n"
" ----------------- ----------------- ------------------\n");CHKERRQ(ierr);
for(i=0;i<nev;i++){

212
src/extra_diag.irp.f
View File

@ -5,7 +5,7 @@
integer(C_SIZE_T) :: iaa,iaa2,tistart,tistart2
integer(C_SIZE_T) :: imat4,jmat4
integer :: i,ik,iik,j
integer :: ik1,ik2,IC,k,ikmax,ikmin,count,count2,detfound2
integer :: ik1,ik2,IC,k,ikmax,ikmin,count1,count2,detfound2
integer,allocatable :: ideter2(:)
real*8 :: dmat4,xmat
logical :: yw
@ -23,114 +23,130 @@
detfound2=0
foundadd=0
foundaddh=0
count=0
count1=0
count2=1
tistart2=tistart
do j=1,nrows
call getdet(tistart,ideter2)
deter=ideter2
ideter2=0
Touch deter
! call adr(deter,iaa)
! call elem_diag(xmat)
! countcol+=1
! col(countcol)=iaa
! val(countcol)=xmat*1.0d0
call getdet(tistart,ideter2)
deter=ideter2
! print *," j=",tistart
ideter2=0
Touch deter
count=0
yw=.FALSE.
do ik=1,nlientot
count1=0
yw=.FALSE.
do ik=1,nlientot
ik1=iliatom1(ik)
ik2=iliatom2(ik)
do k=1,natom
ideter2(k)=deter(k)
enddo
if(yalt(ik)) then
if (deter(ik1).eq.2) then
ideter2(ik1)=1
ideter2(ik2)=2
else
ideter2(ik1)=2
ideter2(ik2)=1
endif
dmat4=xjz(ik)
if(dmat4.ne.0d0)then
count+=1
foundet(:,detfound+count)=ideter2
foundetdmat(detfound+count)=dmat4
endif
endif
if(ytrou(ik)) then
if(deter(ik2).eq.3)then
if (deter(ik1).eq.1) then
ideter2(ik1)=3
ideter2(ik2)=1
else
ideter2(ik1)=3
ideter2(ik2)=2
endif
else
if (deter(ik2).eq.1) then
ideter2(ik1)=1
ideter2(ik2)=3
else
ideter2(ik1)=2
ideter2(ik2)=3
endif
endif
ikmin=min(ik1,ik2)
ikmax=max(ik1,ik2)
IC=0
do iik=ikmin+1,ikmax-1
if(deter(iik).ne.3)IC=IC+1
enddo
dmat4=(xt(ik))*(-1)**(IC)
if(dmat4.ne.0d0)then
count+=1
foundet(:,detfound+count)=ideter2
foundetdmat(detfound+count)=dmat4
endif
endif
enddo
detfound+=count
countcolfull(j)=count
tistart=tistart+1
enddo
Touch foundet foundetadr detfound foundadd foundaddh foundetdmat det deth
call adrfull()
do i=1,detfound
if(i.eq.1 .or. i-1.eq.detfound2)then
call getdet(tistart2,ideter2)
deter=ideter2
ideter2=0
Touch deter
call adr(deter,iaa)
call elem_diag(xmat)
countcol+=1
col(countcol)=iaa
val(countcol)=xmat*1.0d0
tistart2+=1
detfound2+=countcolfull(count2)
! if(i.ne.1)then
count2+=1
! endif
do k=1,natom
ideter2(k)=deter(k)
enddo
if(yalt(ik)) then
if (deter(ik1).eq.2) then
ideter2(ik1)=1
ideter2(ik2)=2
else
ideter2(ik1)=2
ideter2(ik2)=1
endif
dmat4=xjz(ik)
if(dmat4.ne.0d0)then
count1+=1
foundet(:,detfound+count1)=ideter2
foundetdmat(detfound+count1)=dmat4
endif
endif
if(ytrou(ik)) then
if(deter(ik2).eq.3)then
if (deter(ik1).eq.1) then
ideter2(ik1)=3
ideter2(ik2)=1
else
ideter2(ik1)=3
ideter2(ik2)=2
endif
else
if (deter(ik2).eq.1) then
ideter2(ik1)=1
ideter2(ik2)=3
else
ideter2(ik1)=2
ideter2(ik2)=3
endif
endif
ikmin=min(ik1,ik2)
ikmax=max(ik1,ik2)
IC=0
do iik=ikmin+1,ikmax-1
if(deter(iik).ne.3)IC=IC+1
enddo
dmat4=(xt(ik))*(-1)**(IC)
if(dmat4.ne.0d0)then
count1+=1
foundet(:,detfound+count1)=ideter2
foundetdmat(detfound+count1)=dmat4
endif
endif
imat4=iaa+1
jmat4=foundetadr(i)
dmat4=foundetdmat(i)
if(jmat4.le.(nt1*nt2) .and. dmat4 .ne. 0d0)then
countcol+=1
col(countcol)=jmat4
val(countcol)=dmat4
endif
enddo
detfound+=count1
countcolfull(j)=count1
tistart=tistart+1
enddo
! Check for large number of extradiagonal terms
if(detfound + count1 > maxlien)then
write(6,*)" ===================================================="
write(6,*)" *****WARNING*****: The number of extradiagonal terms &
exceedes maximum dimension of :",maxlien, &
" \n The calculation will be unreliable. Decrease the number &
of extradiagonal terms (nnz: second row in input) to solve &
this problem or increase maxlien."
write(6,*)" ===================================================="
endif
Touch foundet foundetadr detfound foundadd foundaddh foundetdmat det deth
call adrfull()
do i=1,detfound
if(i.eq.1 .or. i-1.eq.detfound2)then
call getdet(tistart2,ideter2)
deter=ideter2
! print *," ----> i=",i
! write(6,*)(ideter2(iik),iik=1,natom)
ideter2=0
Touch deter
call adr(deter,iaa)
call elem_diag(xmat)
countcol+=1
! print *,"1->id=",iaa," val=",xmat*1.0d0
col(countcol)=iaa
val(countcol)=xmat*1.0d0
tistart2+=1
detfound2+=countcolfull(count2)
! if(i.ne.1)then
count2+=1
! endif
endif
imat4=iaa+1
jmat4=foundetadr(i)
dmat4=foundetdmat(i)
if(jmat4.le.(nt1*nt2) .and. dmat4 .ne. 0d0)then
countcol+=1
! print *,"2->id=",jmat4," val=",dmat4
col(countcol)=jmat4
val(countcol)=dmat4
endif
enddo
! do i=0,200
! print *,i," det=",det(i,1)," add=",det(i,2)
! enddo
return
end

2
src/foundet.irp.f
View File

@ -1,7 +1,7 @@
use iso_c_binding
BEGIN_PROVIDER[integer, foundet,(natomax,maxlien)]
&BEGIN_PROVIDER[integer(C_SIZE_T), foundetadr,(maxlien)]
&BEGIN_PROVIDER[real, foundetdmat,(maxlien)]
&BEGIN_PROVIDER[real*8, foundetdmat,(maxlien)]
&BEGIN_PROVIDER[integer(C_SIZE_T), foundadd,(maxlien,3)]
&BEGIN_PROVIDER[integer(C_SIZE_T), foundaddh,(maxlien,3)]
&BEGIN_PROVIDER[integer, detfound]

3
src/get_s2.c
View File

@ -675,7 +675,8 @@ void get_s2(Vec xr, PetscInt *Istart, PetscInt *Iend, PetscScalar *valxr, int *n
*xymat2=*xymat2+xmat2;
*xymat3=*xymat3+xmat3;
*xymat4=*xymat4+xmat4;
// if(mpiid==3)printf(" ii = %d norm = %18f %18f 3 = %18f 4 = %18f\n", ii, *norm2, *norm3, *xymat2, *xymat3);
// if(mpiid==0)printf(" ii = %d norm = %18f %18f 3 = %18f 4 = %18f\n", ii, *norm2, *norm3, *xymat2, *xymat3);
// printf(" %d) ii = %d norm = %18f xymat = %18f 3 = %18f 4 = %18f\n",mpiid, ii, *norm, *xymat, *norm3, *xymat2, *xymat3);
}
ierr = PetscTime(&tt2);

19
src/getdet.irp.f
View File

@ -24,12 +24,12 @@ subroutine getdet(add,ideter)
detb = det(ib,1)
deta = deth(ia,1)
if(FAM1) then
if(fix_trou1 .eq. fix_trou2) then
deta = ISHFT(deta,-(natom/2))
else
natom2 = natom - (fix_trou2 - fix_trou1)
deta = ISHFT(deta, -natom2)
endif
if(fix_trou1 .eq. fix_trou2) then
deta = ISHFT(deta,-(natom/2))
else
natom2 = natom - (fix_trou2 - fix_trou1)
deta = ISHFT(deta, -natom2)
endif
endif
! do while (i.le.(ib))
! const=1
@ -50,7 +50,6 @@ subroutine getdet(add,ideter)
! i+=1
! write(6,14)deta,deta
! enddo
const=0
if(FAM1) then
if(fix_trou1 .eq. fix_trou2) then
natom2 = natom/2
@ -66,6 +65,12 @@ subroutine getdet(add,ideter)
ideter((natom2)-i)=3
endif
enddo
! do i=ib-2,ib+2
! print *,i," det=",det(i,1)," add=",det(i,2)
! enddo
! print *,"add=",ib," detb=",detb
! write(6,*)(ideter(i),i=1,natom)
const=0
do i=0,natom-1
if(ideter(natom-i).eq.1)then
if(BTEST(detb,const))then

126
src/natom.irp.f
View File

@ -94,33 +94,41 @@ BEGIN_PROVIDER [integer, natom]
! FAM1=.TRUE.
yham=.TRUE.
write(6,*)'HAMILTONIEN t-J'
write(6,*)'Le nombre de trou est : ',ntrou
write(6,*)'Famille 1 : ',FAM1
if(FAM1) then
if(fix_trou1 .ne. fix_trou2) write(6,*)'Trou fixe entre :', fix_trou1, "et ", fix_trou2
if(mpiid==0)then
write(6,*)'HAMILTONIEN t-J'
write(6,*)'Le nombre de trou est : ',ntrou
write(6,*)'Famille 1 : ',FAM1
if(FAM1) then
if(fix_trou1 .ne. fix_trou2) write(6,*)'Trou fixe entre :', fix_trou1, "et ", fix_trou2
endif
endif
!---------------------------------------------
write(6,*)' '
write(6,*)' '
write(6,*)'LECTURE DES ATOMES, DES LIAISONS, DES INTEGRALES'
write(6,*)' '
write(6,*)' '
if(mpiid==0)then
write(6,*)' '
write(6,*)' '
write(6,*)'LECTURE DES ATOMES, DES LIAISONS, DES INTEGRALES'
write(6,*)' '
write(6,*)' '
endif
!-----------Lecture 1ier voisin
! read(5,clust)
jclust=jclust+1
if(yw)write(6,*)' '
write(6,*)'================ CLUSTER',jclust,'=================='
write(6,*)' '
if(mpiid==0)then
write(6,*)'================ CLUSTER',jclust,'=================='
write(6,*)' '
endif
!------------------------
do i=1,maxlien
if(l1(i).eq.0)EXIT
nlien=i
enddo
if(mpiid==0)then
if(yw)write(6,*)(l1(i),i=1,maxlien)
write(6,*)'Liaisons entre les atomes',nlien
endif
do i=1,natomax
y(i)=.false.
@ -140,18 +148,22 @@ BEGIN_PROVIDER [integer, natom]
y(l1(i))=.true.
y(l2(i))=.true.
ltyp(nlientot+i)=ktyp(i)
if(mpiid==0)then
write(6,*)'Les atomes ',l1(i),' et ',l2(i),' forment la liaison', &
ilien(l1(i),l2(i)),'qui est de type',ltyp(i)
if(yw)write(6,*)'iliatom1',iliatom1(i)
endif
enddo
nlientot=nlientot+nlien
do i=1,natomax
if(y(i))natom=natom+1
enddo
write(6,*)'============================================='
write(6,*)'Le nombre total d atomes est ',natom
write(6,*)'============================================='
if(mpiid==0)then
write(6,*)'============================================='
write(6,*)'Le nombre total d atomes est ',natom
write(6,*)'============================================='
endif
!----------------------------------------------------------------
!----------------Voisins---------------------
@ -210,24 +222,28 @@ BEGIN_PROVIDER [integer, natom]
!C xjjxy=(/.1000d0,-0.8d0,0.000d0/)
!C xtt=(/-1.0000d0,0.d0,0.0d0/)
write(6,*)'Nombre de J differents',ityp
do ikl=1,nlientot
Ykl(ikl)=.false.
enddo
do il=1,nlientot
write(6,*)'type de liaison',il,ltyp(il)
enddo
do iiki=1,ityp
write(6,*)'type de J',xjjz(iiki)
enddo
if(mpiid==0)then
write(6,*)'Nombre de J differents',ityp
do il=1,nlientot
write(6,*)'type de liaison',il,ltyp(il)
enddo
do iiki=1,ityp
write(6,*)'type de J',xjjz(iiki)
enddo
endif
do il=1,nlientot
if(.not.ykl(il))then
xjz(il)=xjjz(ltyp(il))
write(6,*)'Parametres : Jz',il,'=',xjz(il)
xjxy(il)=xjjxy(ltyp(il))
write(6,*)'Parametres : Jxy',il,'=',xjxy(il)
xt(il)=xtt(ltyp(il))
write(6,*)'Parametre : t',il,'=',xt(il)
if(mpiid==0)then
write(6,*)'Parametres : Jz',il,'=',xjz(il)
write(6,*)'Parametres : Jxy',il,'=',xjxy(il)
write(6,*)'Parametre : t',il,'=',xt(il)
endif
ykl(il)=.true.
endif
enddo
@ -248,26 +264,28 @@ BEGIN_PROVIDER [integer, natom]
xenediagT=0.000d0
xspar=-0.00d0
xsperp=-0.00d0
write(6,*)'coucoudslect3'
write(6,*)'coucou'
write(6,*)'Parametres pour le t-J'
write(6,*)'xj1 = ',xj1
write(6,*)'xj2 = ',xj2
write(6,*)'xt1 = ',xt1
write(6,*)'xt2 = ',xt2
write(6,*)'xv1 = ',xv1
write(6,*)'xv2 = ',xv2
write(6,*)'xv3 = ',xv3
write(6,*)'xbj = ',xbj
write(6,*)'xbt = ',xbt
write(6,*)'xeneparJ = ',xeneparJ
write(6,*)'xeneperpJ = ',xeneperpJ
write(6,*)'xeneparT = ',xeneparT
write(6,*)'xeneperpT = ',xeneperpT
write(6,*)'xenediagJ = ',xenediagJ
write(6,*)'xenediagT = ',xenediagT
write(6,*)'xspar = ',xspar
write(6,*)'xsperp = ',xsperp
if(mpiid==0)then
write(6,*)'coucoudslect3'
write(6,*)'coucou'
write(6,*)'Parametres pour le t-J'
write(6,*)'xj1 = ',xj1
write(6,*)'xj2 = ',xj2
write(6,*)'xt1 = ',xt1
write(6,*)'xt2 = ',xt2
write(6,*)'xv1 = ',xv1
write(6,*)'xv2 = ',xv2
write(6,*)'xv3 = ',xv3
write(6,*)'xbj = ',xbj
write(6,*)'xbt = ',xbt
write(6,*)'xeneparJ = ',xeneparJ
write(6,*)'xeneperpJ = ',xeneperpJ
write(6,*)'xeneparT = ',xeneparT
write(6,*)'xeneperpT = ',xeneperpT
write(6,*)'xenediagJ = ',xenediagJ
write(6,*)'xenediagT = ',xenediagT
write(6,*)'xspar = ',xspar
write(6,*)'xsperp = ',xsperp
endif
!===================================================================
!====================================================================
! calcul des plaquettes pour un 2D t-J
@ -315,11 +333,13 @@ BEGIN_PROVIDER [integer, natom]
enddo
enddo
enddo
write(6,*)'Le systeme comporte ',nplac,' plaquettes.'
do kko=1,nplac
write(6,*)'La plaquette ',kko,' est contituee des atomes',&
iplac(1,kko),' ',iplac(2,kko),' ',iplac(3,kko),' et ',iplac(4,kko)
enddo
if(mpiid==0)then
write(6,*)'Le systeme comporte ',nplac,' plaquettes.'
do kko=1,nplac
write(6,*)'La plaquette ',kko,' est contituee des atomes',&
iplac(1,kko),' ',iplac(2,kko),' ',iplac(3,kko),' et ',iplac(4,kko)
enddo
endif
!===================================================================
! isz=0
IPREC=8
@ -332,6 +352,7 @@ BEGIN_PROVIDER [integer, natom]
xseuil=1.0E-008
ysuiv=.FALSE.
yec=.TRUE.
if(mpiid==0)then
write(6,*)'Spin total',isz
write(6,*)'Nombre de vecteurs demande',nvec
write(6,*)'Nombre maximal d iterations de Davidson',niter
@ -344,12 +365,15 @@ BEGIN_PROVIDER [integer, natom]
! write(6,*)Emin
! write(6,*)Emax
! write(6,*)M0
endif
if(yham)then
IAL0=(natom-ntrou)/2+mod(natom-ntrou,2)+isz
else
IAL0=(natom)/2+mod(natom,2)+isz
endif
write(6,*)'=======nombre de centres de spin alpha=====',ial0
if(mpiid==0)then
write(6,*)'=======nombre de centres de spin alpha=====',ial0
endif
natrest=natom-ntrou
!C calculating nalpha and nbeta

4
src/nt1.irp.f
View File

@ -16,5 +16,7 @@ BEGIN_PROVIDER [integer(C_SIZE_T), nt1]
endif
endif
nt1= nint(gamma(1.0*(natom2+1))/(gamma(1.0*(natom2-ntrou+1))*gamma(1.0*(ntrou+1))),selected_int_kind(16))
write(6,*)'nt1',nt1
if(mpiid==0)then
write(6,*)'nt1',nt1
endif
END_PROVIDER

4
src/nt2.irp.f
View File

@ -7,5 +7,7 @@ BEGIN_PROVIDER [integer(C_SIZE_T), nt2]
! call combin(idet2(1,nt2+1),natrest,ial0,nt2,32,jrangmax)
nt2= nint(gamma(1.0*(natom-ntrou+1))/((gamma(1.0*(nalpha+1))*gamma(1.0*(nbeta+1)))),selected_int_kind(16))
print *,"nt2=",nt2
if(mpiid==0)then
print *,"nt2=",nt2
endif
END_PROVIDER

23
src/providdet.irp.f
View File

@ -8,7 +8,7 @@ BEGIN_PROVIDER[integer(C_SIZE_T),det,(nt2,2)]
implicit none
! integer(kind=selected_int_kind(16))::dethsh
integer(C_SIZE_t)::a
integer(C_SIZE_T)::i,count
integer(C_SIZE_T)::i,count,iik
integer::const
i=1
a=0
@ -18,14 +18,7 @@ BEGIN_PROVIDER[integer(C_SIZE_T),det,(nt2,2)]
If(ntrou.ge.1)then
const=0
! dethsh = ISHFT(deth,-natom/2)
! i=nt1
do while (i.le.(nt1))
! if(a.eq.dethsh)then
! addh=i-1
! EXIT
! endif
i+=1
a+=1
do while(popcnt(a).ne.ntrou)
@ -42,21 +35,16 @@ BEGIN_PROVIDER[integer(C_SIZE_T),det,(nt2,2)]
deth(count, 1) = a
endif
deth(count,2)=i-1
! write(6,16)ISHFT(a,natom/2),ISHFT(a,natom/2),i-1
enddo
! if(a.eq.dethsh )then
! count+=1
! deth(1,1)=ISHFT(a,natom/2)
! deth(1,2)=nt1
! endif
endif
!C if det=0 then exit
a=0
i=0
count=0
print *,'nt2=',nt2,'nbeta=',nbeta
if(mpiid==0)then
print *,'nt2=',nt2,'nbeta=',nbeta
endif
do while (i.lt.(nt2))
i+=1
@ -79,6 +67,9 @@ BEGIN_PROVIDER[integer(C_SIZE_T),det,(nt2,2)]
endif
! write(6,16)a,a,i
enddo
! do i=0,nt2
! print *,i," det=",det(i,1)," add=",det(i,2)
! enddo
10 FORMAT(B64,I8,F8.2)

7
src/provide_mpiid.irp.f Normal file
View File

@ -0,0 +1,7 @@
use iso_c_binding
BEGIN_PROVIDER [integer(C_SIZE_T), mpiid]
BEGIN_DOC
! simply store the mpiid for pinting
END_DOC
END_PROVIDER

1
src/stimsyr.h
View File

@ -17,5 +17,6 @@ void unit_l1_(
long int *,
_Bool *,
long int *,
long int *,
double *);

3
src/unit_FIL44.irp.f
View File

@ -88,6 +88,7 @@
enddo
! print *,"tistart =", tistart,"countcol =", countcol,"\n",(tcountcol(i),i=1,nrows)
! print *,""
! print *,(tcol(i),i=1,maxlien)
! print *,(tval(i),i=1,maxdet)
! print *,(tcol(i),i=1,maxdet)
deallocate(ideter2)
end

6
src/unit_l1.irp.f
View File

@ -13,10 +13,11 @@
tfix_trou1, &
tfix_trou2, &
tfam1, &
tmpiid, &
tcol,tval)
use iso_c_binding
implicit none
integer,INTENT(INOUT)::tistart, tnrows
integer,INTENT(INOUT)::tistart, tnrows, tmpiid
integer,INTENT(INOUT)::tntrou, tisz
integer,INTENT(INOUT)::tfix_trou1, tfix_trou2
logical*1,INTENT(INOUT)::tfam1
@ -45,7 +46,8 @@
fix_trou2 = tfix_trou2
tcol=0
tval=0d0
provide l1 l2 ktyp xtt xjjxy xjjz ntrou
mpiid=tmpiid
provide l1 l2 ktyp xtt xjjxy xjjz ntrou mpiid
!print *,"l1"
!print *,l1
!print *,"xjjz"