mirror of
https://github.com/LCPQ/DEHam
synced 2024-12-22 04:13:44 +01:00
looks like now it works for natom > 16
This commit is contained in:
parent
2262d8dce6
commit
aeabef5ded
@ -1,4 +1,5 @@
|
||||
subroutine adr(ideter,add)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! this subroutine provides the address of a detrminant
|
||||
@ -7,8 +8,8 @@ subroutine adr(ideter,add)
|
||||
! matches the given determinant.
|
||||
END_DOC
|
||||
integer,INTENT(INOUT)::ideter(natomax)
|
||||
integer(kind=selected_int_kind(16)),INTENT(INOUT)::add
|
||||
integer(kind=selected_int_kind(16))::deti,dethi,addh,detnew
|
||||
integer(C_SIZE_T),INTENT(INOUT)::add
|
||||
integer(C_SIZE_T)::deti,dethi,addh,detnew
|
||||
integer::count,i,j
|
||||
|
||||
deti=0
|
||||
|
@ -1,5 +1,6 @@
|
||||
subroutine adrfull()
|
||||
implicit none
|
||||
use iso_c_binding
|
||||
BEGIN_DOC
|
||||
! this subroutine provides the address of a detrminant
|
||||
! given in old format.
|
||||
@ -7,8 +8,8 @@ subroutine adrfull()
|
||||
! matches the given determinant.
|
||||
END_DOC
|
||||
integer,dimension(natomax)::ideter
|
||||
integer(kind=selected_int_kind(16))::add
|
||||
integer(kind=selected_int_kind(16))::deti,dethi,addh,detnew
|
||||
integer(C_SIZE_T)::add
|
||||
integer(C_SIZE_T)::deti,dethi,addh,detnew
|
||||
integer::count,i,j
|
||||
|
||||
deti=0
|
||||
|
@ -1,10 +1,11 @@
|
||||
SUBROUTINE ANALYSE(vect, dimvect, startvect, endvect, xymat2, norm2)
|
||||
! INCLUDE "nbtots.prm"
|
||||
use iso_c_binding
|
||||
IMPLICIT NONE
|
||||
INTEGER dimvect, nbtots, startvect, endvect
|
||||
REAL*8,dimension(dimvect)::vect
|
||||
INTEGER (kind=selected_int_kind(16))::add,kvect
|
||||
INTEGER (kind=selected_int_kind(16))::iaa2,i
|
||||
INTEGER (C_SIZE_T)::add,kvect
|
||||
INTEGER (C_SIZE_T)::iaa2,i
|
||||
INTEGER ,dimension(natomax)::ideter
|
||||
INTEGER ,dimension(natomax)::ideter2
|
||||
REAL*8,allocatable ::xz(:)
|
||||
|
@ -1,12 +1,13 @@
|
||||
subroutine conv(ideter,deti,dethi)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! this routine converts a detrminant in the old
|
||||
! format into the new one and returns the determinant.
|
||||
END_DOC
|
||||
integer,INTENT(INOUT)::ideter(natomax)
|
||||
integer(kind=selected_int_kind(16)),INTENT(INOUT)::deti
|
||||
integer(kind=selected_int_kind(16)),INTENT(INOUT)::dethi
|
||||
integer(C_SIZE_T),INTENT(INOUT)::deti
|
||||
integer(C_SIZE_T),INTENT(INOUT)::dethi
|
||||
integer::i
|
||||
deti=0
|
||||
dethi=0
|
||||
|
@ -1,7 +1,8 @@
|
||||
subroutine desort()
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
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 j=i+1,detfound
|
||||
|
24
src/ex1.c
24
src/ex1.c
@ -27,9 +27,10 @@ int main(int argc,char **argv)
|
||||
PetscReal normfin2=0.0;
|
||||
PetscReal normfin3=0.0;
|
||||
PetscReal normfin4=0.0;
|
||||
PetscScalar kr,ki,value[700];
|
||||
const int natomax=900;
|
||||
PetscScalar kr,ki,value[natomax];
|
||||
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;
|
||||
PetscLogDouble t1,t2,tt1,tt2;
|
||||
//PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE;
|
||||
@ -37,7 +38,6 @@ int main(int argc,char **argv)
|
||||
//PetscScalar eigr;
|
||||
//PetscScalar eigi;
|
||||
int mpiid;
|
||||
int natomax=700;
|
||||
|
||||
char const* const fileName = argv[1];
|
||||
FILE* file = fopen(fileName, "r");
|
||||
@ -60,8 +60,8 @@ int main(int argc,char **argv)
|
||||
PetscInt kk,ll,mm,nn,iii2,iiii;
|
||||
PetscInt ii;
|
||||
long int iii;
|
||||
long int tcountcol2,tcol[700],tcountcol[getdata.nnz];
|
||||
double val[700];
|
||||
long int tcountcol2,tcol[natomax],tcountcol[getdata.nnz];
|
||||
double val[natomax];
|
||||
PetscReal xymat=0.0;
|
||||
PetscReal xymat2=0.0;
|
||||
PetscReal xymat3=0.0;
|
||||
@ -96,8 +96,8 @@ int main(int argc,char **argv)
|
||||
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 = 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 = MatMPIAIJSetPreallocation(A,getdata.natom,NULL,getdata.natom,NULL);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,10*getdata.natom,NULL,10*getdata.natom,NULL);CHKERRQ(ierr);
|
||||
//ierr = MatSetFromOptions(A);CHKERRQ(ierr);
|
||||
//ierr = MatSetUp(A);CHKERRQ(ierr);
|
||||
|
||||
@ -149,7 +149,7 @@ int main(int argc,char **argv)
|
||||
col[kk] = tcol[kk+tcountcol2]-1;
|
||||
// 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;
|
||||
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,
|
||||
&getdata.s21a1, &getdata.s21a2, &getdata.s21b1, &getdata.s21b2, &getdata.s22a1, &getdata.s22a2,
|
||||
&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,
|
||||
// &getdata.s21a1, &getdata.s21a2, &getdata.s21b1, &getdata.s21b2, &getdata.s22a1, &getdata.s22a2,
|
||||
// &getdata.s22b1, &getdata.s22b2, &getdata.s23a1, &getdata.s23a2,
|
||||
// &getdata.s23b1, &getdata.s23b2, &getdata.postrou);
|
||||
// get_1rdm(values, &Istart, &Iend, &getdata.natom, &trace1rdm);
|
||||
// get_2rdm(values, &Istart, &Iend, &getdata.natom, &trace2rdm, densmat2);
|
||||
// &getdata.s23b1, &getdata.s23b2, &getdata.postrou, natomax);
|
||||
// get_1rdm(values, &Istart, &Iend, &getdata.natom, &trace1rdm, natomax);
|
||||
// get_2rdm(values, &Istart, &Iend, &getdata.natom, &trace2rdm, densmat2, natomax);
|
||||
// analyse_(valxr, (Iend-Istart), &Istart, &Iend, &xymat, &norm);
|
||||
VecRestoreArray(vec2,&values);
|
||||
ierr = VecRestoreArray(xr, &valxr);CHKERRQ(ierr);
|
||||
|
@ -1,8 +1,9 @@
|
||||
subroutine extra_diag(tistart)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
|
||||
integer(kind=selected_int_kind(16)) :: iaa,iaa2,tistart,tistart2
|
||||
integer(kind=selected_int_kind(16)) :: imat4,jmat4
|
||||
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,allocatable :: ideter2(:)
|
||||
|
@ -1,8 +1,9 @@
|
||||
use iso_c_binding
|
||||
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[integer(kind=selected_int_kind(16)), foundadd,(maxlien,3)]
|
||||
&BEGIN_PROVIDER[integer(kind=selected_int_kind(16)), foundaddh,(maxlien,3)]
|
||||
&BEGIN_PROVIDER[integer(C_SIZE_T), foundadd,(maxlien,3)]
|
||||
&BEGIN_PROVIDER[integer(C_SIZE_T), foundaddh,(maxlien,3)]
|
||||
&BEGIN_PROVIDER[integer, detfound]
|
||||
BEGIN_DOC
|
||||
! provides all found determinants
|
||||
|
@ -23,9 +23,8 @@
|
||||
* =====
|
||||
* 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 ideter2[natomax];
|
||||
int kko,kok,kkio;
|
||||
@ -82,9 +81,8 @@ void get_1rdm(PetscScalar *valxr, PetscInt *Istart, PetscInt *Iend, int *natom,
|
||||
* =====
|
||||
* 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 ideter2[natomax];
|
||||
int kko,kok,kkio;
|
||||
|
@ -5,5 +5,5 @@
|
||||
#include <ctype.h>
|
||||
#include <string.h>
|
||||
|
||||
void get_1rdm(PetscScalar *, PetscInt *, PetscInt *, int *, PetscReal *);
|
||||
void get_2rdm(PetscScalar *valxr, PetscInt *Istart, PetscInt *Iend, int *natom, PetscReal *trace2rdm, double densmat2[*natom][*natom][*natom][*natom]);
|
||||
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], const int natomax);
|
||||
|
@ -15,7 +15,8 @@ int get_ntot(_Bool FAM1, int natom, long int isz, long int ntrou, long int fix_t
|
||||
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;
|
||||
|
||||
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))));
|
||||
//printf("nalpha=%d nbeta=%d | | %d %d ntot=%d\n",nalpha, nbeta, tnt1, tnt2, tnt1*tnt2);
|
||||
tnt2 = (int)ceil(exp(lgamma((double)(natom-ntrou+1)) - (lgamma((double)(nalpha+1)) + lgamma((double)(nbeta+1)))));
|
||||
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;
|
||||
}
|
||||
|
@ -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 *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){
|
||||
const int natomax=700;
|
||||
int *s22b1, int *s22b2, int *s23a1, int *s23a2, int *s23b1, int *s23b2, int *postrou, const int natomax){
|
||||
long int iaa2, iaa;
|
||||
long int iii;
|
||||
int ideter[natomax];
|
||||
|
@ -5,7 +5,7 @@
|
||||
#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,
|
||||
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 *,
|
||||
int *,
|
||||
@ -20,7 +20,7 @@ void get_s2_mov(Vec, PetscInt *, PetscInt *, PetscScalar *, int *, PetscReal *,
|
||||
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 *,
|
||||
int *,
|
||||
@ -35,4 +35,4 @@ void get_s2_cyclic(Vec, PetscInt *, PetscInt *, PetscScalar *, int *, PetscReal
|
||||
int *,
|
||||
int *,
|
||||
int *,
|
||||
int *);
|
||||
int *, const int natomax);
|
||||
|
@ -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,
|
||||
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=700;
|
||||
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){
|
||||
long int iaa2, iaa;
|
||||
long int iii;
|
||||
int ideter[natomax];
|
||||
|
@ -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,
|
||||
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=700;
|
||||
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){
|
||||
long int iaa2, iaa;
|
||||
long int iii;
|
||||
int ideter[natomax];
|
||||
|
@ -1,12 +1,13 @@
|
||||
subroutine getdet(add,ideter)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! this routing gives the determinant in
|
||||
! the traditional form given its address
|
||||
END_DOC
|
||||
integer,INTENT(INOUT)::ideter(natomax)
|
||||
integer(kind=selected_int_kind(16)),INTENT(IN)::add
|
||||
integer(kind=selected_int_kind(16))::deta,detb
|
||||
integer(C_SIZE_T),INTENT(IN)::add
|
||||
integer(C_SIZE_T)::deta,detb
|
||||
integer::i,const,ia,ib, natom2
|
||||
|
||||
ib = MOD(add,nt2)
|
||||
|
@ -1,13 +1,14 @@
|
||||
program main
|
||||
use iso_c_binding
|
||||
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(:)
|
||||
integer::i, tnrows, tntrou,tisz
|
||||
real*4::t1,t2
|
||||
real*8,allocatable::tval(:)
|
||||
integer(kind=selected_int_kind(16)),allocatable::tcol(:)
|
||||
integer(kind=selected_int_kind(16)),dimension(10)::tcountcol
|
||||
integer(kind=selected_int_kind(16))::tistart
|
||||
integer(C_SIZE_T),allocatable::tcol(:)
|
||||
integer(C_SIZE_T),dimension(10)::tcountcol
|
||||
integer(C_SIZE_T)::tistart
|
||||
allocate (tl1(maxlien))
|
||||
allocate (tl2(maxlien))
|
||||
allocate (tktyp(maxlien))
|
||||
|
@ -13,10 +13,10 @@ BEGIN_PROVIDER [integer, natomax]
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
natomax=700
|
||||
natomax=900
|
||||
jrangmax=10705432
|
||||
maxial=20
|
||||
maxlien=700
|
||||
maxlien=900
|
||||
maxplac=20
|
||||
maxdet=10000
|
||||
END_PROVIDER
|
||||
|
@ -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
|
||||
! calculates the number of det the 3's moving
|
||||
END_DOC
|
||||
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)
|
||||
natom2=natom
|
||||
|
@ -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
|
||||
! calculates the number of det the 1's moving
|
||||
END_DOC
|
||||
|
@ -1,12 +1,14 @@
|
||||
BEGIN_PROVIDER[integer(kind=selected_int_kind(16)),det,(nt2,2)]
|
||||
&BEGIN_PROVIDER[integer(kind=selected_int_kind(16)),deth,(nt1,2)]
|
||||
use iso_c_binding
|
||||
BEGIN_PROVIDER[integer(C_SIZE_T),det,(nt2,2)]
|
||||
&BEGIN_PROVIDER[integer(C_SIZE_T),deth,(nt1,2)]
|
||||
BEGIN_DOC
|
||||
! provides det and deth array
|
||||
END_DOC
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
! integer(kind=selected_int_kind(16))::dethsh
|
||||
integer(kind=selected_int_kind(16))::a
|
||||
integer(kind=selected_int_kind(16))::i,count
|
||||
integer(C_SIZE_t)::a
|
||||
integer(C_SIZE_T)::i,count
|
||||
integer::const
|
||||
i=1
|
||||
a=0
|
||||
|
@ -1,17 +1,18 @@
|
||||
subroutine searchdet(deti,add,dethi,addh)
|
||||
use iso_c_binding
|
||||
BEGIN_DOC
|
||||
! this subroutine is at the heart of the idea
|
||||
! it will generate all the determinants in a fixed order
|
||||
! then find the posistion of the determinant given and
|
||||
! return it's position in add.
|
||||
END_DOC
|
||||
integer(kind=selected_int_kind(16)),INTENT(INOUT)::deti
|
||||
integer(kind=selected_int_kind(16)),INTENT(INOUT)::add
|
||||
integer(kind=selected_int_kind(16)),INTENT(INOUT)::dethi
|
||||
integer(kind=selected_int_kind(16)),INTENT(INOUT)::addh
|
||||
integer(kind=selected_int_kind(16))::dethsh
|
||||
integer(kind=selected_int_kind(16))::a
|
||||
integer(kind=selected_int_kind(16))::i,j
|
||||
integer(C_SIZE_T),INTENT(INOUT)::deti
|
||||
integer(C_SIZE_T),INTENT(INOUT)::add
|
||||
integer(C_SIZE_T),INTENT(INOUT)::dethi
|
||||
integer(C_SIZE_T),INTENT(INOUT)::addh
|
||||
integer(C_SIZE_T)::dethsh
|
||||
integer(C_SIZE_T)::a
|
||||
integer(C_SIZE_T)::i,j
|
||||
integer::count
|
||||
logical::found
|
||||
|
||||
|
@ -1,17 +1,18 @@
|
||||
subroutine searchdetfull()
|
||||
use iso_c_binding
|
||||
BEGIN_DOC
|
||||
! this subroutine is at the heart of the idea
|
||||
! it will generate all the determinants in a fixed order
|
||||
! then find the posistion of the determinant given and
|
||||
! return it's position in add.
|
||||
END_DOC
|
||||
! integer(kind=selected_int_kind(16)),INTENT(INOUT)::foundetadr(maxlien,4)
|
||||
integer(kind=selected_int_kind(16))::add
|
||||
! integer(kind=selected_int_kind(16)),INTENT(INOUT)::deth
|
||||
integer(kind=selected_int_kind(16))::dethsh
|
||||
integer(kind=selected_int_kind(16))::addh
|
||||
integer(kind=selected_int_kind(16))::a
|
||||
integer(kind=selected_int_kind(16))::i
|
||||
! integer(C_SIZE_T),INTENT(INOUT)::foundetadr(maxlien,4)
|
||||
integer(C_SIZE_T)::add
|
||||
! integer(C_SIZE_T),INTENT(INOUT)::deth
|
||||
integer(C_SIZE_T)::dethsh
|
||||
integer(C_SIZE_T)::addh
|
||||
integer(C_SIZE_T)::a
|
||||
integer(C_SIZE_T)::i
|
||||
integer::const,count
|
||||
i=1
|
||||
a=0
|
||||
|
@ -1,7 +1,8 @@
|
||||
subroutine sort()
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
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 j=i+1,detfound
|
||||
|
@ -3,19 +3,19 @@
|
||||
BEGIN_DOC
|
||||
! file units for writing
|
||||
END_DOC
|
||||
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
integer :: i,j,k,ia1,ia2,l,m,chcind,chcval,ii,tistart2
|
||||
integer :: count,unit_44,unit_33
|
||||
integer :: iat,nbtots
|
||||
integer(kind=selected_int_kind(16))::iaa
|
||||
integer(C_SIZE_T)::iaa
|
||||
integer :: kkio,kkiok,n,nz,cdiag,cexdiag
|
||||
integer,allocatable ::ideter1(:),ideter2(:),deti(:),detj(:)
|
||||
integer(kind=selected_int_kind(16)),dimension(maxlien) ::tl1,tl2,tktyp
|
||||
integer(kind=selected_int_kind(16)),dimension(nrows)::tcountcol
|
||||
integer(kind=selected_int_kind(16))::tistart
|
||||
integer(C_SIZE_T),dimension(maxlien) ::tl1,tl2,tktyp
|
||||
integer(C_SIZE_T),dimension(nrows)::tcountcol
|
||||
integer(C_SIZE_T)::tistart
|
||||
real*8,dimension(maxlien)::tval
|
||||
integer(kind=selected_int_kind(16)),dimension(maxlien)::tcol
|
||||
integer(C_SIZE_T),dimension(maxlien)::tcol
|
||||
real*8 :: xmat
|
||||
integer :: ik,imat4,iaa2,iik
|
||||
integer :: ik1,ik2,jmat4,IC,ikmax,ikmin
|
||||
|
@ -13,6 +13,7 @@
|
||||
tfix_trou2, &
|
||||
tfam1, &
|
||||
tcol,tval)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
integer,INTENT(INOUT)::tistart, tnrows
|
||||
integer,INTENT(INOUT)::tntrou, tisz
|
||||
@ -20,9 +21,9 @@
|
||||
logical*1,INTENT(INOUT)::tfam1
|
||||
integer::i
|
||||
real*8,INTENT(INOUT)::tval(maxlien)
|
||||
integer(kind=selected_int_kind(16)),INTENT(INOUT)::tcol(maxlien)
|
||||
integer(kind=selected_int_kind(16)),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)::tcol(maxlien)
|
||||
integer(C_SIZE_T),INTENT(INOUT),dimension(tnrows)::tcountcol
|
||||
integer(C_SIZE_T),INTENT(INOUT)::tl1(maxlien),tl2(maxlien),tktyp(maxlien)
|
||||
real*8,INTENT(INOUT)::txtt(maxlien),txjjz(maxlien),txjjxy(maxlien)
|
||||
|
||||
nrows = tnrows
|
||||
|
Loading…
Reference in New Issue
Block a user