From 62dba9a3c59de70c45b07f3a25b908144ce999d5 Mon Sep 17 00:00:00 2001 From: vijay gopal chilkuri Date: Sun, 28 Jan 2018 11:05:08 +0100 Subject: [PATCH] now limit the hole movement by giving range --- src/ex1.c | 4 +++- src/getdet.irp.f | 15 +++++++++++++-- src/natom.irp.f | 3 +++ src/nt1.irp.f | 8 +++++++- src/providdet.irp.f | 6 +++++- src/provide_clust.irp.f | 10 ++++++---- src/read2.c | 10 ++++++++-- src/read2.h | 8 +++++--- src/unit_l1.irp.f | 8 +++++++- 9 files changed, 57 insertions(+), 15 deletions(-) diff --git a/src/ex1.c b/src/ex1.c index b37e99c..d27c41f 100644 --- a/src/ex1.c +++ b/src/ex1.c @@ -127,13 +127,15 @@ int main(int argc,char **argv) getdata.l2, getdata.ktyp, &iii, - &getdata.nnz, + &getdata.nnz, getdata.xjjxy, getdata.xjjz , getdata.xtt , tcountcol, &getdata.ntrou, &getdata.isz, + &getdata.fix_trou1, + &getdata.fix_trou2, &getdata.FAM1, tcol, val); diff --git a/src/getdet.irp.f b/src/getdet.irp.f index a4e451c..fa98b05 100644 --- a/src/getdet.irp.f +++ b/src/getdet.irp.f @@ -22,7 +22,14 @@ subroutine getdet(add,ideter) i=1 detb = det(ib,1) deta = deth(ia,1) - if(FAM1) deta = ISHFT(deta,-(natom/2)) + 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 + endif ! do while (i.le.(ib)) ! const=1 ! do while(popcnt(detb).ne.nbeta .or. const==1) @@ -44,7 +51,11 @@ subroutine getdet(add,ideter) ! enddo const=0 if(FAM1) then - natom2 = natom/2 + if(fix_trou1 .eq. fix_trou2) then + natom2 = natom/2 + else + natom2 = (fix_trou2 - fix_trou1) + endif else natom2 = natom endif diff --git a/src/natom.irp.f b/src/natom.irp.f index cd47a04..58bf864 100644 --- a/src/natom.irp.f +++ b/src/natom.irp.f @@ -97,6 +97,9 @@ BEGIN_PROVIDER [integer, natom] 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 !--------------------------------------------- write(6,*)' ' write(6,*)' ' diff --git a/src/nt1.irp.f b/src/nt1.irp.f index 64c3e78..11dda96 100644 --- a/src/nt1.irp.f +++ b/src/nt1.irp.f @@ -7,7 +7,13 @@ BEGIN_PROVIDER [integer(kind=selected_int_kind(16)), nt1] ! call combin(idet1(1,nt1+1),natom,ntrou,nt1,32,jrangmax) natom2=natom - if(FAM1)natom2=natom/2 + if(FAM1) then + if(fix_trou1 .eq. fix_trou2) then + natom2=natom/2 + else + natom2 = fix_trou2 - fix_trou1 + endif + endif nt1= nint(gamma(real(natom2+1,16))/(gamma(real(natom2-ntrou+1,16))*gamma(real(ntrou+1,16))),selected_int_kind(16)) write(6,*)'nt1',nt1 END_PROVIDER diff --git a/src/providdet.irp.f b/src/providdet.irp.f index 959940f..577890a 100644 --- a/src/providdet.irp.f +++ b/src/providdet.irp.f @@ -31,7 +31,11 @@ BEGIN_PROVIDER[integer(kind=selected_int_kind(16)),det,(nt2,2)] enddo count+=1 if(FAM1) then - deth(count,1)=ISHFT(a,natom/2) + if(fix_trou1 .eq. fix_trou2) then + deth(count,1)=ISHFT(a,natom/2) + else + deth(count,1)=ISHFT(a,natom - (fix_trou2-fix_trou1)) + endif else deth(count, 1) = a endif diff --git a/src/provide_clust.irp.f b/src/provide_clust.irp.f index a529887..9ed9988 100644 --- a/src/provide_clust.irp.f +++ b/src/provide_clust.irp.f @@ -1,12 +1,14 @@ BEGIN_PROVIDER[integer,l1, (maxlien)] &BEGIN_PROVIDER[integer,l2, (maxlien)] &BEGIN_PROVIDER[integer,ktyp,(maxlien)] -&BEGIN_PROVIDER [real*8, xtt ,(maxlien)] +&BEGIN_PROVIDER[real*8, xtt ,(maxlien)] &BEGIN_PROVIDER[real*8, xjjz ,(maxlien)] &BEGIN_PROVIDER[real*8, xjjxy,(maxlien)] -&BEGIN_PROVIDER [integer, ntrou] -&BEGIN_PROVIDER [integer, isz] -&BEGIN_PROVIDER [logical*1, FAM1] +&BEGIN_PROVIDER[integer, ntrou] +&BEGIN_PROVIDER[integer, isz] +&BEGIN_PROVIDER[logical*1, FAM1] +&BEGIN_PROVIDER[integer, fix_trou1] +&BEGIN_PROVIDER[integer, fix_trou2] implicit none ! integer::i ! open(unit=11,file="l1.dat",form="formatted") diff --git a/src/read2.c b/src/read2.c index f2308f0..9fcd19e 100644 --- a/src/read2.c +++ b/src/read2.c @@ -13,7 +13,7 @@ void Data_new(FILE* file, Data* dat) { /* note that fgets don't strip the terminating \n, checking its presence would allow to handle lines longer that sizeof(line) */ - if (count != 26){ + if (count != 29){ count++; switch(count){ case 1: @@ -223,6 +223,12 @@ void Data_new(FILE* file, Data* dat) { case 27: dat->postrou=atol(line); break; + case 28: + dat->fix_trou1=atol(line); + break; + case 29: + dat->fix_trou2=atol(line); + break; } /* end of switch */ } /* end of the input file */ @@ -232,7 +238,7 @@ void Data_new(FILE* file, Data* dat) { //return dat; } -PetscBool to_bool(const char* str) { +_Bool to_bool(const char* str) { PetscBool strflg; PetscStrcmp("true\n",str, &strflg); if(!strflg) PetscStrcmp("True\n",str, &strflg); diff --git a/src/read2.h b/src/read2.h index dedce9c..ce325db 100644 --- a/src/read2.h +++ b/src/read2.h @@ -6,13 +6,13 @@ #include #include -PetscBool to_bool(const char* str); +_Bool to_bool(const char* str); typedef struct { PetscInt n; long int nnz,npar; long int ntrou,isz; - PetscBool FAM1; + _Bool FAM1; long int l1[700]; long int l2[700]; long int ktyp[700]; @@ -33,7 +33,9 @@ typedef struct { int s23a2; int s23b1; int s23b2; - int postrou; + long int postrou; + long int fix_trou1; + long int fix_trou2; } Data ; diff --git a/src/unit_l1.irp.f b/src/unit_l1.irp.f index 2bb5ecf..cb61e46 100644 --- a/src/unit_l1.irp.f +++ b/src/unit_l1.irp.f @@ -9,10 +9,14 @@ tcountcol, & tntrou, & tisz, & + tfix_trou1, & + tfix_trou2, & tfam1, & tcol,tval) implicit none - integer,INTENT(INOUT)::tistart, tnrows, tntrou, tisz + integer,INTENT(INOUT)::tistart, tnrows + integer,INTENT(INOUT)::tntrou, tisz + integer,INTENT(INOUT)::tfix_trou1, tfix_trou2 logical*1,INTENT(INOUT)::tfam1 integer::i real*8,INTENT(INOUT)::tval(maxlien) @@ -34,6 +38,8 @@ ntrou = tntrou isz = tisz FAM1 = tfam1 + fix_trou1 = tfix_trou1 + fix_trou2 = tfix_trou2 tcol=0 tval=0d0 provide l1 l2 ktyp xtt xjjxy xjjz ntrou