diff --git a/src/elem_diag.irp.f b/src/elem_diag.irp.f index 85b244f..96fc01e 100644 --- a/src/elem_diag.irp.f +++ b/src/elem_diag.irp.f @@ -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 diff --git a/src/ex1.c b/src/ex1.c index c2a2659..98f89f0 100644 --- a/src/ex1.c +++ b/src/ex1.c @@ -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;ll0) { ierr = PetscPrintf(PETSC_COMM_WORLD, - " k ||Ax-kx||/||kx|| \n" - " ----------------- ----------------- ------------------\n");CHKERRQ(ierr); + " k ||Ax-kx||/||kx|| \n" + " ----------------- ----------------- ------------------\n");CHKERRQ(ierr); for(i=0;i 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 diff --git a/src/foundet.irp.f b/src/foundet.irp.f index e95c062..de6c850 100644 --- a/src/foundet.irp.f +++ b/src/foundet.irp.f @@ -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] diff --git a/src/get_s2.c b/src/get_s2.c index 081213e..7a82498 100644 --- a/src/get_s2.c +++ b/src/get_s2.c @@ -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); diff --git a/src/getdet.irp.f b/src/getdet.irp.f index acba73a..ba30c33 100644 --- a/src/getdet.irp.f +++ b/src/getdet.irp.f @@ -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 diff --git a/src/natom.irp.f b/src/natom.irp.f index 58bf864..d588596 100644 --- a/src/natom.irp.f +++ b/src/natom.irp.f @@ -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 diff --git a/src/nt1.irp.f b/src/nt1.irp.f index 8bd0124..1832b17 100644 --- a/src/nt1.irp.f +++ b/src/nt1.irp.f @@ -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 diff --git a/src/nt2.irp.f b/src/nt2.irp.f index 0ff4c5d..51fee91 100644 --- a/src/nt2.irp.f +++ b/src/nt2.irp.f @@ -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 diff --git a/src/providdet.irp.f b/src/providdet.irp.f index d651244..afac84c 100644 --- a/src/providdet.irp.f +++ b/src/providdet.irp.f @@ -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) diff --git a/src/stimsyr.h b/src/stimsyr.h index 5964517..798c85f 100644 --- a/src/stimsyr.h +++ b/src/stimsyr.h @@ -17,5 +17,6 @@ void unit_l1_( long int *, _Bool *, long int *, + long int *, double *); diff --git a/src/unit_FIL44.irp.f b/src/unit_FIL44.irp.f index 96da0c8..46a7ddd 100644 --- a/src/unit_FIL44.irp.f +++ b/src/unit_FIL44.irp.f @@ -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 diff --git a/src/unit_l1.irp.f b/src/unit_l1.irp.f index fc0dc40..b897a01 100644 --- a/src/unit_l1.irp.f +++ b/src/unit_l1.irp.f @@ -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"