void GramSchmidt(size_t N, size_t Mold, size_t Mnew, F *VL, size_t LDVL,
F *VR, size_t LDVR, _MatInner matInner, CQMemManager &mem, size_t NRe = 0) {
F * SCR = mem.template malloc<F>(Mold + Mnew);
if( Mold == 0 ) {
// Normalize the first vector of each set
F inner; matInner(1,1,VL,LDVL,VR,LDVR,&inner);
if( std::abs(inner) < 1e-12 ) CErr("Zero Inner product incurred");
Scale(N, F(1.) / std::sqrt(std::abs(inner)), VL, 1);
Scale(N, F(1.) / std::sqrt(std::abs(inner)), VR, 1);
}
// Orthonormalize the rest of the matrix using GS
for(auto k = Mold + 1; k < (Mold + Mnew); k++) {
F* VR_c = VR + k*LDVR;
F* VL_c = VL + k*LDVL;
// Project out the inner products
for(auto iRe = 0; iRe < (NRe+1); iRe++) {
matInner(k,1,VR,LDVR,VL_c,LDVL,SCR);
Gemm('N','N',N,1,k,F(-1.),VL,LDVL,SCR,k,F(1.),VL_c,LDVL);
}
for(auto iRe = 0; iRe < (NRe+1); iRe++) {
matInner(k,1,VL,LDVL,VR_c,LDVR,SCR);
Gemm('N','N',N,1,k,F(-1.),VR,LDVR,SCR,k,F(1.),VR_c,LDVR);
}
// Normalize the new vector
F inner; matInner(1,1,VL_c,LDVL,VR_c,LDVR,&inner);
if( std::abs(inner) < 1e-12 ) CErr("Zero Inner product incurred");
Scale(N, F(1.) / std::sqrt(std::abs(inner)), VR_c, 1);
Scale(N, F(1.) / std::sqrt(std::abs(inner)), VL_c, 1);
}
mem.free(SCR);
#if 0
size_t M = Mold + Mnew;
F* tInner = mem.template malloc<F>(M*M);
matInner(M,M,VL,LDVL,VR,LDVR,tInner);
for(auto k = 0ul; k < M; k++) tInner[k*(M+1)] -= 1.;
std::cerr << "Error after " << TwoNorm<double>(M*M,tInner,1)
<< std::endl;
mem.free(tInner);
#endif
};
size_t GramSchmidt(size_t N, size_t Mold, size_t Mnew, F *V, size_t LDV,
_VecNorm vecNorm, _MatInner matInner, CQMemManager &mem, size_t NRe = 0,
double eps = 1e-12) {
F * SCR = mem.template malloc<F>(Mold + Mnew);
if( Mold == 0 ) {
// Normalize the first vector
F inner = vecNorm(V);
if(std::abs(inner) < eps) CErr("Zero inner product incurred!");
Scale(N, 1./inner, V, 1);
}
// Orthonormalize the rest of the matrix using GS
size_t iOrtho = Mold + 1;
for(auto k = Mold + 1; k < (Mold + Mnew); k++) {
F* V_c = V + k * LDV;
F* V_p = V + iOrtho * LDV;
if( k != iOrtho ) std::copy_n(V_c,N,V_p);
// Project out the inner products
for(auto iRe = 0; iRe < (NRe+1); iRe++) {
matInner(iOrtho,1,V,LDV,V_p,LDV,SCR);
Gemm('N','N',N,1,iOrtho,F(-1.),V,LDV,SCR,iOrtho,F(1.),V_p,LDV);
}
// Normalize the new vector
F inner = vecNorm(V_p);
std::cout << k << " " << inner << std::endl;
if(std::abs(inner) < N*eps) {
std::cout << "Zero inner product incurred! " << k << "\n";
Scale(N,F(0.),V_p,1);
} else {
Scale(N, 1./inner, V_p, 1);
iOrtho++;
}
}
mem.free(SCR);
#if 0
size_t M = iOrtho;
F* tInner = mem.template malloc<F>(M*M);
matInner(M,M,V,LDV,V,LDV,tInner);
for(auto k = 0ul; k < M; k++) tInner[k*(M+1)] -= 1.;
std::cerr << "Error after " << TwoNorm<double>(M*M,tInner,1)
<< std::endl;
mem.free(tInner);
#endif
return iOrtho;
};
int ExpectingToken( // ISSUE EXPECTING ERROR FOR A TOKEN
TOKEN token ) // - required token
{
TOKEN alt_token;
/* also accept alternative tokens (digraphs) */
switch( token ) {
case T_LEFT_BRACKET:
alt_token = T_ALT_LEFT_BRACKET;
break;
case T_RIGHT_BRACKET:
alt_token = T_ALT_RIGHT_BRACKET;
break;
case T_LEFT_BRACE:
alt_token = T_ALT_LEFT_BRACE;
break;
case T_RIGHT_BRACE:
alt_token = T_ALT_RIGHT_BRACE;
break;
default:
alt_token = token;
break;
}
if( ( CurToken == token ) || ( CurToken == alt_token ) ) {
return( 1 );
}
CErr( ERR_EXPECTING_BUT_FOUND, Tokens[token], TokenString() );
return( 0 );
}
void QuasiNewton<dcomplex>::symmHerDiag(int NTrial, ostream &output){
/*
* Solve S(R)| X(R) > = E(R)| X(R) > (1/ω)
*
* | X(R) > = | X(R)_g >
* | X(R)_u >
*
* The opposite (1/ω vs ω) is solved because the metric is not positive definite
* and can therefore not be solved using DSYGV because of the involved Cholesky
* decomposition.
*
*/
char JOBV = 'V';
char UPLO = 'L';
int iType = 1;
int TwoNTrial = 2*NTrial;
int INFO;
ComplexCMMap SSuper(this->SSuperMem, 2*NTrial,2*NTrial);
ComplexCMMap SCPY(this->SCPYMem, TwoNTrial,TwoNTrial);
SCPY = SSuper; // Copy of original matrix to use for re-orthogonalization
// Perform diagonalization of reduced subspace using DSYGV
zhegv_(&iType,&JOBV,&UPLO,&TwoNTrial,this->SSuperMem,&TwoNTrial,
this->ASuperMem,&TwoNTrial,this->RealEMem,this->WORK,&this->LWORK,
this->RWORK,&INFO);
if(INFO!=0) CErr("ZHEGV failed to converge in Davison Iterations",output);
// Grab the "positive paired" roots (throw away other element of the pair)
this->RealEMem += NTrial;
RealVecMap ER (this->RealEMem,NTrial);
new (&SSuper) ComplexCMMap(this->SSuperMem+2*NTrial*NTrial,2*NTrial,NTrial);
// Swap the ordering because we solve for (1/ω)
for(auto i = 0 ; i < NTrial; i++) ER(i) = 1.0/ER(i);
for(auto i = 0 ; i < NTrial/2; i++){
SSuper.col(i).swap(SSuper.col(NTrial - i - 1));
double tmp = ER(i);
ER(i) = ER(NTrial - i - 1);
ER(NTrial - i - 1) = tmp;
}
/*
* Re-orthogonalize the eigenvectors with respect to the metric S(R)
* because DSYGV orthogonalzies the vectors with respect to E(R)
* because we solve the opposite problem.
*
* Gramm-Schmidt
*/
this->metBiOrth(SSuper,SCPY);
// Separate the eigenvectors into gerade and ungerade parts
ComplexCMMap XTSigmaR(this->XTSigmaRMem,NTrial,NTrial);
ComplexCMMap XTSigmaL(this->XTSigmaLMem,NTrial,NTrial);
XTSigmaR = SSuper.block(0, 0,NTrial,NTrial);
XTSigmaL = SSuper.block(NTrial,0,NTrial,NTrial);
} // symmHerDiag
/* Detects a C99 designated initializer */
local void *DesignatedInit( TYPEPTR typ, TYPEPTR ctyp, void *field )
{
TREEPTR tree;
unsigned long offs;
static int new_field = 1;
if( !CompFlags.extensions_enabled && !CompFlags.c99_extensions ) {
return( field );
}
if( CurToken != T_LEFT_BRACKET && CurToken != T_DOT ) {
new_field = 1;
return( field );
}
/* if designator refers to outer type: back out */
if(typ != ctyp && new_field)
return( NULL );
new_field = 0;
if( typ->decl_type == TYPE_ARRAY ) {
if( CurToken != T_LEFT_BRACKET )
return( NULL );
NextToken();
tree = SingleExpr();
if( tree->op.opr == OPR_PUSHINT || tree->op.opr == OPR_PUSHFLOAT ) {
CastConstValue( tree, typ->decl_type );
*(unsigned long *)field = tree->op.ulong_value;
} else {
CErr1( ERR_NOT_A_CONSTANT_EXPR );
}
FreeExprTree( tree );
MustRecog( T_RIGHT_BRACKET );
} else {
if( CurToken != T_DOT )
return( NULL );
NextToken();
if( CurToken != T_ID ) {
CErr1( ERR_EXPECTING_ID );
}
offs = 0;
field = SearchFields( &typ, &offs, Buffer );
if( field == NULL ) {
CErr( ERR_NAME_NOT_FOUND_IN_STRUCT, Buffer, typ->u.tag->name );
}
NextToken();
}
if( CurToken != T_LEFT_BRACKET && CurToken != T_DOT ) {
new_field = 1;
MustRecog( T_EQUAL );
}
return( field );
}
double * BasisSet::basisEval(int iShell, std::array<double,3> center,sph3GP *ptSph){
cartGP pt;
bg::transform(*ptSph,pt);
auto shSize = this->shells(iShell).size();
auto contDepth = this->shells(iShell).alpha.size();
double * fEVal = new double[shSize];
std::vector<std::array<int,3>> L;
if(this->shells(iShell).contr[0].l == 0){
L.push_back({{0,0,0}});
} else if(this->shells(iShell).contr[0].l == 1){
L.push_back({{1,0,0}});
L.push_back({{0,1,0}});
L.push_back({{0,0,1}});
} else if(this->shells(iShell).contr[0].l == 2){
L.push_back({{2,0,0}});
L.push_back({{1,1,0}});
L.push_back({{1,0,1}});
L.push_back({{0,2,0}});
L.push_back({{0,1,1}});
L.push_back({{0,0,2}});
} else CErr("L > 2 NYI");
std::memset(fEVal,0,shSize*sizeof(double));
cout << "Point Cart " << bg::get<0>(pt) << " " << bg::get<1>(pt) << " " << bg::get<2>(pt) <<endl;
cout << "Center " << center[0] << " " << center[1] << " " << center[2] <<endl;
double x = bg::get<0>(pt) - center[0];
double y = bg::get<1>(pt) - center[1];
double z = bg::get<2>(pt) - center[2];
cout << "Point Scaled" << x << " " << y << " " << z << endl;
double rSq = x*x + y*y + z*z;
cout << " rSq " << rSq << endl;
cout << "shSize " << shSize << endl;
cout << "contDepth " << contDepth << endl;
for(auto i = 0; i < shSize; i++){
// cout << endl << fEVal[i] << endl;
for(auto k = 0; k < contDepth; k++){
fEVal[i] +=
this->shells(iShell).contr[0].coeff[k] *
std::exp(-this->shells(iShell).alpha[k]*rSq);
// cout << "AP " << this->shells(iShell).contr[0].coeff[k] << endl;
// cout << this->shells(iShell).alpha[k] << endl;
}
auto l = L[i][0];
auto m = L[i][1];
auto n = L[i][2];
cout << "l= " << l << "m= " << m << "n= " << n << endl;
fEVal[i] *= std::pow(x,l);
fEVal[i] *= std::pow(y,m);
fEVal[i] *= std::pow(z,n);
}
return fEVal;
}
void QuasiNewton<double>::stdHerDiag(int NTrial, ostream &output){
// Solve E(R)| X(R) > = | X(R) > ω
char JOBV = 'V';
char UPLO = 'L';
int INFO;
RealCMMap A(this->XTSigmaRMem,NTrial,NTrial);
//cout << "HERE" << endl;
//cout << endl << A << endl;
dsyev_(&JOBV,&UPLO,&NTrial,this->XTSigmaRMem,&NTrial,
this->ERMem,this->WORK,&this->LWORK,&INFO);
if(INFO!=0) CErr("DSYEV failed to converge in Davison Iterations",output);
} // stdHerDiag
static boolean segmentIsCode(
fe_seg_id segid ) // - function symbol
{
PC_SEGMENT *seg;
seg = segIdLookup( segid );
if( ( seg->attrs & EXEC ) == 0 ) {
CErr( ERR_CODE_IN_NONCODE_SEG, seg->name );
InfMsgPtr( INF_CODE_SEGMENT_SUFFIX, CODE_ENDING );
return( FALSE );
}
return( TRUE );
}
local void FuncDefn( SYMPTR sym )
{
SYM_NAMEPTR sym_name;
int sym_len;
TYPEPTR typ;
/* duplicate name in near space */
sym_name = SymName( sym, CurFuncHandle );
sym_len = far_strlen_plus1( sym_name );
sym->name = CMemAlloc( sym_len );
far_memcpy( sym->name, sym_name, sym_len );
if( sym->flags & SYM_DEFINED ) {
CErr2p( ERR_SYM_ALREADY_DEFINED, sym->name ); /* 03-aug-88 */
}
typ = sym->sym_type->object; /* get return type */
SKIP_TYPEDEFS( typ );
if( typ->decl_type != TYPE_VOID ) { /* 26-mar-91 */
if( TypeSize( typ ) == 0 ) {
CErr( ERR_INCOMPLETE_TYPE, sym_name );
}
}
sym->flags |= /*SYM_REFERENCED | 18-jan-89 */ SYM_DEFINED;
if( !(GenSwitches & NO_OPTIMIZATION) ) {
sym->flags |= SYM_OK_TO_RECURSE; /* 25-sep-91 */
}
if( sym->stg_class == SC_EXTERN || sym->stg_class == SC_FORWARD ) {
sym->stg_class = SC_NULL; /* indicate exported function */
}
CompFlags.external_defn_found = 1;
if( Toggles & TOGGLE_CHECK_STACK )
sym->flags |= SYM_CHECK_STACK;
if( !CompFlags.zu_switch_used ) {
if( (sym->attrib & FLAG_INTERRUPT) == FLAG_INTERRUPT ) {
/* interrupt function */
TargetSwitches |= FLOATING_SS; /* force -zu switch on */
} else {
TargetSwitches &= ~FLOATING_SS; /* turn it back off */
}
}
if( strcmp( CurFunc->name, "main" ) == 0 || strcmp( CurFunc->name, "wmain" ) == 0 ) {
sym->attrib &= ~FLAG_LANGUAGES; // Turn off any language flags
sym->attrib |= LANG_WATCALL; // Turn on __watcall calling convention for main
}
SymReplace( sym, CurFuncHandle );
}
double * BasisSet::basisEval(libint2::Shell &liShell, sph3GP *ptSph){
cartGP pt;
bg::transform(*ptSph,pt);
auto shSize = liShell.size();
auto contDepth = liShell.alpha.size();
auto center = liShell.O;
double * fEVal = new double[shSize];
std::vector<std::array<int,3>> L;
if(liShell.contr[0].l == 0){
L.push_back({{0,0,0}});
} else if(liShell.contr[0].l == 1){
L.push_back({{1,0,0}});
L.push_back({{0,1,0}});
L.push_back({{0,0,1}});
} else if(liShell.contr[0].l == 2){
L.push_back({{2,0,0}});
L.push_back({{1,1,0}});
L.push_back({{1,0,1}});
L.push_back({{0,2,0}});
L.push_back({{0,1,1}});
L.push_back({{0,0,2}});
} else CErr("L > 2 NYI");
std::memset(fEVal,0,shSize*sizeof(double));
double x = bg::get<0>(pt) - center[0];
double y = bg::get<1>(pt) - center[1];
double z = bg::get<2>(pt) - center[2];
double rSq = x*x + y*y + z*z;
for(auto i = 0; i < shSize; i++){
// cout << endl << fEVal[i] << endl;
for(auto k = 0; k < contDepth; k++){
fEVal[i] +=
liShell.contr[0].coeff[k] *
std::exp(-liShell.alpha[k]*rSq);
}
auto l = L[i][0];
auto m = L[i][1];
auto n = L[i][2];
fEVal[i] *= std::pow(x,l);
fEVal[i] *= std::pow(y,m);
fEVal[i] *= std::pow(z,n);
// cout << "inside " << i << " " << fEVal[i] << endl;
}
return fEVal;
}
double * BasisSet::basisEval(int iShell, std::array<double,3> center, cartGP *pt){
auto shSize = this->shells(iShell).size();
auto contDepth = this->shells(iShell).alpha.size();
double * fEVal = new double[shSize];
std::vector<std::array<int,3>> L;
if(this->shells(iShell).contr[0].l == 0){
L.push_back({{0,0,0}});
} else if(this->shells(iShell).contr[0].l == 1){
L.push_back({{1,0,0}});
L.push_back({{0,1,0}});
L.push_back({{0,0,1}});
} else if(this->shells(iShell).contr[0].l == 2){
L.push_back({{2,0,0}});
L.push_back({{1,1,0}});
L.push_back({{1,0,1}});
L.push_back({{0,2,0}});
L.push_back({{0,1,1}});
L.push_back({{0,0,2}});
} else CErr("L > 2 NYI");
std::memset(fEVal,0,shSize*sizeof(double));
double x = bg::get<0>(*pt) - center[0];
double y = bg::get<1>(*pt) - center[1];
double z = bg::get<2>(*pt) - center[2];
double rSq = x*x + y*y + z*z;
for(auto i = 0; i < shSize; i++){
cout << endl << fEVal[i] << endl;
for(auto k = 0; k < contDepth; k++){
fEVal[i] +=
this->shells(iShell).contr[0].coeff[k] *
std::exp(-this->shells(iShell).alpha[k]*rSq);
}
auto l = L[i][0];
auto m = L[i][1];
auto n = L[i][2];
fEVal[i] *= std::pow(x,l);
fEVal[i] *= std::pow(y,m);
fEVal[i] *= std::pow(z,n);
}
return fEVal;
}
static void pragPack( // #PRAGMA PACK
void )
{
if( ExpectingToken( T_LEFT_PAREN ) ) {
PPCTL_ENABLE_MACROS();
NextToken();
PPCTL_DISABLE_MACROS();
switch( CurToken ) {
case T_ID:
if( PragIdRecog( "pop" ) ) {
popPrag( &HeadPacks, &PackAmount );
} else if( PragIdRecog( "push" ) ) {
if( CurToken == T_RIGHT_PAREN ) {
pushPrag( &HeadPacks, PackAmount );
} else {
if( ExpectingToken( T_COMMA ) ) {
PPCTL_ENABLE_MACROS();
NextToken();
PPCTL_DISABLE_MACROS();
}
if( CurToken == T_CONSTANT ) {
pushPrag( &HeadPacks, PackAmount );
PackAmount = VerifyPackAmount( U32Fetch( Constant64 ) );
NextToken();
} else {
MustRecog( T_CONSTANT );
}
}
} else {
CErr( ERR_EXPECTING_BUT_FOUND, "push or pop", Buffer );
}
break;
case T_CONSTANT:
PackAmount = VerifyPackAmount( U32Fetch( Constant64 ) );
NextToken();
break;
case T_RIGHT_PAREN:
PackAmount = GblPackAmount;
break;
default:
break;
}
MustRecog( T_RIGHT_PAREN );
}
}
double BasisSet::fRmax (int l, double alpha, double thr, double epsConv, int maxiter){
double root ;
double root1 ;
root = fSpAv (2, l,alpha, thr);
for (auto i=0; i < maxiter; i++){
root1 = - (this->fSpAv(0, l,alpha, root) - thr);
root1 /= this->fSpAv (1, l,alpha, root);
root1 += root;
if(std::abs(root1-root) <= epsConv){
// cout << "l "<< l << " alpha " << alpha <<endl;
// cout << "root(n-1)= " << root << " root(n)= "<<root1 <<" abs_err " << std::abs(root1-root) << endl;
// cout << "Root found " << root1 << " It " << i << " froot " << this->fSpAv(0, l,alpha, root) << endl;
return root1;
}else{
root = root1;
}
}
this->fileio_->out << "Convergence Failure in fRmax, change maxiter or turn off screening " << endl;
this->fileio_->out << "root(n-1)= " << root << " root(n)= "<<root1 <<" abs_err " << std::abs(root1-root) << endl;
CErr("Convergence Failure",this->fileio_->out);
}
/**
* Attempt to find the file containing the basis set definition
*/
void BasisSet::findBasisFile(std::string fName){
std::string tmpStr;
tmpStr = "/" + fName;
tmpStr.insert(0,BASIS_PATH);
this->setBasisPath(tmpStr);
this->basisFile_ = std::unique_ptr<ifstream>(new ifstream(this->basisPath_));
if(!this->basisFile_->fail()){ // Check if file is in BASIS_PATH
// this->fileio_->out << "Reading Basis Set from: " << this->basisPath_ << endl;
} else {
this->basisFile_.reset();
this->setBasisPath(fName);
this->basisFile_ = std::unique_ptr<ifstream>(new ifstream(this->basisPath_));
if(!this->basisFile_->fail()){ // Check if file is in PWD
this->fileio_->out << "Reading Basis Set from: ./" << this->basisPath_ << endl;
} else CErr("Could not find basis set file \"" + fName + "\"");
}
}; // BasisSet::findBasisFile
static int ReadBuffer( FCB *srcfcb )
{
int last_char;
if( srcfcb->src_fp == NULL ) { /* in-memory buffer */
CloseSrcFile( srcfcb );
return( 0 );
}
/* ANSI/ISO C says a non-empty source file must be terminated
* with a newline. If it's not, we insert one, otherwise
* whatever comes next will be tacked onto that unterminated
* line, possibly confusing the hell out of the user.
*/
srcfcb->src_ptr = srcfcb->src_buf;
if( srcfcb->src_cnt ) {
last_char = srcfcb->src_ptr[ srcfcb->src_cnt - 1 ];
} else {
last_char = '\n';
}
srcfcb->src_cnt = read( fileno( srcfcb->src_fp ),
srcfcb->src_ptr,
srcfcb->src_bufsize );
if( srcfcb->src_cnt == -1 ) {
CErr( ERR_IO_ERR, srcfcb->src_name, strerror( errno ) );
CloseSrcFile( srcfcb );
return( 1 );
} else if( ( srcfcb->src_cnt == 0 ) && ( last_char == '\n' ) ) {
CloseSrcFile( srcfcb );
return( 1 );
} else if( srcfcb->src_cnt != 0 ) {
last_char = srcfcb->src_ptr[ srcfcb->src_cnt - 1 ];
}
if( ( srcfcb->src_cnt < srcfcb->src_bufsize ) && ( last_char != '\n' ) ) {
srcfcb->no_eol = 1; // emit warning later so line # is right
srcfcb->src_ptr[ srcfcb->src_cnt ] = '\n'; // mark end of buffer
srcfcb->src_cnt++;
}
srcfcb->src_ptr[ srcfcb->src_cnt ] = '\0'; // mark end of buffer
return( 0 ); // indicate CurrChar does not contain a character
}
static void loadUnicodeTable( unsigned code_page )
{
unsigned amt;
int fh;
char filename[ 20 ];
sprintf( filename, "unicode.%3.3u", code_page );
if( filename[ 11 ] != '\0' ) {
filename[ 7 ] = filename[ 8 ];
filename[ 8 ] = '.';
}
fh = openUnicodeFile( filename );
if( fh != -1 ) {
amt = 256 * sizeof( unsigned short );
if( (unsigned)read( fh, UniCode, amt ) != amt ) {
CErr( ERR_IO_ERR, filename, strerror( errno ) );
}
close( fh );
} else {
CErr2p( ERR_CANT_OPEN_FILE, filename );
}
}
static void displayParmMismatch(// DISPLAY PARAMETER MISMATCH
DIAG_INFO* diag ) // - diagnostic information
{
CErr( INF_FUNC_PARM_MISMATCH, diag->bad_parm, &diag->location );
}
void Expecting( // ISSUE EXPECTING ERROR FOR A TOKEN
const char *a_token ) // - required token
{
CErr( ERR_EXPECTING_BUT_FOUND, a_token, TokenString() );
}
void CExcel5Filter::Pass1()
{
CExcelStream es(fBook);
short code, len, bofrec;
int32 offset;
offset = 0;
fBook.Seek(offset, SEEK_SET);
es >> code >> len;
offset += 4 + len;
if (code != 0x0809)
throw CErr("Expected BOF record");
es >> bofrec >> bofrec;
if (bofrec != 0x0005) throw CErr("Expected global section");
while (offset < fBook.BufferLength())
{
fBook.Seek(offset, SEEK_SET);
es >> code >> len;
offset += 4 + len;
if (code == 0x0809)
throw CErr("Unexpected start of new substream");
else if (code == B_EOF)
break;
switch (code)
{
case LABEL:
case RK:
case RSTRING:
case MULRK:
case MULBLANK:
case BLANK:
case FORMULA:
throw CErr("Did not expect data insize globals area");
default:
HandleXLRecordForPass1(code, len);
}
}
fBook.Seek(offset, SEEK_SET);
es >> code >> len;
offset += 4 + len;
if (code != 0x0809)
throw CErr("Expected new substream");
es >> bofrec >> bofrec;
if (bofrec != 0x0010) throw CErr("Expected beginning of data for sheet 1");
while (offset < fBook.BufferLength())
{
fBook.Seek(offset, SEEK_SET);
es >> code >> len;
offset += 4 + len;
if (code == 0x0809)
throw CErr("Unexpected start of new substream");
else if (code == B_EOF)
break;
HandleXLRecordForPass1(code, len);
}
} // CExcel5Filter::Pass1
TYPEPTR EnumDecl( int flags )
{
TYPEPTR typ;
TAGPTR tag;
NextToken();
if( CurToken == T_ID ) {
/* could be: (1) "enum" <id> ";"
(2) "enum" <id> <variable_name> ";"
(3) "enum" <id> "{" <enum_const_decl> ... "}"
*/
tag = TagLookup();
NextToken();
if( CurToken != T_LEFT_BRACE ) {
typ = tag->sym_type;
if( typ == NULL ) {
CErr1( ERR_INCOMPLETE_ENUM_DECL );
typ = TypeDefault();
} else {
if( typ->decl_type != TYPE_ENUM ) { /* 18-jan-89 */
CErr2p( ERR_DUPLICATE_TAG, tag->name );
}
typ->u.tag = tag;
}
return( typ );
}
tag = VfyNewTag( tag, TYPE_ENUM );
} else {
tag = NullTag();
}
typ = TypeNode( TYPE_ENUM, GetType( TYPE_INT ) );
typ->u.tag = tag;
tag->sym_type = typ;
tag->size = TARGET_INT;
tag->u.enum_list = NULL;
if( CurToken == T_LEFT_BRACE ) {
const_val val;
enum enum_rng index;
enum enum_rng const_index;
enum enum_rng start_index;
enum enum_rng step;
enum enum_rng error;
uint64 n;
uint64 Inc;
bool minus;
bool has_sign;
ENUMPTR *prev_lnk;
ENUMPTR esym;
source_loc error_loc;
char buff[50];
if( CompFlags.make_enums_an_int ) {
start_index = ENUM_INT;
} else {
start_index = ENUM_S8;
}
const_index = ENUM_UNDEF;
NextToken();
if( CurToken == T_RIGHT_BRACE ) {
CErr1( ERR_EMPTY_ENUM_LIST );
}
U32ToU64( 1, &Inc );
U64Clear( n );
minus = FALSE;
has_sign = FALSE;
step = 1;
prev_lnk = &esym;
esym = NULL;
while( CurToken == T_ID ) {
esym = EnumLkAdd( tag );
*prev_lnk = esym;
prev_lnk = &esym->thread;
error_loc = TokenLoc;
NextToken();
if( CurToken == T_EQUAL ) {
NextToken();
error_loc = TokenLoc;
ConstExprAndType( &val );
switch( val.type ){
case TYPE_ULONG:
case TYPE_UINT:
case TYPE_ULONG64:
minus = FALSE;
break;
default:
if( val.value.u.sign.v ) {
minus = TRUE;
step = 2;
} else {
minus = FALSE;
}
break;
}
n = val.value;
} else if( has_sign ) {
if( n.u.sign.v ) {
minus = TRUE;
} else {
minus = FALSE;
}
}
for( index = start_index; index < ENUM_SIZE; index += step ) {
if( minus ) {
if( I64Cmp( &n, &( RangeTable[ index ][LOW] ) ) >= 0 ) break;
} else {
if( U64Cmp( &n, &( RangeTable[ index ][HIGH]) ) <= 0 ) break;
}
}
error = ENUM_UNDEF;
if( !CompFlags.extensions_enabled && ( index > ENUM_INT )) {
error = ENUM_INT;
}
if( index >= ENUM_SIZE ) {
// overflow signed maximum range
if( error == ENUM_UNDEF ) {
error = const_index;
}
} else if(( const_index == ENUM_SIZE - 1 ) && minus ) {
// overflow unsigned maximum range by any negative signed value
if( error == ENUM_UNDEF )
error = const_index;
step = 1;
} else {
if( !has_sign && minus) {
has_sign = TRUE;
if( index < const_index ) {
// round up to signed
index = ( const_index + 1 ) & ~1;
}
}
if( index > const_index ) {
const_index = index;
typ->object = GetType( ItypeTable[const_index].decl_type );
tag->size = ItypeTable[const_index].size;
}
}
if( error != ENUM_UNDEF ) {
SetErrLoc( &error_loc );
get_msg_range( buff, error );
CErr( ERR_ENUM_CONSTANT_OUT_OF_RANGE, buff );
}
esym->value = n;
EnumTable[ esym->hash ] = esym; /* 08-nov-94 */
if( CurToken == T_RIGHT_BRACE )
break;
U64Add( &n, &Inc, &n );
MustRecog( T_COMMA );
if( !CompFlags.extensions_enabled
&& !CompFlags.c99_extensions
&& ( CurToken == T_RIGHT_BRACE )) {
ExpectIdentifier(); /* 13-may-91 */
}
}
MustRecog( T_RIGHT_BRACE );
}
return( typ );
}
void RealTime<double>::formUTrans() {
//
// Form the unitary transformation matrix:
// U = exp(-i*dT*F)
//
auto NTCSxNBASIS = this->nTCS_*this->nBasis_;
// Set up Eigen Maps
ComplexMap uTransA(this->uTransAMem_,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap scratch(this->scratchMem_,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap uTransB(this->uTransBMem_,0,0);
if(!this->isClosedShell_ && this->Ref_ != SingleSlater<double>::TCS) {
new (&uTransB) ComplexMap(this->uTransBMem_,NTCSxNBASIS,NTCSxNBASIS);
}
// FIXME: Eigen's Eigensolver is terrible, replace with LAPACK routines
if (this->methFormU_ == EigenDecomp) {
// Eigen-decomposition
char JOBZ = 'V';
char UPLO = 'L';
int INFO;
dcomplex *A = this->scratchMem_;
double *W = this->REAL_LAPACK_SCR;
double *RWORK = W + std::max(1,3*NTCSxNBASIS-2);
dcomplex *WORK = this->CMPLX_LAPACK_SCR;
RealVecMap E(W,NTCSxNBASIS);
ComplexMap V(A,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap S(WORK,NTCSxNBASIS,NTCSxNBASIS);
E.setZero();
V.setZero();
S.setZero();
std::memcpy(A,this->ssPropagator_->fockA()->data(),
NTCSxNBASIS*NTCSxNBASIS*sizeof(dcomplex));
V.transposeInPlace(); // BC Col major
zheev_(&JOBZ,&UPLO,&NTCSxNBASIS,A,&NTCSxNBASIS,W,WORK,&this->lWORK,RWORK,
&INFO);
V.transposeInPlace(); // BC Col major
std::memcpy(WORK,A,NTCSxNBASIS*NTCSxNBASIS*sizeof(dcomplex));
for(auto i = 0; i < NTCSxNBASIS; i++) {
S.col(i) *= dcomplex(std::cos(this->deltaT_ * W[i]),
-std::sin(this->deltaT_ * W[i]));
}
uTransA = S * V.adjoint();
if(!this->isClosedShell_ && this->Ref_ != SingleSlater<dcomplex>::TCS) {
E.setZero();
V.setZero();
S.setZero();
std::memcpy(A,this->ssPropagator_->fockB()->data(),
NTCSxNBASIS*NTCSxNBASIS*sizeof(dcomplex));
V.transposeInPlace(); // BC Col major
zheev_(&JOBZ,&UPLO,&NTCSxNBASIS,A,&NTCSxNBASIS,W,WORK,&this->lWORK,RWORK,
&INFO);
V.transposeInPlace(); // BC Col major
std::memcpy(WORK,A,NTCSxNBASIS*NTCSxNBASIS*sizeof(dcomplex));
for(auto i = 0; i < NTCSxNBASIS; i++) {
S.col(i) *= dcomplex(std::cos(this->deltaT_ * W[i]),
-std::sin(this->deltaT_ * W[i]));
}
uTransB = S * V.adjoint();
}
} else if (this->methFormU_ == Taylor) {
// Taylor expansion
CErr("Taylor expansion NYI",this->fileio_->out);
/* This is not taylor and breaks with the new memory scheme
scratch = -math.ii * deltaT_ * (*this->ssPropagator_->fockA());
uTransA = scratch.exp(); // FIXME
if(!this->isClosedShell_ && this->Ref_ != SingleSlater<double>::TCS) {
scratch = -math.ii * deltaT_ * (*this->ssPropagator_->fockB());
uTransB = scratch.exp(); // FIXME
}
*/
}
// prettyPrint(this->fileio_->out,(*this->uTransA_),"uTransA");
// if(!this->isClosedShell_ && this->Ref_ != SingleSlater<double>::TCS) prettyPrint(this->fileio_->out,(*this->uTransB_),"uTransB");
};
fe_seg_id SegmentAddSym( // SEGMENT: ADD SYMBOL TO SPECIFIED SEGMENT
SYMBOL sym, // - sym to add
fe_seg_id id, // - id of segment to use
target_size_t size, // - size of sym
target_offset_t align ) // - alignment for sym
{
PC_SEGMENT *curr; // - new segment
target_size_t aligned_offset;
target_size_t calc_offset;
target_size_t total_size;
if( id == SEG_DATA || ( id == SEG_BSS && flags.use_def_seg ) ) {
curr = data_def_seg.pcseg;
id = curr->seg_id;
} else if( id == SEG_CODE ) {
curr = code_def_seg.pcseg;
id = curr->seg_id;
} else {
curr = segIdLookup( id );
}
if( curr == NULL ) {
CFatal( "segment: cannot find default segment" );
} else {
accumAlignment( curr, align );
if( ( ! SymIsInitialized( sym ) ) && SymIsExtern( sym ) ) {
id = curr->seg_id;
_markUsed( curr, TRUE );
curr->has_data = TRUE;
data_def_seg.ds_used = TRUE;
} else {
aligned_offset = SegmentAdjust( curr->seg_id, curr->offset, align );
calc_offset = curr->offset + aligned_offset + size;
_CHECK_ADJUST( calc_offset, calc_offset, curr->offset );
if( calc_offset == 0 ) {
if( size != 0 ) {
CErr( ERR_MAX_SEGMENT_EXCEEDED, curr->name, sym );
}
id = SEG_NULL;
} else if( curr->dgroup ) {
total_size = dgroup_size + size + aligned_offset;
_CHECK_ADJUST( calc_offset, total_size, dgroup_size );
if( calc_offset == 0 ) {
if( size != 0 ) {
CErr( ERR_MAX_DGROUP_EXCEEDED, sym, curr->name );
}
id = SEG_NULL;
} else {
dgroup_size += size + aligned_offset;
curr->offset = calc_offset;
_markUsed( curr, TRUE );
curr->has_data = TRUE;
id = curr->seg_id;
data_def_seg.ds_used = TRUE;
}
} else {
curr->offset = calc_offset;
_markUsed( curr, TRUE );
curr->has_data = TRUE;
id = curr->seg_id;
data_def_seg.ds_used = TRUE;
}
}
}
return id;
}
void ParticleParticlePropagator<HartreeFock<dcomplex,dcomplex>>::formLinearTrans_direct(
MPI_Comm c, RC_coll<double> x){
CErr("SOMETHING HAS GONE HORRIBLY WRONG: formLinearTrans_direct");
};
void RealTime<double>::iniDensity() {
bool inOrthoBas;
bool idempotent;
auto NTCSxNBASIS = this->nTCS_*this->nBasis_;
// Set up Eigen Maps
ComplexMap oTrans1(this->oTrans1Mem_,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap oTrans2(this->oTrans2Mem_,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap POA (this->POAMem_ ,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap POAsav (this->POAsavMem_ ,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap FOA (this->FOAMem_ ,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap initMOA(this->initMOAMem_,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap scratch(this->scratchMem_,NTCSxNBASIS,NTCSxNBASIS);
ComplexMap POB (this->POBMem_ ,0,0);
ComplexMap POBsav (this->POBsavMem_ ,0,0);
ComplexMap FOB (this->FOBMem_ ,0,0);
ComplexMap initMOB(this->initMOBMem_,0,0);
if(!this->isClosedShell_ && this->Ref_ != SingleSlater<double>::TCS) {
new (&POB ) ComplexMap(this->POBMem_ ,NTCSxNBASIS,NTCSxNBASIS);
new (&POBsav ) ComplexMap(this->POBsavMem_ ,NTCSxNBASIS,NTCSxNBASIS);
new (&FOB ) ComplexMap(this->FOBMem_ ,NTCSxNBASIS,NTCSxNBASIS);
new (&initMOB) ComplexMap(this->initMOBMem_,NTCSxNBASIS,NTCSxNBASIS);
}
// Form the orthonormal transformation matrices
if (this->typeOrtho_ == Lowdin) {
// Lowdin transformation
// V1 = S^(-1/2)
// V2 = S^(1/2)
char JOBZ = 'V';
char UPLO = 'L';
int INFO;
double *A = this->REAL_LAPACK_SCR;
double *W = A + NTCSxNBASIS * NTCSxNBASIS;
double *WORK = W + NTCSxNBASIS;
RealVecMap E(W,NTCSxNBASIS);
RealMap V(A,NTCSxNBASIS,NTCSxNBASIS);
RealMap S(WORK,NTCSxNBASIS,NTCSxNBASIS); // Requires WORK to be NBSq
E.setZero();
V.setZero();
S.setZero();
std::memcpy(A,this->aointegrals_->overlap_->data(),
NTCSxNBASIS*NTCSxNBASIS*sizeof(double));
dsyev_(&JOBZ,&UPLO,&NTCSxNBASIS,A,&NTCSxNBASIS,W,WORK,&this->lWORK,&INFO);
V.transposeInPlace(); // BC Col major
std::memcpy(WORK,A,NTCSxNBASIS*NTCSxNBASIS*sizeof(double));
for(auto i = 0; i < NTCSxNBASIS; i++) {
S.col(i) *= std::sqrt(W[i]);
}
oTrans2.real() = S * V.adjoint();
for(auto i = 0; i < NTCSxNBASIS; i++) {
S.col(i) /= W[i];
}
oTrans1.real() = S * V.adjoint();
if(this->printLevel_>3) {
prettyPrintComplex(this->fileio_->out,oTrans1,"S^(-1/2)");
prettyPrintComplex(this->fileio_->out,oTrans2,"S^(1/2)");
}
} else if (this->typeOrtho_ == Cholesky) {
char UPLO = 'L';
int INFO;
double *A = this->REAL_LAPACK_SCR;
RealMap V(A,NTCSxNBASIS,NTCSxNBASIS);
V.setZero();
std::memcpy(A,this->aointegrals_->overlap_->data(),
NTCSxNBASIS*NTCSxNBASIS*sizeof(double));
// compute L = A * L^(-T)
dpotrf_(&UPLO,&NTCSxNBASIS,A,&NTCSxNBASIS,&INFO);
V.transposeInPlace(); // BC Col major
V = V.triangularView<Lower>(); // Upper elements are junk
oTrans2.real() = V; // oTrans2 = L
V.transposeInPlace(); // BC Row major
// Given L, compute S^(-1) = L^(-T) * L^(-1)
dpotri_(&UPLO,&NTCSxNBASIS,A,&NTCSxNBASIS,&INFO);
V.transposeInPlace(); // BC Col major
// oTrans1 = L^(-1) = L^(T) * S^(-1)
oTrans1.real() = oTrans2.adjoint().real() * V;
oTrans1 = oTrans1.triangularView<Lower>(); // Upper elements junk
}
else if (this->typeOrtho_ == Canonical) {
CErr("Canonical orthogonalization NYI",this->fileio_->out);
// Canonical orthogonalization
// V1 = U*s^(-1/2)
// V2 = S*V1
}
// Form the initial density
if (this->initDensity_ == 0) {
// Use converged ground-state density
inOrthoBas = false;
idempotent = true;
}
else if (this->initDensity_ == 1) {
// Form the initial density by swaping MOs
inOrthoBas = false;
idempotent = true;
if (this->swapMOA_ != 0) {
// MOs to swap
int iA = ((this->swapMOA_)/1000);
int jA = ((this->swapMOA_)%1000);
this->fileio_->out << endl << "Alpha MOs swapped: "
<< iA << " <-> " << jA << endl;
if(this->printLevel_ > 3) {
prettyPrint(this->fileio_->out,
(*this->ssPropagator_->moA()),"Initial Alpha MO");
}
this->ssPropagator_->moA()->col(jA-1).swap(
this->ssPropagator_->moA()->col(iA-1)
);
}
if (this->swapMOB_ != 0 &&
!this->isClosedShell_ && this->Ref_ != SingleSlater<double>::TCS) {
// MOs to swap
int iB = (this->swapMOB_/1000);
int jB = (this->swapMOB_%1000);
this->fileio_->out << endl << "Beta MOs swapped: "
<< iB << " <-> " << jB << endl;
if(this->printLevel_ > 3) {
prettyPrint(this->fileio_->out,
(*this->ssPropagator_->moB()),"Initial Beta MO");
}
this->ssPropagator_->moB()->col(jB-1).swap(
this->ssPropagator_->moB()->col(iB-1)
);
}
this->ssPropagator_->formDensity();
}
else if (this->initDensity_ == 2) {
// Read in the AO density from checkpoint file
CErr("Read in the AO density from checkpint file NYI",this->fileio_->out);
}
else if (this->initDensity_ == 3) {
// Read in the orthonormal density from checkpoint file
CErr("Read in the orthonormal density from checkpoint file NYI",
this->fileio_->out);
}
if (!inOrthoBas) {
// Transform density from AO to orthonormal basis
POA = oTrans2.adjoint() * (*this->ssPropagator_->densityA()) * oTrans2;
POAsav = POA;
if(!this->isClosedShell_ && this->Ref_ != SingleSlater<double>::TCS) {
POB = oTrans2.adjoint() * (*this->ssPropagator_->densityB()) * oTrans2;
POBsav = POB;
}
} else {
// Transform density from orthonormal to AO basis
(*this->ssPropagator_->densityA()) = oTrans1.adjoint() * POAsav * oTrans1;
if(!this->isClosedShell_ && this->Ref_ != SingleSlater<double>::TCS)
(*this->ssPropagator_->densityB()) = oTrans1.adjoint() * POB * oTrans1;
}
// Need ground state MO in orthonormal basis for orbital occupation
initMOA.setZero();
initMOA.real() = *this->groundState_->moA();
initMOA = oTrans2.adjoint() * initMOA;
if(!this->isClosedShell_ && this->Ref_ != SingleSlater<double>::TCS) {
initMOB.setZero();
initMOB.real() = *this->groundState_->moB();
initMOB = oTrans2.adjoint() * initMOB;
}
};