Merge pull request #3 from v1j4y/master

Merge

README.md

@@ -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.)
+0.,0.,0.,0.,0.,0.,0.,0.,0. # Energy of each orbital + one extra term
-1                   # The total number of roots
+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_
 -------------------------------
 

examples/eight.inp

@@ -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

examples/seven.inp

@@ -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

examples/small.inp

@@ -1,6 +1,6 @@
 8
-140
+35
-1
+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

examples/tJ_2x2.inp

@@ -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

examples/tJ_3x3.inp

@@ -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

examples/tJ_4x4.inp

@@ -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

examples/three.inp

@@ -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

examples/twenty.inp

@@ -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

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=-(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
 !         if(yrep1(i))then
 !              xmat=xv1+xmat

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;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"
+         "               k          ||Ax-kx||/||kx||         <S>\n"
-         "   ----------------- ----------------- ------------------\n");CHKERRQ(ierr);
+         "       ----------------- ----------------- ------------------\n");CHKERRQ(ierr);
 
    for(i=0;i<nev;i++){
 

src/extra_diag.irp.f

@@ -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)
+        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)
           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
-	       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
+        enddo
-              endif
+        
+!       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

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]

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);

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
+      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
 !    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

src/natom.irp.f

@@ -94,33 +94,41 @@ BEGIN_PROVIDER [integer, natom]
 
 !      FAM1=.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
 !---------------------------------------------
-      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
 !     read(5,clust)
         jclust=jclust+1
 	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
 	  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,*)'============================================='
+      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---------------------
@@ -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
+       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
          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'
+        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
@@ -315,11 +333,13 @@ BEGIN_PROVIDER [integer, natom]
 	      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
     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

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

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

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)

src/provide_mpiid.irp.f

@@ -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
+

src/stimsyr.h

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

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

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"