void
paramline_to_argcv (const char *cmdp, int *argcp, char ***argvp)
{
int len;
int argc;
char **argv;
len = strlen (cmdp);
argc = count_params (cmdp, len);
argv = malloc((argc+1) * sizeof *argv);
if (!argv)
argc = -1;
else
{
int i;
for (i = 0; i < argc; ++i)
argv[i] = get_param (&cmdp, &len);
argv[i] = 0;
*argcp = argc;
*argvp = argv;
}
}
void writecode_exp(PARBRE arbre, PATT super_fin_env) {
char * typeg = NULL;
char * typed = NULL;
PATT local_fin_env = NULL;
char * id = arbre->gauche.S;
if(arbre)
switch (arbre->op)
{
case New : {
writecodeln("--NEW");
int c=0;
writecode("ALLOC ");
PCLASSE lc = get_class(arbre->gauche.A->gauche.S);
while(lc){
PATT att = lc->lattributs;
while(att){
c++;
att = att->suiv;
}
lc = get_class(lc->name_parent);
}
writecodeiln(1+c);
writecodeln("DUPN 1");
writecode("PUSHG ");
writecodeiln( (get_class(arbre->gauche.A->gauche.S))->index );
writecodeln("STORE 0"); writecodeln("--NEWEND");
}
break;
case Bloc : { writecodeln("--BLOC");
local_fin_env = enrichissement_att_environnement(NULL,arbre->droit.lattributs);
//Allouer les variables
PATT att = arbre->droit.lattributs;
int c = 0;
while(att){
c++;
att = att->suiv;
}
writecode("PUSHN ");
writecodeiln(c);
writecode_exp( arbre->gauche.A, local_fin_env );
int i;
for(i=0;i<c;i++){
writecodeln("SWAP");
writecodeln("POPN 1");
}
desenrichissement_att_environnement(local_fin_env);
writecodeln("--BLOCEND");
}
break;
case Self :
writecodeln("PUSHL -1");
//return current_class_name;
break;
case Id : {
int index = get_var_index( super_fin_env, id );
if( current_method == NULL ){ //Main
writecode("PUSHL ");
writecodeiln(index + count_classes(definedClasses));
}else{
if( index > -1 ){
writecode("PUSHL ");
writecodeiln(index);
}else{
int indexparam = index_param( current_method , id );
int n = count_params( current_method );
if( indexparam ){
writecode("PUSHL -");
writecodeiln( n + 2 - indexparam );
}else{
int indexatt = index_att( current_class_name , id );
if( indexatt >=0 ){
writecodeln("PUSHL -1");
writecode("LOAD ");
writecodeiln(indexatt + 1);
}
}
}
}
}
break;
case Fct :{ writecodeln("--APPEL");
writecodeln("PUSHN 1"); //Pour le retour de la fonction
//Met self au dessus de la pile
writecodeln("PUSHL -1");
PFONC f = arbre->gauche.F;
PARG arg = f->largs;
int c = 0;
while(arg){
writecode_exp( arg->expression, super_fin_env );
writecodeln("SWAP");
c++;
arg = arg->suiv;
}
writecodeln("DUPN 1");
writecodeln("LOAD 0");
writecode("LOAD ");
writecodeiln( (get_meth_index( check_type(arbre->gauche.A , NULL, super_fin_env), f->name) ) );
writecodeln("CALL");
writecode("POPN ");
writecodeiln( c + 1 ); //Dépile le destinataire et les paramètres
writecodeln("--APPELEND");
} break;
case Aff: { writecodeln("--AFF");
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("DUPN 1");
if( arbre->gauche.A->op == '.' ){ //C'est le champ d'un objet
writecode_exp(arbre->gauche.A->gauche.A, super_fin_env);
int indexatt = index_att( check_type( arbre->gauche.A->gauche.A, NULL, super_fin_env ) ,
arbre->gauche.A->droit.S );
writecodeln("SWAP");
writecode("STORE ");
writecodeiln(indexatt + 2);
}else { //C'est un id
int index = get_var_index( super_fin_env, arbre->gauche.A->gauche.S );
if( current_method == NULL ){ //Main
writecode("STOREL ");
writecodeiln(index + count_classes(definedClasses));
}else{
if( index > -1 ){
writecode("STOREL ");
writecodeiln(index);
}else{
int indexparam = index_param( current_method , arbre->gauche.A->gauche.S );
if( indexparam ){
int n = count_params( current_method );
writecode("STOREL -");
writecodeiln( n + 2 - indexparam );
}else{
int indexatt = index_att( current_class_name , arbre->gauche.A->gauche.S );
if( indexatt >= 0 ){
writecodeln("PUSHL -1");
writecodeln("SWAP");
writecode("STORE ");
writecodeiln(indexatt + 1);
}
}
}
}
}writecodeln("--AFFEND");
}
break;
case ';':
if( arbre->droit.A != NULL ){
writecode_exp( arbre->gauche.A, super_fin_env );
writecodeln("POPN 1");
writecode_exp( arbre->droit.A, super_fin_env );
}
break;
case '.' : {
if( arbre->droit.A->op == Id ){
writecode_exp( arbre->gauche.A, super_fin_env );
int index = index_att( check_type( arbre->gauche.A, NULL, super_fin_env ) , arbre->droit.A->gauche.S );
writecode("LOAD ");
writecodeiln(index + 2);
}else if( arbre->droit.A->op == Fct ){
int imprimer = 0;
PFONC f = arbre->droit.A->gauche.F;
if( strcmp(f->name,"imprimer")==0 ){
if( strcmp(check_type( arbre->gauche.A, NULL, super_fin_env ),"Entier")==0 ){
writecode_exp( arbre->gauche.A, super_fin_env );
writecodeln("DUPN 1");
writecodeln("WRITEI");
imprimer=1;
}
if( strcmp(check_type( arbre->gauche.A, NULL, super_fin_env ),"Chaine")==0 ){
writecode_exp( arbre->gauche.A, super_fin_env );
writecodeln("DUPN 1");
writecodeln("WRITES");
imprimer=1;
}
}
if( !imprimer && arbre->gauche.A->op == Super ){ writecodeln("--APPEL");
writecodeln("PUSHN 1"); //Pour le retour de la fonction
PARG arg = f->largs;
int c = 0;
while(arg){
writecode_exp( arg->expression, super_fin_env );
c++;
arg = arg->suiv;
}
writecodeln("PUSHL -1");
int index = get_class(parent_current_class_name)->index;
writecode("PUSHG ");
writecodeiln(index);
writecode("LOAD ");
writecodeiln( (get_meth_index( check_type(arbre->gauche.A, NULL ,super_fin_env), f->name) ) );
writecodeln("CALL");
writecode("POPN ");
writecodeiln( c + 1 ); //Dépile le destinataire et les paramètres
writecodeln("--APPELEND");
}else if(!imprimer){
writecodeln("--APPEL");
writecodeln("PUSHN 1"); //Pour le retour de la fonction
writecode_exp( arbre->gauche.A, super_fin_env );
PFONC f = arbre->droit.A->gauche.F;
PARG arg = f->largs;
int c = 0;
while(arg){
writecode_exp( arg->expression, super_fin_env );
writecodeln("SWAP");
c++;
arg = arg->suiv;
}
writecodeln("DUPN 1");
writecodeln("LOAD 0");
writecode("LOAD ");
writecodeiln( (get_meth_index( check_type(arbre->gauche.A, NULL, super_fin_env), f->name) ) );
writecodeln("CALL");
writecode("POPN ");
writecodeiln( c + 1 ); //Dépile le destinataire et les paramètres
writecodeln("--APPELEND");
}
}
}
break;
case Cste:
writecode("PUSHI ");
writecodeiln(arbre->gauche.E);
break;
case String:
writecode("PUSHS ");
writecodeln(arbre->gauche.S);
break;
case '+':
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("ADD");
break;
case '-':
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("SUB");
break;
case '*':
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("MUL");
break;
case '/':
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("DIV");
break;
case ITE :
writecode_exp(arbre->gauche.A, super_fin_env);
int lblelse = newlbl();
int lblend = newlbl();
writecode("JZ ");
writecodeln(lbl(lblelse));
writecode_exp( arbre->droit.A->gauche.A, super_fin_env );
writecode("JUMP ");
writecodeln(lbl(lblend));
writecode(lbl(lblelse));
writecodeln(": NOP");
writecode_exp( arbre->droit.A->droit.A, super_fin_env );
writecode(lbl(lblend));
writecodeln(": NOP");
break;
case LT :
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("INF");
break;
case LE :
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("INFEQ");
break;
case GT :
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("SUP");
break;
case GE :
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("SUPEQ");
break;
case EQ :
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("EQUAL");
break;
case NEQ :
writecode_exp(arbre->gauche.A, super_fin_env);
writecode_exp(arbre->droit.A, super_fin_env);
writecodeln("EQUAL");
writecodeln("NOT");
break;
}
}
arma::cx_mat PZStability::oo_rotation(const arma::vec & x, bool spin) const {
if(x.n_elem != count_params()) {
ERROR_INFO();
throw std::runtime_error("Inconsistent parameter size.\n");
}
if(spin && restr) {
ERROR_INFO();
throw std::runtime_error("Incompatible arguments.\n");
}
// Amount of occupied orbitals
size_t o=oa;
if(spin)
o=ob;
// Calculate offset
size_t ioff0=0;
// Canonical rotations
if(cancheck) {
ioff0=count_ov_params(oa,va);
if(!restr)
ioff0+=count_ov_params(ob,vb);
}
// Occupied rotations
if(spin)
ioff0+=count_oo_params(oa);
// Collect real part of rotation
arma::mat kappa(o,o);
kappa.zeros();
for(size_t i=0;i<o;i++)
for(size_t j=0;j<i;j++) {
size_t idx=i*(i-1)/2 + j + ioff0;
kappa(i,j)=x(idx);
kappa(j,i)=-x(idx);
}
// Rotation matrix
arma::cx_mat R;
if(!cplx)
R=kappa*COMPLEX1;
else {
// Imaginary part of rotation.
arma::mat lambda(o,o);
lambda.zeros();
// Offset
size_t ioff=o*(o-1)/2 + ioff0;
for(size_t i=0;i<o;i++)
for(size_t j=0;j<=i;j++) {
size_t idx=ioff + i*(i+1)/2 + j;
lambda(i,j)=x(idx);
lambda(j,i)=-x(idx);
}
// Matrix
R=kappa*COMPLEX1 + lambda*COMPLEXI;
}
// R is anti-hermitian. Get its eigenvalues and eigenvectors
arma::cx_mat Rvec;
arma::vec Rval;
bool diagok=arma::eig_sym(Rval,Rvec,-COMPLEXI*R);
if(!diagok) {
arma::mat Rt;
Rt=arma::real(R);
Rt.save("R_re.dat",arma::raw_ascii);
Rt=arma::imag(R);
Rt.save("R_im.dat",arma::raw_ascii);
ERROR_INFO();
throw std::runtime_error("Unitary optimization: error diagonalizing R.\n");
}
// Rotation is
arma::cx_mat Roo(Rvec*arma::diagmat(arma::exp(COMPLEXI*Rval))*arma::trans(Rvec));
// Check unitarity
arma::cx_mat prod=arma::trans(Roo)*Roo-arma::eye(Roo.n_cols,Roo.n_cols);
double norm=rms_cnorm(prod);
if(norm>=sqrt(DBL_EPSILON))
throw std::runtime_error("Matrix is not unitary!\n");
return Roo;
}
void PZStability::set(const uscf_t & sol, const arma::uvec & dropa, const arma::uvec & dropb, bool cplx_, bool can, bool oo) {
cplx=cplx_;
cancheck=can;
oocheck=oo;
Checkpoint *chkptp=solverp->get_checkpoint();
arma::cx_mat CWa, CWb;
chkptp->cread("CWa",CWa);
chkptp->cread("CWb",CWb);
chkptp->read(basis);
grid=DFTGrid(&basis,true,method.lobatto);
nlgrid=DFTGrid(&basis,true,method.lobatto);
// Update solution
usol=sol;
usol.cCa.cols(0,CWa.n_cols-1)=CWa;
usol.cCb.cols(0,CWb.n_cols-1)=CWb;
// Drop orbitals
if(!cancheck) {
arma::uvec dra(arma::sort(dropa,"descend"));
for(size_t i=0;i<dra.n_elem;i++) {
usol.cCa.shed_col(dra(i));
CWa.shed_col(0);
}
arma::uvec drb(arma::sort(dropb,"descend"));
for(size_t i=0;i<drb.n_elem;i++) {
usol.cCb.shed_col(drb(i));
CWb.shed_col(0);
}
}
// Update size parameters
restr=false;
oa=CWa.n_cols;
ob=CWb.n_cols;
va=usol.cCa.n_cols-oa;
vb=usol.cCb.n_cols-ob;
fprintf(stderr,"\noa = %i, ob = %i, va = %i, vb = %i\n",(int) oa, (int) ob, (int) va, (int) vb);
fprintf(stderr,"There are %i parameters.\n",(int) count_params());
fflush(stdout);
// Reconstruct DFT grid
if(method.adaptive) {
arma::cx_mat Ctilde(sol.Ca.n_rows,CWa.n_cols+CWb.n_cols);
Ctilde.cols(0,oa-1)=CWa;
if(ob)
Ctilde.cols(oa,oa+ob-1)=CWb;
grid.construct(Ctilde,method.gridtol,method.x_func,method.c_func);
} else {
bool strict(false);
grid.construct(method.nrad,method.lmax,method.x_func,method.c_func,strict);
if(method.nl)
nlgrid.construct(method.nlnrad,method.nllmax,true,false,strict,true);
}
// Update reference
arma::vec x(count_params());
x.zeros();
eval(x,-1);
}
arma::mat FDHessian::hessian() {
// Amount of parameters
size_t npar=count_params();
// Compute gradient
arma::mat h(npar,npar);
h.zeros();
std::vector<loopidx_t> idx;
for(size_t i=0;i<npar;i++)
for(size_t j=0;j<=i;j++) {
loopidx_t t;
t.i=i;
t.j=j;
idx.push_back(t);
}
/* This loop isn't OpenMP parallel, because parallellization is
already used in the energy evaluation. Parallellizing over trials
here would require use of thread-local DFT grids, and possibly
even thread-local SCF solver objects (for the Coulomb part).*/
for(size_t ii=0;ii<idx.size();ii++) {
size_t i=idx[ii].i;
size_t j=idx[ii].j;
arma::vec x(npar);
// RH,RH value
x.zeros();
x(i)+=ss;
x(j)+=ss;
double yrr=eval(x,GHMODE);
// RH,LH
x.zeros();
x(i)+=ss;
x(j)-=ss;
double yrl=eval(x,GHMODE);
// LH,RH
x.zeros();
x(i)-=ss;
x(j)+=ss;
double ylr=eval(x,GHMODE);
// LH,LH
x.zeros();
x(i)-=ss;
x(j)-=ss;
double yll=eval(x,GHMODE);
// Values
h(i,j)=(yrr - yrl - ylr + yll)/(4.0*ss*ss);
// Symmetrize
h(j,i)=h(i,j);
if(std::isnan(h(i,j))) {
ERROR_INFO();
std::ostringstream oss;
oss << "Element (" << i << "," << j << ") of Hessian gives NaN.\n";
oss << "Step size is " << ss << ". Stencil values\n";
oss << "yrr = " << yrr << "\n";
oss << "yrl = " << yrl << "\n";
oss << "ylr = " << ylr << "\n";
oss << "yll = " << yll << "\n";
throw std::runtime_error(oss.str());
}
}
return h;
}
arma::cx_mat PZStability::ov_rotation(const arma::vec & x, bool spin) const {
if(x.n_elem != count_params()) {
ERROR_INFO();
throw std::runtime_error("Inconsistent parameter size.\n");
}
if(spin && restr) {
ERROR_INFO();
throw std::runtime_error("Incompatible arguments.\n");
}
if(!cancheck)
throw std::runtime_error("ov_rotation called even though canonical orbitals are not supposed to be checked!\n");
// Amount of occupied orbitals
size_t o=oa, v=va;
if(spin) {
o=ob;
v=vb;
}
// Rotation matrix
arma::cx_mat rot(o,v);
// Calculate offset
size_t ioff0=0;
if(spin)
ioff0=count_ov_params(oa,va);
// Collect real part of rotation
arma::mat rr(o,v);
rr.zeros();
for(size_t i=0;i<o;i++)
for(size_t j=0;j<v;j++) {
rr(i,j)=x(i*v + j + ioff0);
}
// Full rotation
arma::cx_mat r(o,v);
if(!cplx) {
r=rr*COMPLEX1;
} else {
// Imaginary part of rotation.
arma::mat ir(o,v);
ir.zeros();
// Offset
size_t ioff=o*v + ioff0;
for(size_t i=0;i<o;i++)
for(size_t j=0;j<v;j++) {
ir(i,j)=x(i*v + j + ioff);
}
// Matrix
r=rr*COMPLEX1 + ir*COMPLEXI;
}
// Construct full, padded rotation matrix
arma::cx_mat R(o+v,o+v);
R.zeros();
R.submat(0,o,o-1,o+v-1)=r;
R.submat(o,0,o+v-1,o-1)=-arma::trans(r);
// R is anti-hermitian. Get its eigenvalues and eigenvectors
arma::cx_mat Rvec;
arma::vec Rval;
bool diagok=arma::eig_sym(Rval,Rvec,-COMPLEXI*R);
if(!diagok) {
arma::mat Rt;
Rt=arma::real(R);
Rt.save("R_re.dat",arma::raw_ascii);
Rt=arma::imag(R);
Rt.save("R_im.dat",arma::raw_ascii);
ERROR_INFO();
throw std::runtime_error("Unitary optimization: error diagonalizing R.\n");
}
// Rotation is
arma::cx_mat Rov(Rvec*arma::diagmat(arma::exp(COMPLEXI*Rval))*arma::trans(Rvec));
arma::cx_mat prod=arma::trans(Rov)*Rov-arma::eye(Rov.n_cols,Rov.n_cols);
double norm=rms_cnorm(prod);
if(norm>=sqrt(DBL_EPSILON))
throw std::runtime_error("Matrix is not unitary!\n");
return Rov;
}
void PZStability::real_imag_idx(arma::uvec & idxr, arma::uvec & idxi) const {
if(!cplx) {
ERROR_INFO();
throw std::runtime_error("Should not call real_imag_idx for purely real calculation!\n");
}
// Count amount of parameters
size_t nreal=0, nimag=0;
if(cancheck) {
nreal+=oa*va;
nimag+=oa*va;
if(!restr) {
nreal+=ob*vb;
nimag+=ob*vb;
}
}
if(oocheck) {
nreal+=oa*(oa-1)/2;
if(cplx)
nimag+=oa*(oa+1)/2;
if(!restr) {
nreal+=ob*(ob-1)/2;
if(cplx)
nimag+=ob*(ob+1)/2;
}
}
// Sanity check
if(nreal+nimag != count_params()) {
ERROR_INFO();
throw std::runtime_error("Parameter count is wrong!\n");
}
// Parameter indices
idxr.zeros(nreal);
idxi.zeros(nimag);
// Fill indices.
size_t ir=0, ii=0;
// Offset
size_t ioff=0;
if(cancheck) {
// First are the real parameters
for(size_t irot=0;irot<oa*va;irot++) {
idxr(ir++)=irot;
}
ioff+=oa*va;
// followed by the imaginary parameters
for(size_t irot=0;irot<oa*va;irot++)
idxi(ii++)=irot+ioff;
ioff+=oa*va;
if(!restr) {
// and then again the real parameters
for(size_t irot=0;irot<ob*vb;irot++)
idxr(ir++)=irot + ioff;
ioff+=ob*vb;
// followed by the imaginary parameters
for(size_t irot=0;irot<ob*vb;irot++)
idxi(ii++)=irot + ioff;
ioff+=ob*vb;
}
}
if(oocheck) {
// First are the real parameters
for(size_t irot=0;irot<oa*(oa-1)/2;irot++) {
idxr(ir++)=irot+ioff;
}
ioff+=oa*(oa-1)/2;
// and then the imaginary parameters
for(size_t irot=0;irot<oa*(oa+1)/2;irot++)
idxi(ii++)=irot + ioff;
ioff+=oa*(oa+1)/2;
if(!restr) {
// First are the real parameters
for(size_t irot=0;irot<ob*(ob-1)/2;irot++) {
idxr(ir++)=irot+ioff;
}
ioff+=ob*(ob-1)/2;
// and then the imaginary parameters
for(size_t irot=0;irot<ob*(ob+1)/2;irot++)
idxi(ii++)=irot + ioff;
ioff+=ob*(ob+1)/2;
}
}
// Sanity check
arma::uvec idx(nreal+nimag);
idx.subvec(0,nreal-1)=idxr;
idx.subvec(nreal,nreal+nimag-1)=idxi;
idx=arma::sort(idx,"ascending");
for(size_t i=0;i<idx.n_elem;i++)
if(idx(i)!=i) {
std::ostringstream oss;
oss << "Element " << i << " of compound index is wrong: " << idx(i) << "!\n";
throw std::runtime_error(oss.str());
}
}
void FDHessian::optimize(size_t maxiter, double gthr, bool max) {
arma::vec x0(count_params());
x0.zeros();
double ival=eval(x0);
printf("Initial value is % .10f\n",ival);
// Current and previous gradient
arma::vec g, gold;
// Search direction
arma::vec sd;
for(size_t iiter=0;iiter<maxiter;iiter++) {
// Evaluate gradient
gold=g;
{
Timer t;
g=gradient();
print_status(iiter,g,t);
}
if(arma::norm(g,2)<gthr)
break;
// Initial step size
double initstep=1e-4;
// Factor for increase of step size
double stepfac=2.0;
// Do line search
std::vector<double> step, val;
// Update search direction
arma::vec oldsd(sd);
sd = max ? g : -g;
if(iiter % std::min((size_t) round(sqrt(count_params())),(size_t) 5) !=0) {
// Update factor
double gamma;
// Polak-Ribiere
gamma=arma::dot(g,g-gold)/arma::dot(gold,gold);
// Fletcher-Reeves
//gamma=arma::dot(g,g)/arma::dot(gold,gold);
// Update search direction
sd+=gamma*oldsd;
printf("CG step\n");
} else printf("SD step\n");
while(true) {
step.push_back(std::pow(stepfac,step.size())*initstep);
val.push_back(eval(step[step.size()-1]*sd));
if(val.size()>=2)
printf(" %e % .10f % e\n",step[step.size()-1],val[val.size()-1],val[val.size()-1]-val[val.size()-2]);
else
printf(" %e % .10f\n",step[step.size()-1],val[val.size()-1]);
double dval=val[val.size()-1]-val[val.size()-2];
// Check if converged
if(val.size()>=2) {
if(max && dval<0)
break;
else if(!max && dval>0)
break;
}
}
// Get optimal value
arma::vec vals=arma::conv_to<arma::vec>::from(val);
arma::uword iopt;
if(max)
vals.max(iopt);
else
vals.min(iopt);
printf("Line search changed value by %e\n",val[iopt]-val[0]);
// Optimal value is
double optstep=step[iopt];
// Update x
update(optstep*sd);
}
double fval=eval(x0);
printf("Final value is % .10f; optimization changed value by %e\n",fval,fval-ival);
}
void PZStability::check() {
Timer tfull;
// Estimate runtime
{
// Test value
arma::vec x0(count_params());
x0.zeros();
if(x0.n_elem)
x0(0)=0.1;
if(x0.n_elem>=2)
x0(1)=-0.1;
Timer t;
eval(x0,GHMODE);
double dt=t.get();
// Total time is
double ttot=2*x0.n_elem*(x0.n_elem+1)*dt;
fprintf(stderr,"\nComputing the Hessian will take approximately %s\n",t.parse(ttot).c_str());
fflush(stderr);
}
// Get gradient
Timer t;
arma::vec g(gradient());
printf("Gradient norm is %e (%s)\n",arma::norm(g,2),t.elapsed().c_str()); fflush(stdout);
if(cancheck && oocheck) {
size_t nov=count_ov_params(oa,va);
if(!restr)
nov+=count_ov_params(ob,vb);
double ovnorm=arma::norm(g.subvec(0,nov-1),2);
double oonorm=arma::norm(g.subvec(nov,g.n_elem-1),2);
printf("OV norm %e, OO norm %e.\n",ovnorm,oonorm);
}
t.set();
// Evaluate Hessian
arma::mat h(hessian());
printf("Hessian evaluated (%s)\n",t.elapsed().c_str()); fflush(stdout);
t.set();
// Helpers
arma::mat hvec;
arma::vec hval;
if(cancheck && oocheck) {
// Amount of parameters
size_t nov=count_ov_params(oa,va);
if(!restr)
nov+=count_ov_params(ob,vb);
// Stability of canonical orbitals
arma::mat hcan(h.submat(0,0,nov-1,nov-1));
eig_sym_ordered(hval,hvec,hcan);
printf("\nOV Hessian diagonalized (%s)\n",t.elapsed().c_str()); fflush(stdout);
hval.t().print("Canonical orbital stability");
// Stability of optimal orbitals
arma::mat hopt(h.submat(nov-1,nov-1,h.n_rows-1,h.n_cols-1));
eig_sym_ordered(hval,hvec,hopt);
printf("\nOO Hessian diagonalized (%s)\n",t.elapsed().c_str()); fflush(stdout);
hval.t().print("Optimal orbital stability");
}
if(cplx) {
// Collect real and imaginary parts of Hessian.
arma::uvec rp, ip;
real_imag_idx(rp,ip);
arma::mat rh(rp.n_elem,rp.n_elem);
for(size_t i=0;i<rp.n_elem;i++)
for(size_t j=0;j<rp.n_elem;j++)
rh(i,j)=h(rp(i),rp(j));
arma::mat ih(ip.n_elem,ip.n_elem);
for(size_t i=0;i<ip.n_elem;i++)
for(size_t j=0;j<ip.n_elem;j++)
ih(i,j)=h(ip(i),ip(j));
eig_sym_ordered(hval,hvec,rh);
printf("\nReal part of Hessian diagonalized (%s)\n",t.elapsed().c_str()); fflush(stdout);
hval.t().print("Real orbital stability");
eig_sym_ordered(hval,hvec,ih);
printf("\nImaginary part of Hessian diagonalized (%s)\n",t.elapsed().c_str()); fflush(stdout);
hval.t().print("Imaginary orbital stability");
}
// Total stability
eig_sym_ordered(hval,hvec,h);
printf("\nFull Hessian diagonalized (%s)\n",t.elapsed().c_str()); fflush(stdout);
hval.t().print("Orbital stability");
fprintf(stderr,"Check completed in %s.\n",tfull.elapsed().c_str());
}
