LCPQ
/
DEHam
mirror of https://github.com/LCPQ/DEHam
2
0
Fork 0
Code Issues Releases Wiki Activity

Added some improvements to printing by adding mpiid. Printing is now done only by the master.

This commit is contained in:
v1j4y 2020-03-16 14:00:26 +01:00
parent fe70ca64c0
commit aec246a7c9
13 changed files with 222 additions and 185 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/elem_diag.irp.f
View File

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

7
src/ex1.c
View File

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

201
src/extra_diag.irp.f
View File

@ -5,7 +5,7 @@
integer(C_SIZE_T) :: iaa,iaa2,tistart,tistart2 integer(C_SIZE_T) :: iaa,iaa2,tistart,tistart2
integer(C_SIZE_T) :: imat4,jmat4 integer(C_SIZE_T) :: imat4,jmat4
integer :: i,ik,iik,j 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(:) integer,allocatable :: ideter2(:)
real*8 :: dmat4,xmat real*8 :: dmat4,xmat
logical :: yw logical :: yw
@ -23,114 +23,119 @@
detfound2=0 detfound2=0
foundadd=0 foundadd=0
foundaddh=0 foundaddh=0
count=0 count1=0
count2=1 count2=1
tistart2=tistart tistart2=tistart
do j=1,nrows do j=1,nrows
call getdet(tistart,ideter2) call getdet(tistart,ideter2)
deter=ideter2 deter=ideter2
ideter2=0 ! print *," j=",tistart
Touch deter ideter2=0
! call adr(deter,iaa) Touch deter
! call elem_diag(xmat)
! countcol+=1
! col(countcol)=iaa
! val(countcol)=xmat*1.0d0
count=0 count1=0
yw=.FALSE. yw=.FALSE.
do ik=1,nlientot do ik=1,nlientot
ik1=iliatom1(ik) ik1=iliatom1(ik)
ik2=iliatom2(ik) ik2=iliatom2(ik)
do k=1,natom do k=1,natom
ideter2(k)=deter(k) ideter2(k)=deter(k)
enddo enddo
if(yalt(ik)) then if(yalt(ik)) then
if (deter(ik1).eq.2) then if (deter(ik1).eq.2) then
ideter2(ik1)=1 ideter2(ik1)=1
ideter2(ik2)=2 ideter2(ik2)=2
else else
ideter2(ik1)=2 ideter2(ik1)=2
ideter2(ik2)=1 ideter2(ik2)=1
endif endif
dmat4=xjz(ik) dmat4=xjz(ik)
if(dmat4.ne.0d0)then if(dmat4.ne.0d0)then
count+=1 count1+=1
foundet(:,detfound+count)=ideter2 foundet(:,detfound+count1)=ideter2
foundetdmat(detfound+count)=dmat4 foundetdmat(detfound+count1)=dmat4
endif endif
endif endif
if(ytrou(ik)) then if(ytrou(ik)) then
if(deter(ik2).eq.3)then if(deter(ik2).eq.3)then
if (deter(ik1).eq.1) then if (deter(ik1).eq.1) then
ideter2(ik1)=3 ideter2(ik1)=3
ideter2(ik2)=1 ideter2(ik2)=1
else else
ideter2(ik1)=3 ideter2(ik1)=3
ideter2(ik2)=2 ideter2(ik2)=2
endif endif
else else
if (deter(ik2).eq.1) then if (deter(ik2).eq.1) then
ideter2(ik1)=1 ideter2(ik1)=1
ideter2(ik2)=3 ideter2(ik2)=3
else else
ideter2(ik1)=2 ideter2(ik1)=2
ideter2(ik2)=3 ideter2(ik2)=3
endif endif
endif endif
ikmin=min(ik1,ik2) ikmin=min(ik1,ik2)
ikmax=max(ik1,ik2) ikmax=max(ik1,ik2)
IC=0 IC=0
do iik=ikmin+1,ikmax-1 do iik=ikmin+1,ikmax-1
if(deter(iik).ne.3)IC=IC+1 if(deter(iik).ne.3)IC=IC+1
enddo enddo
dmat4=(xt(ik))*(-1)**(IC) dmat4=(xt(ik))*(-1)**(IC)
if(dmat4.ne.0d0)then if(dmat4.ne.0d0)then
count+=1 count1+=1
foundet(:,detfound+count)=ideter2 foundet(:,detfound+count1)=ideter2
foundetdmat(detfound+count)=dmat4 foundetdmat(detfound+count1)=dmat4
endif 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
endif endif
imat4=iaa+1 enddo
jmat4=foundetadr(i)
dmat4=foundetdmat(i) detfound+=count1
if(jmat4.le.(nt1*nt2) .and. dmat4 .ne. 0d0)then countcolfull(j)=count1
countcol+=1 tistart=tistart+1
col(countcol)=jmat4
val(countcol)=dmat4
endif
enddo 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
! 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 return
end end

2
src/foundet.irp.f
View File

@ -1,7 +1,7 @@
use iso_c_binding use iso_c_binding
BEGIN_PROVIDER[integer, foundet,(natomax,maxlien)] BEGIN_PROVIDER[integer, foundet,(natomax,maxlien)]
&BEGIN_PROVIDER[integer(C_SIZE_T), foundetadr,(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), foundadd,(maxlien,3)]
&BEGIN_PROVIDER[integer(C_SIZE_T), foundaddh,(maxlien,3)] &BEGIN_PROVIDER[integer(C_SIZE_T), foundaddh,(maxlien,3)]
&BEGIN_PROVIDER[integer, detfound] &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; *xymat2=*xymat2+xmat2;
*xymat3=*xymat3+xmat3; *xymat3=*xymat3+xmat3;
*xymat4=*xymat4+xmat4; *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); ierr = PetscTime(&tt2);

19
src/getdet.irp.f
View File

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

126
src/natom.irp.f
View File

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

23
src/providdet.irp.f
View File

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

1
src/stimsyr.h
View File

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

3
src/unit_FIL44.irp.f
View File

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

6
src/unit_l1.irp.f
View File

@ -13,10 +13,11 @@
tfix_trou1, & tfix_trou1, &
tfix_trou2, & tfix_trou2, &
tfam1, & tfam1, &
tmpiid, &
tcol,tval) tcol,tval)
use iso_c_binding use iso_c_binding
implicit none implicit none
integer,INTENT(INOUT)::tistart, tnrows integer,INTENT(INOUT)::tistart, tnrows, tmpiid
integer,INTENT(INOUT)::tntrou, tisz integer,INTENT(INOUT)::tntrou, tisz
integer,INTENT(INOUT)::tfix_trou1, tfix_trou2 integer,INTENT(INOUT)::tfix_trou1, tfix_trou2
logical*1,INTENT(INOUT)::tfam1 logical*1,INTENT(INOUT)::tfam1
@ -45,7 +46,8 @@
fix_trou2 = tfix_trou2 fix_trou2 = tfix_trou2
tcol=0 tcol=0
tval=0d0 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 *,l1 !print *,l1
!print *,"xjjz" !print *,"xjjz"