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

looks like now it works for natom > 16

Browse Source
This commit is contained in:
vijay gopal chilkuri 2018-01-29 00:10:47 +01:00
parent 2262d8dce6
commit aeabef5ded
26 changed files with 96 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/adr.irp.f
View File

@ -1,4 +1,5 @@
subroutine adr(ideter,add) subroutine adr(ideter,add)
use iso_c_binding
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! this subroutine provides the address of a detrminant ! this subroutine provides the address of a detrminant
@ -7,8 +8,8 @@ subroutine adr(ideter,add)
! matches the given determinant. ! matches the given determinant.
END_DOC END_DOC
integer,INTENT(INOUT)::ideter(natomax) integer,INTENT(INOUT)::ideter(natomax)
integer(kind=selected_int_kind(16)),INTENT(INOUT)::add integer(C_SIZE_T),INTENT(INOUT)::add
integer(kind=selected_int_kind(16))::deti,dethi,addh,detnew integer(C_SIZE_T)::deti,dethi,addh,detnew
integer::count,i,j integer::count,i,j
deti=0 deti=0

5
src/adrnew.irp.f
View File

@ -1,5 +1,6 @@
subroutine adrfull() subroutine adrfull()
implicit none implicit none
use iso_c_binding
BEGIN_DOC BEGIN_DOC
! this subroutine provides the address of a detrminant ! this subroutine provides the address of a detrminant
! given in old format. ! given in old format.
@ -7,8 +8,8 @@ subroutine adrfull()
! matches the given determinant. ! matches the given determinant.
END_DOC END_DOC
integer,dimension(natomax)::ideter integer,dimension(natomax)::ideter
integer(kind=selected_int_kind(16))::add integer(C_SIZE_T)::add
integer(kind=selected_int_kind(16))::deti,dethi,addh,detnew integer(C_SIZE_T)::deti,dethi,addh,detnew
integer::count,i,j integer::count,i,j
deti=0 deti=0

5
src/analyse.irp.f
View File

@ -1,10 +1,11 @@
SUBROUTINE ANALYSE(vect, dimvect, startvect, endvect, xymat2, norm2) SUBROUTINE ANALYSE(vect, dimvect, startvect, endvect, xymat2, norm2)
! INCLUDE "nbtots.prm" ! INCLUDE "nbtots.prm"
use iso_c_binding
IMPLICIT NONE IMPLICIT NONE
INTEGER dimvect, nbtots, startvect, endvect INTEGER dimvect, nbtots, startvect, endvect
REAL*8,dimension(dimvect)::vect REAL*8,dimension(dimvect)::vect
INTEGER (kind=selected_int_kind(16))::add,kvect INTEGER (C_SIZE_T)::add,kvect
INTEGER (kind=selected_int_kind(16))::iaa2,i INTEGER (C_SIZE_T)::iaa2,i
INTEGER ,dimension(natomax)::ideter INTEGER ,dimension(natomax)::ideter
INTEGER ,dimension(natomax)::ideter2 INTEGER ,dimension(natomax)::ideter2
REAL*8,allocatable ::xz(:) REAL*8,allocatable ::xz(:)

5
src/conv.irp.f
View File

@ -1,12 +1,13 @@
subroutine conv(ideter,deti,dethi) subroutine conv(ideter,deti,dethi)
use iso_c_binding
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! this routine converts a detrminant in the old ! this routine converts a detrminant in the old
! format into the new one and returns the determinant. ! format into the new one and returns the determinant.
END_DOC END_DOC
integer,INTENT(INOUT)::ideter(natomax) integer,INTENT(INOUT)::ideter(natomax)
integer(kind=selected_int_kind(16)),INTENT(INOUT)::deti integer(C_SIZE_T),INTENT(INOUT)::deti
integer(kind=selected_int_kind(16)),INTENT(INOUT)::dethi integer(C_SIZE_T),INTENT(INOUT)::dethi
integer::i integer::i
deti=0 deti=0
dethi=0 dethi=0

3
src/desort.irp.f
View File

@ -1,7 +1,8 @@
subroutine desort() subroutine desort()
use iso_c_binding
implicit none implicit none
integer::i,j,ord,ordh integer::i,j,ord,ordh
integer(kind=selected_int_kind(16))::add,addh,deti,dethi,addt integer(C_SIZE_T)::add,addh,deti,dethi,addt
do i=1,detfound-1 do i=1,detfound-1
do j=i+1,detfound do j=i+1,detfound

24
src/ex1.c
View File

@ -27,9 +27,10 @@ int main(int argc,char **argv)
PetscReal normfin2=0.0; PetscReal normfin2=0.0;
PetscReal normfin3=0.0; PetscReal normfin3=0.0;
PetscReal normfin4=0.0; PetscReal normfin4=0.0;
PetscScalar kr,ki,value[700]; const int natomax=900;
PetscScalar kr,ki,value[natomax];
Vec xr,xi; Vec xr,xi;
PetscInt i,Istart,Iend,col[700],maxit,its,nconv,countcol; PetscInt i,Istart,Iend,col[natomax],maxit,its,nconv,countcol;
PetscInt nev, ncv, mpd; PetscInt nev, ncv, mpd;
PetscLogDouble t1,t2,tt1,tt2; PetscLogDouble t1,t2,tt1,tt2;
//PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE; //PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE;
@ -37,7 +38,6 @@ int main(int argc,char **argv)
//PetscScalar eigr; //PetscScalar eigr;
//PetscScalar eigi; //PetscScalar eigi;
int mpiid; int mpiid;
int natomax=700;
char const* const fileName = argv[1]; char const* const fileName = argv[1];
FILE* file = fopen(fileName, "r"); FILE* file = fopen(fileName, "r");
@ -60,8 +60,8 @@ int main(int argc,char **argv)
PetscInt kk,ll,mm,nn,iii2,iiii; PetscInt kk,ll,mm,nn,iii2,iiii;
PetscInt ii; PetscInt ii;
long int iii; long int iii;
long int tcountcol2,tcol[700],tcountcol[getdata.nnz]; long int tcountcol2,tcol[natomax],tcountcol[getdata.nnz];
double val[700]; double val[natomax];
PetscReal xymat=0.0; PetscReal xymat=0.0;
PetscReal xymat2=0.0; PetscReal xymat2=0.0;
PetscReal xymat3=0.0; PetscReal xymat3=0.0;
@ -96,8 +96,8 @@ int main(int argc,char **argv)
SlepcInitialize(&argc,&argv,(char*)0,NULL); SlepcInitialize(&argc,&argv,(char*)0,NULL);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n1-D t-J Eigenproblem, n=%D\n\n",getdata.n);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n1-D t-J Eigenproblem, n=%D\n\n",getdata.n);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatCreateAIJ(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,getdata.n,getdata.n,2.0*getdata.natom,NULL,2.0*getdata.natom,NULL,&A);CHKERRQ(ierr); ierr = MatCreateAIJ(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,getdata.n,getdata.n,10*getdata.natom,NULL,10*getdata.natom,NULL,&A);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(A,getdata.natom,NULL,getdata.natom,NULL);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(A,10*getdata.natom,NULL,10*getdata.natom,NULL);CHKERRQ(ierr);
//ierr = MatSetFromOptions(A);CHKERRQ(ierr); //ierr = MatSetFromOptions(A);CHKERRQ(ierr);
//ierr = MatSetUp(A);CHKERRQ(ierr); //ierr = MatSetUp(A);CHKERRQ(ierr);
@ -149,7 +149,7 @@ int main(int argc,char **argv)
col[kk] = tcol[kk+tcountcol2]-1; col[kk] = tcol[kk+tcountcol2]-1;
// PetscPrintf(PETSC_COMM_WORLD,"value = %f col = %d\n",value[kk],col[kk]); // PetscPrintf(PETSC_COMM_WORLD,"value = %f col = %d\n",value[kk],col[kk]);
} }
for(kk=tcountcol2+tcountcol[ll]+1;kk<700;kk++){ for(kk=tcountcol2+tcountcol[ll]+1;kk<natomax;kk++){
value[kk] = 0.0; value[kk] = 0.0;
col[kk] = 0; col[kk] = 0;
} }
@ -268,13 +268,13 @@ int main(int argc,char **argv)
get_s2(xr, &Istart, &Iend, values, &getdata.natom, &norm, &norm2, &norm3, &norm4, &xymat, &xymat2, &xymat3, &xymat4, &weight3, get_s2(xr, &Istart, &Iend, values, &getdata.natom, &norm, &norm2, &norm3, &norm4, &xymat, &xymat2, &xymat3, &xymat4, &weight3,
&getdata.s21a1, &getdata.s21a2, &getdata.s21b1, &getdata.s21b2, &getdata.s22a1, &getdata.s22a2, &getdata.s21a1, &getdata.s21a2, &getdata.s21b1, &getdata.s21b2, &getdata.s22a1, &getdata.s22a2,
&getdata.s22b1, &getdata.s22b2, &getdata.s23a1, &getdata.s23a2, &getdata.s22b1, &getdata.s22b2, &getdata.s23a1, &getdata.s23a2,
&getdata.s23b1, &getdata.s23b2, &getdata.postrou); &getdata.s23b1, &getdata.s23b2, &getdata.postrou, natomax);
// get_s2_cyclic(xr, &Istart, &Iend, values, &getdata.natom, &norm, &norm2, &norm3, &norm4, &xymat, &xymat2, &xymat3, &xymat4, // get_s2_cyclic(xr, &Istart, &Iend, values, &getdata.natom, &norm, &norm2, &norm3, &norm4, &xymat, &xymat2, &xymat3, &xymat4,
// &getdata.s21a1, &getdata.s21a2, &getdata.s21b1, &getdata.s21b2, &getdata.s22a1, &getdata.s22a2, // &getdata.s21a1, &getdata.s21a2, &getdata.s21b1, &getdata.s21b2, &getdata.s22a1, &getdata.s22a2,
// &getdata.s22b1, &getdata.s22b2, &getdata.s23a1, &getdata.s23a2, // &getdata.s22b1, &getdata.s22b2, &getdata.s23a1, &getdata.s23a2,
// &getdata.s23b1, &getdata.s23b2, &getdata.postrou); // &getdata.s23b1, &getdata.s23b2, &getdata.postrou, natomax);
// get_1rdm(values, &Istart, &Iend, &getdata.natom, &trace1rdm); // get_1rdm(values, &Istart, &Iend, &getdata.natom, &trace1rdm, natomax);
// get_2rdm(values, &Istart, &Iend, &getdata.natom, &trace2rdm, densmat2); // get_2rdm(values, &Istart, &Iend, &getdata.natom, &trace2rdm, densmat2, natomax);
// analyse_(valxr, (Iend-Istart), &Istart, &Iend, &xymat, &norm); // analyse_(valxr, (Iend-Istart), &Istart, &Iend, &xymat, &norm);
VecRestoreArray(vec2,&values); VecRestoreArray(vec2,&values);
ierr = VecRestoreArray(xr, &valxr);CHKERRQ(ierr); ierr = VecRestoreArray(xr, &valxr);CHKERRQ(ierr);

5
src/extra_diag.irp.f
View File

@ -1,8 +1,9 @@
subroutine extra_diag(tistart) subroutine extra_diag(tistart)
use iso_c_binding
implicit none implicit none
integer(kind=selected_int_kind(16)) :: iaa,iaa2,tistart,tistart2 integer(C_SIZE_T) :: iaa,iaa2,tistart,tistart2
integer(kind=selected_int_kind(16)) :: 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,count,count2,detfound2
integer,allocatable :: ideter2(:) integer,allocatable :: ideter2(:)

7
src/foundet.irp.f
View File

@ -1,8 +1,9 @@
use iso_c_binding
BEGIN_PROVIDER[integer, foundet,(natomax,maxlien)] BEGIN_PROVIDER[integer, foundet,(natomax,maxlien)]
&BEGIN_PROVIDER[integer(kind=selected_int_kind(16)), foundetadr,(maxlien)] &BEGIN_PROVIDER[integer(C_SIZE_T), foundetadr,(maxlien)]
&BEGIN_PROVIDER[real, foundetdmat,(maxlien)] &BEGIN_PROVIDER[real, foundetdmat,(maxlien)]
&BEGIN_PROVIDER[integer(kind=selected_int_kind(16)), foundadd,(maxlien,3)] &BEGIN_PROVIDER[integer(C_SIZE_T), foundadd,(maxlien,3)]
&BEGIN_PROVIDER[integer(kind=selected_int_kind(16)), foundaddh,(maxlien,3)] &BEGIN_PROVIDER[integer(C_SIZE_T), foundaddh,(maxlien,3)]
&BEGIN_PROVIDER[integer, detfound] &BEGIN_PROVIDER[integer, detfound]
BEGIN_DOC BEGIN_DOC
! provides all found determinants ! provides all found determinants

6
src/get_dmat.c
View File

@ -23,9 +23,8 @@
* ===== * =====
* trace = trace * trace = trace
*/ */
void get_1rdm(PetscScalar *valxr, PetscInt *Istart, PetscInt *Iend, int *natom, PetscReal *trace1rdm){ void get_1rdm(PetscScalar *valxr, PetscInt *Istart, PetscInt *Iend, int *natom, PetscReal *trace1rdm, const int natomax){
const int natomax=700;
long int ideter[natomax]; long int ideter[natomax];
long int ideter2[natomax]; long int ideter2[natomax];
int kko,kok,kkio; int kko,kok,kkio;
@ -82,9 +81,8 @@ void get_1rdm(PetscScalar *valxr, PetscInt *Istart, PetscInt *Iend, int *natom,
* ===== * =====
* trace = trace * trace = trace
*/ */
void get_2rdm(PetscScalar *valxr, PetscInt *Istart, PetscInt *Iend, int *natom, PetscReal *trace2rdm, double densmat2[*natom][*natom][*natom][*natom]){ void get_2rdm(PetscScalar *valxr, PetscInt *Istart, PetscInt *Iend, int *natom, PetscReal *trace2rdm, double densmat2[*natom][*natom][*natom][*natom], const int natomax){
const int natomax=700;
long int ideter[natomax]; long int ideter[natomax];
long int ideter2[natomax]; long int ideter2[natomax];
int kko,kok,kkio; int kko,kok,kkio;

4
src/get_dmat.h
View File

@ -5,5 +5,5 @@
#include <ctype.h> #include <ctype.h>
#include <string.h> #include <string.h>
void get_1rdm(PetscScalar *, PetscInt *, PetscInt *, int *, PetscReal *); void get_1rdm(PetscScalar *, PetscInt *, PetscInt *, int *, PetscReal *, const int natomax);
void get_2rdm(PetscScalar *valxr, PetscInt *Istart, PetscInt *Iend, int *natom, PetscReal *trace2rdm, double densmat2[*natom][*natom][*natom][*natom]); void get_2rdm(PetscScalar *valxr, PetscInt *Istart, PetscInt *Iend, int *natom, PetscReal *trace2rdm, double densmat2[*natom][*natom][*natom][*natom], const int natomax);

7
src/get_ntot.c
View File

@ -15,7 +15,8 @@ int get_ntot(_Bool FAM1, int natom, long int isz, long int ntrou, long int fix_t
natom2 = natom; natom2 = natom;
} }
tnt1 = (int)exp(lgamma((double)(natom2+1)) - (lgamma((double)(natom2-ntrou+1)) + lgamma((double)(ntrou+1)))); tnt1 = (int)ceil(exp(lgamma((double)(natom2+1)) - (lgamma((double)(natom2-ntrou+1)) + lgamma((double)(ntrou+1)))));
printf("%10.5f | tnt1=%d\n",exp(lgamma((double)(natom2+1)) - (lgamma((double)(natom2-ntrou+1)) + lgamma((double)(ntrou+1)))),tnt1);
int nalpha, nbeta; int nalpha, nbeta;
if((((natom-ntrou) + 2*isz) % 2) == 0){ if((((natom-ntrou) + 2*isz) % 2) == 0){
@ -33,7 +34,7 @@ int get_ntot(_Bool FAM1, int natom, long int isz, long int ntrou, long int fix_t
} }
} }
tnt2 = (int) exp(lgamma((double)(natom-ntrou+1)) - (lgamma((double)(nalpha+1)) + lgamma((double)(nbeta+1)))); tnt2 = (int)ceil(exp(lgamma((double)(natom-ntrou+1)) - (lgamma((double)(nalpha+1)) + lgamma((double)(nbeta+1)))));
//printf("nalpha=%d nbeta=%d | | %d %d ntot=%d\n",nalpha, nbeta, tnt1, tnt2, tnt1*tnt2); printf("natom2=%d fix_trou1=%d fix_trou2=%d nalpha=%d nbeta=%d | | %d %d ntot=%d\n",natom2, fix_trou1, fix_trou2, nalpha, nbeta, tnt1, tnt2, tnt1*tnt2);
return tnt1*tnt2; return tnt1*tnt2;
} }

3
src/get_s2.c
View File

@ -26,8 +26,7 @@ void get_s2(Vec xr, PetscInt *Istart, PetscInt *Iend, PetscScalar *valxr, int *n
PetscReal *norm, PetscReal *norm2, PetscReal *norm3, PetscReal *norm4, PetscReal *norm, PetscReal *norm2, PetscReal *norm3, PetscReal *norm4,
PetscReal *xymat, PetscReal *xymat2, PetscReal *xymat3, PetscReal *xymat4, PetscReal *weight3, PetscReal *xymat, PetscReal *xymat2, PetscReal *xymat3, PetscReal *xymat4, PetscReal *weight3,
int *s21a1, int *s21a2, int *s21b1, int *s21b2, int *s22a1, int *s22a2, int *s21a1, int *s21a2, int *s21b1, int *s21b2, int *s22a1, int *s22a2,
int *s22b1, int *s22b2, int *s23a1, int *s23a2, int *s23b1, int *s23b2, int *postrou){ int *s22b1, int *s22b2, int *s23a1, int *s23a2, int *s23b1, int *s23b2, int *postrou, const int natomax){
const int natomax=700;
long int iaa2, iaa; long int iaa2, iaa;
long int iii; long int iii;
int ideter[natomax]; int ideter[natomax];

6
src/get_s2.h
View File

@ -5,7 +5,7 @@
#include <string.h> #include <string.h>
void get_s2(Vec xr, PetscInt *Istart, PetscInt *Iend, PetscScalar *valxr, int *natom, PetscReal *norm, PetscReal *norm2, PetscReal *norm3, PetscReal *norm4, PetscReal *xymat, PetscReal *xymat2, PetscReal *xymat3, PetscReal *xymat4, PetscReal *weight3, void get_s2(Vec xr, PetscInt *Istart, PetscInt *Iend, PetscScalar *valxr, int *natom, PetscReal *norm, PetscReal *norm2, PetscReal *norm3, PetscReal *norm4, PetscReal *xymat, PetscReal *xymat2, PetscReal *xymat3, PetscReal *xymat4, PetscReal *weight3,
int *s21a1, int *s21a2, int *s21b1, int *s21b2, int *s22a1, int *s22a2, int *s22b1, int *s22b2, int *s23a1, int *s23a2, int *s23b1, int *s23b2, int *postrou); int *s21a1, int *s21a2, int *s21b1, int *s21b2, int *s22a1, int *s22a2, int *s22b1, int *s22b2, int *s23a1, int *s23a2, int *s23b1, int *s23b2, int *postrou, const int natomax);
void get_s2_mov(Vec, PetscInt *, PetscInt *, PetscScalar *, int *, PetscReal *, PetscReal *,PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, void get_s2_mov(Vec, PetscInt *, PetscInt *, PetscScalar *, int *, PetscReal *, PetscReal *,PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *,
int *, int *,
@ -20,7 +20,7 @@ void get_s2_mov(Vec, PetscInt *, PetscInt *, PetscScalar *, int *, PetscReal *,
int *, int *,
int *, int *,
int *, int *,
int *); int *, const int natomax);
void get_s2_cyclic(Vec, PetscInt *, PetscInt *, PetscScalar *, int *, PetscReal *, PetscReal *,PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, void get_s2_cyclic(Vec, PetscInt *, PetscInt *, PetscScalar *, int *, PetscReal *, PetscReal *,PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *,
int *, int *,
@ -35,4 +35,4 @@ void get_s2_cyclic(Vec, PetscInt *, PetscInt *, PetscScalar *, int *, PetscReal
int *, int *,
int *, int *,
int *, int *,
int *); int *, const int natomax);

3
src/get_s2_cyclic.c
View File

@ -23,8 +23,7 @@
*/ */
void get_s2_cyclic(Vec xr, PetscInt *Istart, PetscInt *Iend, PetscScalar *valxr, int *natom, PetscReal *norm, PetscReal *norm2, PetscReal *norm3, PetscReal *norm4, PetscReal *xymat, PetscReal *xymat2, PetscReal *xymat3, PetscReal *xymat4, void get_s2_cyclic(Vec xr, PetscInt *Istart, PetscInt *Iend, PetscScalar *valxr, int *natom, PetscReal *norm, PetscReal *norm2, PetscReal *norm3, PetscReal *norm4, PetscReal *xymat, PetscReal *xymat2, PetscReal *xymat3, PetscReal *xymat4,
int *s21a1, int *s21a2, int *s21b1, int *s21b2, int *s22a1, int *s22a2, int *s22b1, int *s22b2, int *s23a1, int *s23a2, int *s23b1, int *s23b2, int *postrou){ int *s21a1, int *s21a2, int *s21b1, int *s21b2, int *s22a1, int *s22a2, int *s22b1, int *s22b2, int *s23a1, int *s23a2, int *s23b1, int *s23b2, int *postrou, const int natomax){
const int natomax=700;
long int iaa2, iaa; long int iaa2, iaa;
long int iii; long int iii;
int ideter[natomax]; int ideter[natomax];

3
src/get_s2_mov.c
View File

@ -23,8 +23,7 @@
*/ */
void get_s2_mov(Vec xr, PetscInt *Istart, PetscInt *Iend, PetscScalar *valxr, int *natom, PetscReal *norm, PetscReal *norm2, PetscReal *norm3, PetscReal *norm4, PetscReal *xymat, PetscReal *xymat2, PetscReal *xymat3, PetscReal *xymat4, PetscReal *weight3, void get_s2_mov(Vec xr, PetscInt *Istart, PetscInt *Iend, PetscScalar *valxr, int *natom, PetscReal *norm, PetscReal *norm2, PetscReal *norm3, PetscReal *norm4, PetscReal *xymat, PetscReal *xymat2, PetscReal *xymat3, PetscReal *xymat4, PetscReal *weight3,
int *s21a1, int *s21a2, int *s21b1, int *s21b2, int *s22a1, int *s22a2, int *s22b1, int *s22b2, int *s23a1, int *s23a2, int *s23b1, int *s23b2, int *postrou){ int *s21a1, int *s21a2, int *s21b1, int *s21b2, int *s22a1, int *s22a2, int *s22b1, int *s22b2, int *s23a1, int *s23a2, int *s23b1, int *s23b2, int *postrou, const int natomax){
const int natomax=700;
long int iaa2, iaa; long int iaa2, iaa;
long int iii; long int iii;
int ideter[natomax]; int ideter[natomax];

5
src/getdet.irp.f
View File

@ -1,12 +1,13 @@
subroutine getdet(add,ideter) subroutine getdet(add,ideter)
use iso_c_binding
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! this routing gives the determinant in ! this routing gives the determinant in
! the traditional form given its address ! the traditional form given its address
END_DOC END_DOC
integer,INTENT(INOUT)::ideter(natomax) integer,INTENT(INOUT)::ideter(natomax)
integer(kind=selected_int_kind(16)),INTENT(IN)::add integer(C_SIZE_T),INTENT(IN)::add
integer(kind=selected_int_kind(16))::deta,detb integer(C_SIZE_T)::deta,detb
integer::i,const,ia,ib, natom2 integer::i,const,ia,ib, natom2
ib = MOD(add,nt2) ib = MOD(add,nt2)

9
src/main.irp.f
View File

@ -1,13 +1,14 @@
program main program main
use iso_c_binding
implicit none implicit none
integer(kind=selected_int_kind(16)),allocatable::tl1(:),tl2(:),tktyp(:) integer(C_SIZE_T),allocatable::tl1(:),tl2(:),tktyp(:)
real*8,allocatable::txtt(:),txjjxy(:),txjjz(:) real*8,allocatable::txtt(:),txjjxy(:),txjjz(:)
integer::i, tnrows, tntrou,tisz integer::i, tnrows, tntrou,tisz
real*4::t1,t2 real*4::t1,t2
real*8,allocatable::tval(:) real*8,allocatable::tval(:)
integer(kind=selected_int_kind(16)),allocatable::tcol(:) integer(C_SIZE_T),allocatable::tcol(:)
integer(kind=selected_int_kind(16)),dimension(10)::tcountcol integer(C_SIZE_T),dimension(10)::tcountcol
integer(kind=selected_int_kind(16))::tistart integer(C_SIZE_T)::tistart
allocate (tl1(maxlien)) allocate (tl1(maxlien))
allocate (tl2(maxlien)) allocate (tl2(maxlien))
allocate (tktyp(maxlien)) allocate (tktyp(maxlien))

4
src/natomax.irp.f
View File

@ -13,10 +13,10 @@ BEGIN_PROVIDER [integer, natomax]
END_DOC END_DOC
implicit none implicit none
natomax=700 natomax=900
jrangmax=10705432 jrangmax=10705432
maxial=20 maxial=20
maxlien=700 maxlien=900
maxplac=20 maxplac=20
maxdet=10000 maxdet=10000
END_PROVIDER END_PROVIDER

5
src/nt1.irp.f
View File

@ -1,9 +1,10 @@
BEGIN_PROVIDER [integer(kind=selected_int_kind(16)), nt1] use iso_c_binding
BEGIN_PROVIDER [integer(C_SIZE_T), nt1]
BEGIN_DOC BEGIN_DOC
! calculates the number of det the 3's moving ! calculates the number of det the 3's moving
END_DOC END_DOC
implicit none implicit none
integer(kind=selected_int_kind(16))::natom2 integer(C_SIZE_T)::natom2
! call combin(idet1(1,nt1+1),natom,ntrou,nt1,32,jrangmax) ! call combin(idet1(1,nt1+1),natom,ntrou,nt1,32,jrangmax)
natom2=natom natom2=natom

3
src/nt2.irp.f
View File

@ -1,4 +1,5 @@
BEGIN_PROVIDER [integer(kind=selected_int_kind(16)), nt2] use iso_c_binding
BEGIN_PROVIDER [integer(C_SIZE_T), nt2]
BEGIN_DOC BEGIN_DOC
! calculates the number of det the 1's moving ! calculates the number of det the 1's moving
END_DOC END_DOC

10
src/providdet.irp.f
View File

@ -1,12 +1,14 @@
BEGIN_PROVIDER[integer(kind=selected_int_kind(16)),det,(nt2,2)] use iso_c_binding
&BEGIN_PROVIDER[integer(kind=selected_int_kind(16)),deth,(nt1,2)] BEGIN_PROVIDER[integer(C_SIZE_T),det,(nt2,2)]
&BEGIN_PROVIDER[integer(C_SIZE_T),deth,(nt1,2)]
BEGIN_DOC BEGIN_DOC
! provides det and deth array ! provides det and deth array
END_DOC END_DOC
use iso_c_binding
implicit none implicit none
! integer(kind=selected_int_kind(16))::dethsh ! integer(kind=selected_int_kind(16))::dethsh
integer(kind=selected_int_kind(16))::a integer(C_SIZE_t)::a
integer(kind=selected_int_kind(16))::i,count integer(C_SIZE_T)::i,count
integer::const integer::const
i=1 i=1
a=0 a=0

15
src/searchdet.irp.f
View File

@ -1,17 +1,18 @@
subroutine searchdet(deti,add,dethi,addh) subroutine searchdet(deti,add,dethi,addh)
use iso_c_binding
BEGIN_DOC BEGIN_DOC
! this subroutine is at the heart of the idea ! this subroutine is at the heart of the idea
! it will generate all the determinants in a fixed order ! it will generate all the determinants in a fixed order
! then find the posistion of the determinant given and ! then find the posistion of the determinant given and
! return it's position in add. ! return it's position in add.
END_DOC END_DOC
integer(kind=selected_int_kind(16)),INTENT(INOUT)::deti integer(C_SIZE_T),INTENT(INOUT)::deti
integer(kind=selected_int_kind(16)),INTENT(INOUT)::add integer(C_SIZE_T),INTENT(INOUT)::add
integer(kind=selected_int_kind(16)),INTENT(INOUT)::dethi integer(C_SIZE_T),INTENT(INOUT)::dethi
integer(kind=selected_int_kind(16)),INTENT(INOUT)::addh integer(C_SIZE_T),INTENT(INOUT)::addh
integer(kind=selected_int_kind(16))::dethsh integer(C_SIZE_T)::dethsh
integer(kind=selected_int_kind(16))::a integer(C_SIZE_T)::a
integer(kind=selected_int_kind(16))::i,j integer(C_SIZE_T)::i,j
integer::count integer::count
logical::found logical::found

15
src/searchdetfull.irp.f
View File

@ -1,17 +1,18 @@
subroutine searchdetfull() subroutine searchdetfull()
use iso_c_binding
BEGIN_DOC BEGIN_DOC
! this subroutine is at the heart of the idea ! this subroutine is at the heart of the idea
! it will generate all the determinants in a fixed order ! it will generate all the determinants in a fixed order
! then find the posistion of the determinant given and ! then find the posistion of the determinant given and
! return it's position in add. ! return it's position in add.
END_DOC END_DOC
! integer(kind=selected_int_kind(16)),INTENT(INOUT)::foundetadr(maxlien,4) ! integer(C_SIZE_T),INTENT(INOUT)::foundetadr(maxlien,4)
integer(kind=selected_int_kind(16))::add integer(C_SIZE_T)::add
! integer(kind=selected_int_kind(16)),INTENT(INOUT)::deth ! integer(C_SIZE_T),INTENT(INOUT)::deth
integer(kind=selected_int_kind(16))::dethsh integer(C_SIZE_T)::dethsh
integer(kind=selected_int_kind(16))::addh integer(C_SIZE_T)::addh
integer(kind=selected_int_kind(16))::a integer(C_SIZE_T)::a
integer(kind=selected_int_kind(16))::i integer(C_SIZE_T)::i
integer::const,count integer::const,count
i=1 i=1
a=0 a=0

3
src/sort.irp.f
View File

@ -1,7 +1,8 @@
subroutine sort() subroutine sort()
use iso_c_binding
implicit none implicit none
integer::i,j,ord,ordh integer::i,j,ord,ordh
integer(kind=selected_int_kind(16))::add,addh,deti,dethi,addt integer(C_SIZE_T)::add,addh,deti,dethi,addt
do i=1,detfound-1 do i=1,detfound-1
do j=i+1,detfound do j=i+1,detfound

12
src/unit_FIL44.irp.f
View File

@ -3,19 +3,19 @@
BEGIN_DOC BEGIN_DOC
! file units for writing ! file units for writing
END_DOC END_DOC
use iso_c_binding
implicit none implicit none
integer :: i,j,k,ia1,ia2,l,m,chcind,chcval,ii,tistart2 integer :: i,j,k,ia1,ia2,l,m,chcind,chcval,ii,tistart2
integer :: count,unit_44,unit_33 integer :: count,unit_44,unit_33
integer :: iat,nbtots integer :: iat,nbtots
integer(kind=selected_int_kind(16))::iaa integer(C_SIZE_T)::iaa
integer :: kkio,kkiok,n,nz,cdiag,cexdiag integer :: kkio,kkiok,n,nz,cdiag,cexdiag
integer,allocatable ::ideter1(:),ideter2(:),deti(:),detj(:) integer,allocatable ::ideter1(:),ideter2(:),deti(:),detj(:)
integer(kind=selected_int_kind(16)),dimension(maxlien) ::tl1,tl2,tktyp integer(C_SIZE_T),dimension(maxlien) ::tl1,tl2,tktyp
integer(kind=selected_int_kind(16)),dimension(nrows)::tcountcol integer(C_SIZE_T),dimension(nrows)::tcountcol
integer(kind=selected_int_kind(16))::tistart integer(C_SIZE_T)::tistart
real*8,dimension(maxlien)::tval real*8,dimension(maxlien)::tval
integer(kind=selected_int_kind(16)),dimension(maxlien)::tcol integer(C_SIZE_T),dimension(maxlien)::tcol
real*8 :: xmat real*8 :: xmat
integer :: ik,imat4,iaa2,iik integer :: ik,imat4,iaa2,iik
integer :: ik1,ik2,jmat4,IC,ikmax,ikmin integer :: ik1,ik2,jmat4,IC,ikmax,ikmin

7
src/unit_l1.irp.f
View File

@ -13,6 +13,7 @@
tfix_trou2, & tfix_trou2, &
tfam1, & tfam1, &
tcol,tval) tcol,tval)
use iso_c_binding
implicit none implicit none
integer,INTENT(INOUT)::tistart, tnrows integer,INTENT(INOUT)::tistart, tnrows
integer,INTENT(INOUT)::tntrou, tisz integer,INTENT(INOUT)::tntrou, tisz
@ -20,9 +21,9 @@
logical*1,INTENT(INOUT)::tfam1 logical*1,INTENT(INOUT)::tfam1
integer::i integer::i
real*8,INTENT(INOUT)::tval(maxlien) real*8,INTENT(INOUT)::tval(maxlien)
integer(kind=selected_int_kind(16)),INTENT(INOUT)::tcol(maxlien) integer(C_SIZE_T),INTENT(INOUT)::tcol(maxlien)
integer(kind=selected_int_kind(16)),INTENT(INOUT),dimension(tnrows)::tcountcol integer(C_SIZE_T),INTENT(INOUT),dimension(tnrows)::tcountcol
integer(kind=selected_int_kind(16)),INTENT(INOUT)::tl1(maxlien),tl2(maxlien),tktyp(maxlien) integer(C_SIZE_T),INTENT(INOUT)::tl1(maxlien),tl2(maxlien),tktyp(maxlien)
real*8,INTENT(INOUT)::txtt(maxlien),txjjz(maxlien),txjjxy(maxlien) real*8,INTENT(INOUT)::txtt(maxlien),txjjz(maxlien),txjjxy(maxlien)
nrows = tnrows nrows = tnrows