From wware@world.std.com Mon Mar 17 14:03:00 1997
Return-Path: <wware@world.std.com>
Received: from europe.std.com by services.xionics.com 
          id <05417-0@services.xionics.com>; Mon, 17 Mar 1997 14:02:54 -0500
Received: from world.std.com by europe.std.com (8.7.6/BZS-8-1.0) id OAA07512;
          Mon, 17 Mar 1997 14:02:50 -0500 (EST)
Received: by world.std.com (5.65c/Spike-2.0) id AA01579;
          Mon, 17 Mar 1997 14:02:49 -0500
Date: Mon, 17 Mar 1997 14:02:49 -0500
From: wware@world.std.com (Will Ware)
Message-Id: <199703171902.AA01579@world.std.com>
To: wware@xionics.com
Subject: forces in C
Status: R

>From hinsen@lmspc2.ibs.fr  Mon Mar 17 14:56:16 1997
Received: from ibs.ibs.fr by world.std.com (5.65c/Spike-2.0)
	id AA01120; Mon, 17 Mar 1997 09:57:03 -0500
Received: from lmspc2.ibs.fr (hinsen@lmspc2.ibs.fr [192.134.36.142]) by ibs.ibs.fr (8.6.12/8.6.12) with ESMTP id PAA16285 for <wware@world.std.com>; Mon, 17 Mar 1997 15:58:07 +0100
Received: (from hinsen@localhost)
	by lmspc2.ibs.fr (8.8.5/8.8.5) id PAA15534;
	Mon, 17 Mar 1997 15:56:16 +0100
Date: Mon, 17 Mar 1997 15:56:16 +0100
Message-Id: <199703171456.PAA15534@lmspc2.ibs.fr>
From: Konrad Hinsen <hinsen@ibs.ibs.fr>
To: wware@world.std.com
In-Reply-To: <199703171332.AA12740@world.std.com> (wware@world.std.com)
Subject: Re: torsion refs
Status: R

> Thanks for these. The torsion calculation is so complicated, I've
> never been absolutely confident that I got it right, and it would
> be nice to work from something official rather than trust my own
> derivation.

I can also send you a working (tested) C function that does the
calculation, if that helps. In fact, I'll just do it; feel free to
delete it if you don't want it. The file contains all the bonded
interactions (bonds, angles, dihedrals).

---------------------------------------------------------------------------
/* Low-level force field calculations: bonded interactions
 *
 * Written by Konrad Hinsen
 * last revision: 1997-2-8
 */

#define _FORCEFIELD_MODULE
#include "forcefield.h"
#include "forcefield_private.h"


/* Harmonic bond potential */

double
harmonic_bond_evaluator(PyObject *object, int natoms, double *coordinates,
			double *gradients, double *force_constants,
			int small_change)
{
  PyFFEvaluatorObject *self = (PyFFEvaluatorObject *)object;
  vector *x = (vector *)coordinates;
  vector *f = (vector *)gradients;

  int *index = (int *)((PyArrayObject *)self->data1)->data;
  double *param = (double *)((PyArrayObject *)self->data2)->data;

  int term = self->n;
  double energy = 0.;

  while (term-- > 0) {
    int i = index[0];
    int j = index[1];
    vector rij;
    double lrij, dr;
    rij[0] = x[i][0]-x[j][0];
    rij[1] = x[i][1]-x[j][1];
    rij[2] = x[i][2]-x[j][2];
    lrij = vector_length(rij);
    dr = lrij-param[0];
    energy += param[1]*sqr(dr);
    if (gradients != NULL) {
      double deriv = 2.*param[1]*dr/lrij;
      double fx = deriv*rij[0];
      double fy = deriv*rij[1];
      double fz = deriv*rij[2];
      f[i][0] += fx;
      f[i][1] += fy;
      f[i][2] += fz;
      f[j][0] -= fx;
      f[j][1] -= fy;
      f[j][2] -= fz;
    }
    if (force_constants != NULL) {
      double f1 = 2.*param[1]*dr/lrij;
      double f2 = 2.*param[1];
      add_pair_fc(force_constants, natoms, i, j, rij, sqr(lrij), f1, f2);
    }
    index += 2;
    param += 2;
  }
  self->last_energy = energy;
  return energy;
}

/* Harmonic angle potential */

double
harmonic_angle_evaluator(PyObject *object, int natoms, double *coordinates,
			 double *gradients, double *force_constants,
			 int small_change)
{
  PyFFEvaluatorObject *self = (PyFFEvaluatorObject *)object;
  vector *x = (vector *)coordinates;
  vector *f = (vector *)gradients;

  int *index = (int *)((PyArrayObject *)self->data1)->data;
  double *param = (double *)((PyArrayObject *)self->data2)->data;

  int term = self->n;
  double energy = 0.;

  while (term-- > 0) {
    int i = index[0];
    int j = index[1];
    int k = index[2];
    vector rij, rkj;
    double lrij, lrkj;
    double cos_theta, sin_theta, theta, dtheta;
    rij[0] = x[i][0]-x[j][0];
    rij[1] = x[i][1]-x[j][1];
    rij[2] = x[i][2]-x[j][2];
    lrij = vector_length(rij);
    vector_scale(rij, 1./lrij);
    rkj[0] = x[k][0]-x[j][0];
    rkj[1] = x[k][1]-x[j][1];
    rkj[2] = x[k][2]-x[j][2];
    lrkj = vector_length(rkj);
    vector_scale(rkj, 1./lrkj);
    cos_theta = dot(rij, rkj);
    if (cos_theta > 1.) cos_theta = 1.;
    if (cos_theta < -1.) cos_theta = -1.;
    sin_theta = sqrt(1.-sqr(cos_theta));
    theta = acos(cos_theta);
    dtheta = (theta-param[0]);
    energy += param[1]*sqr(dtheta);
    if (gradients != NULL || force_constants != NULL) {
      /* First derivative of angle potential */
      double deriv = -2.*param[1]*dtheta/sin_theta;
      vector di, dk, dj;
      di[0] = (rkj[0]-cos_theta*rij[0])/lrij;
      di[1] = (rkj[1]-cos_theta*rij[1])/lrij;
      di[2] = (rkj[2]-cos_theta*rij[2])/lrij;
      dk[0] = (rij[0]-cos_theta*rkj[0])/lrkj;
      dk[1] = (rij[1]-cos_theta*rkj[1])/lrkj;
      dk[2] = (rij[2]-cos_theta*rkj[2])/lrkj;
      dj[0] = -di[0]-dk[0];
      dj[1] = -di[1]-dk[1];
      dj[2] = -di[2]-dk[2];
      if (gradients != NULL) {
	f[i][0] += deriv*di[0];
	f[i][1] += deriv*di[1];
	f[i][2] += deriv*di[2];
	f[k][0] += deriv*dk[0];
	f[k][1] += deriv*dk[1];
	f[k][2] += deriv*dk[2];
	f[j][0] += deriv*dj[0];
	f[j][1] += deriv*dj[1];
	f[j][2] += deriv*dj[2];
      }
      if (force_constants != NULL) {
	/* Second derivative of angle potential */
	double deriv2 = 2.*param[1] *
	      (1.-(cos_theta/sin_theta)*dtheta)/sqr(sin_theta);
	double *fcii = force_constants + 9*natoms*i+3*i;
	double *fcjj = force_constants + 9*natoms*j+3*j;
	double *fckk = force_constants + 9*natoms*k+3*k;
	double *fcij, *fcik, *fcjk;
	int swapij, swapik, swapjk;
	int l, m;
	if (swapij = (i > j))
	  fcij = force_constants + 9*natoms*j+3*i;
	else
	  fcij = force_constants + 9*natoms*i+3*j;
	if (swapik = (i > k))
	  fcik = force_constants + 9*natoms*k+3*i;
	else
	  fcik = force_constants + 9*natoms*i+3*k;
	if (swapjk = (j > k))
	  fcjk = force_constants + 9*natoms*k+3*j;	
	else
	  fcjk = force_constants + 9*natoms*j+3*k;
	for (l = 0; l < 3; l++)
	  for (m = 0; m < 3; m++) {
	    int o = 3*natoms*l + m;
	    double a, b, ab, ba;
	    fcii[o] += deriv2*di[l]*di[m];
	    fcjj[o] += deriv2*dj[l]*dj[m];
	    fckk[o] += deriv2*dk[l]*dk[m];
	    if (swapij)
	      fcij[o] += deriv2*dj[l]*di[m];
	    else
	      fcij[o] += deriv2*di[l]*dj[m];
	    if (swapik)
	      fcik[o] += deriv2*dk[l]*di[m];
	    else
	      fcik[o] += deriv2*di[l]*dk[m];
	    if (swapjk)
	      fcjk[o] += deriv2*dk[l]*dj[m];
	    else
	      fcjk[o] += deriv2*dj[l]*dk[m];
	    a = 3.*cos_theta*rij[l]*rij[m]-rij[l]*rkj[m]-rkj[l]*rij[m];
	    b = 3.*cos_theta*rkj[l]*rkj[m]-rkj[l]*rij[m]-rij[l]*rkj[m];
	    ab = rij[l]*rkj[m]*cos_theta-rij[l]*rij[m]-rkj[l]*rkj[m];
	    ba = rkj[l]*rij[m]*cos_theta-rkj[l]*rkj[m]-rij[l]*rij[m];
	    if (l == m) {
	      a -= cos_theta;
	      b -= cos_theta;
	      ab += 1.;
	      ba += 1.;
	    }
	    a *= deriv/sqr(lrij);
	    b *= deriv/sqr(lrkj);
	    ab *= deriv/(lrij*lrkj);
	    ba *= deriv/(lrij*lrkj);
	    fcii[o] += a;
	    fcjj[o] += a + b + ab + ba;
	    fckk[o] += b;
	    if (swapij)
	      fcij[o] -= a + ba;
	    else
	      fcij[o] -= a + ab;
	    if (swapik)
	      fcik[o] += ba;
	    else
	      fcik[o] += ab;
	    if (swapjk)
	      fcjk[o] -= ba + b;
	    else
	      fcjk[o] -= ab + b;
	  }
      }
    }
    index += 3;
    param += 2;
  }
  self->last_energy = energy;
  return energy;
}

/* Cosine dihedral potential */

static void
add_fc_tensor(double *fc, int n, int swap, tensor t, double f)
{
  int i, j;
  if (swap) {
    for (i = 0; i < 3; i++)
      for (j = 0; j < 3; j++) {
	int o = 3*n*i+j;
	fc[o] += f*t[j][i];
      }
  }
  else {
    for (i = 0; i < 3; i++)
      for (j = 0; j < 3; j++) {
	int o = 3*n*i+j;
	fc[o] += f*t[i][j];
      }
  }
}

double
cosine_dihedral_evaluator(PyObject *object, int natoms, double *coordinates,
			  double *gradients, double *force_constants,
			  int small_change)
{
  PyFFEvaluatorObject *self = (PyFFEvaluatorObject *)object;
  vector *x = (vector *)coordinates;
  vector *f = (vector *)gradients;

  int *index = (int *)((PyArrayObject *)self->data1)->data;
  double *param = (double *)((PyArrayObject *)self->data2)->data;

  int term = self->n;
  double energy = 0.;
  double last = 0.;

  while (term-- > 0) {
    int i = index[0];
    int j = index[1];
    int k = index[2];
    int l = index[3];
    int n;
    vector rij, rkj, rlk, rkj_cross_rkl, rij_cross_rkj, r, s;
    double lrij, lrkj, lrlk, lm, ln, lr, ls;
    double dot_rij_rkj, dot_rlk_rkj;
    double cos_phi, sqr_cos_phi, cos_n_phi, sin_phi, sin_n_phi, sin_n_phi_ratio;
    double phi, sign_phi, cos_phase, sin_phase;
    rij[0] = x[i][0]-x[j][0];
    rij[1] = x[i][1]-x[j][1];
    rij[2] = x[i][2]-x[j][2];
    lrij = vector_length(rij);
    rkj[0] = x[k][0]-x[j][0];
    rkj[1] = x[k][1]-x[j][1];
    rkj[2] = x[k][2]-x[j][2];
    lrkj = vector_length(rkj);
    rlk[0] = x[l][0]-x[k][0];
    rlk[1] = x[l][1]-x[k][1];
    rlk[2] = x[l][2]-x[k][2];
    lrlk = vector_length(rlk);
    cross(rkj_cross_rkl, rlk, rkj);
    ln = vector_length(rkj_cross_rkl);
    cross(rij_cross_rkj, rij, rkj);
    lm = vector_length(rij_cross_rkj);
    sign_phi = 1.;
    if (dot(rij, rkj_cross_rkl) < 0.) sign_phi = -1.;
    vector_scale(rkj, 1./lrkj);
    dot_rij_rkj = dot(rij, rkj);
    r[0] = rij[0]-dot_rij_rkj*rkj[0];
    r[1] = rij[1]-dot_rij_rkj*rkj[1];
    r[2] = rij[2]-dot_rij_rkj*rkj[2];
    lr = vector_length(r);
    vector_scale(r, 1./lr);
    dot_rlk_rkj = dot(rlk, rkj);
    s[0] = rlk[0]-dot_rlk_rkj*rkj[0];
    s[1] = rlk[1]-dot_rlk_rkj*rkj[1];
    s[2] = rlk[2]-dot_rlk_rkj*rkj[2];
    ls = vector_length(s);
    vector_scale(s, 1./ls);
    cos_phi = dot(r, s);
    if (cos_phi > 1.) cos_phi = 1.;
    if (cos_phi < -1.) cos_phi = -1.;
    n = (int)param[0];
    cos_phase = param[1];
    sin_phase = param[2];
    sqr_cos_phi = sqr(cos_phi);
    sin_phi = 2.;
    switch (n) {
    case 0:
      cos_n_phi = 1.;
      sin_n_phi_ratio = 0.;
      break;
    case 1:
      cos_n_phi = cos_phi;
      sin_n_phi_ratio = 1.;
      break;
    case 2:
      cos_n_phi = 2.*sqr_cos_phi-1.;
      sin_n_phi_ratio = 2.*cos_phi;
      break;
    case 3:
      cos_n_phi = (4.*sqr_cos_phi-3.)*cos_phi;
      sin_n_phi_ratio = 4.*sqr_cos_phi - 1.;
      break;
    case 4:
      cos_n_phi = 8.*(sqr_cos_phi-1.)*sqr_cos_phi+1.;
      sin_n_phi_ratio = 4.*(2.*sqr_cos_phi-1.)*cos_phi;
      break;
#if 0
    /* n=5 and n=6 don't occur in the Amber force field and have
       therefore not been tested. Use this section at your own risk. */
    case 5:
      cos_n_phi = ((16.*sqr_cos_phi-20.)*sqr_cos_phi+5.)*cos_phi;
      sin_n_phi_ratio =4.*(4.*sqr_cos_phi-3.)*sqr_cos_phi+1.;
      break;
    case 6:
      cos_n_phi = ((32.*sqr_cos_phi-48.)*sqr_cos_phi+18.)*sqr_cos_phi-1.;
      sin_n_phi_ratio = (32.*(sqr_cos_phi-1.)*sqr_cos_phi+6.)*cos_phi;
      break;
#endif
    default:
      phi = acos(cos_phi)*sign_phi;
      sin_phi = sqrt(1.-sqr_cos_phi)*sign_phi;
      cos_n_phi = cos(n*phi);
      if (fabs(sin_phi) > 1.e-4)
	sin_n_phi_ratio = sin(n*phi)/sin_phi;
      else
	sin_n_phi_ratio = n;
    }
    if (fabs(sin_phase) < 1.e-8)
      energy += param[3]*(1.+cos_n_phi*cos_phase);
    else {
      if (sin_phi == 2.)
	sin_phi = sqrt(1.-sqr_cos_phi)*sign_phi;
      energy += param[3]*(1.+cos_n_phi*cos_phase 
			  + sin_n_phi_ratio*sin_phi*sin_phase);
    }
#if 0
    if (gradients == NULL) {
      printf("Dihedral %d-%d-%d-%d: %d, %lf\n", i,j,k,l,n, param[3]);
      printf("cos(phi): %lf, sign(phi): %lf\n", cos_phi, sign_phi);
      printf("cos(delta): %lf, sin(delta): %lf\n", cos_phase, sin_phase);
      printf("sin(phi): %lf, sin(n*phi)/sin(phi): %lf, cos(n*phi): %lf\n", sin_phi, sin_n_phi_ratio, cos_n_phi);
      printf("Energy: %lf/%lf\n", energy-last, param[3]*(1.+cos_n_phi*cos_phase));
      last = energy;
    }
#endif
    if (gradients != NULL || force_constants != NULL) {
      double deriv;
      vector di, dj, dk, dl, ds;
      if (sin_phi == 2.)
	sin_phi = sqrt(1.-sqr_cos_phi)*sign_phi;
      deriv = -n*param[3]*(sin_n_phi_ratio*sin_phi*cos_phase -
			  cos_n_phi*sin_phase);
      vector_copy(di, rij_cross_rkj);
      vector_scale(di, lrkj/sqr(lm));
      vector_copy(dl, rkj_cross_rkl);
      vector_scale(dl, -lrkj/sqr(ln));
      ds[0] = (dot_rij_rkj*di[0]+dot_rlk_rkj*dl[0])/lrkj;
      ds[1] = (dot_rij_rkj*di[1]+dot_rlk_rkj*dl[1])/lrkj;
      ds[2] = (dot_rij_rkj*di[2]+dot_rlk_rkj*dl[2])/lrkj;
      dj[0] = ds[0]-di[0];
      dj[1] = ds[1]-di[1];
      dj[2] = ds[2]-di[2];
      dk[0] = -ds[0]-dl[0];
      dk[1] = -ds[1]-dl[1];
      dk[2] = -ds[2]-dl[2];
      if (gradients != NULL) {
	f[i][0] += deriv*di[0];
	f[i][1] += deriv*di[1];
	f[i][2] += deriv*di[2];
	f[j][0] += deriv*dj[0];
	f[j][1] += deriv*dj[1];
	f[j][2] += deriv*dj[2];
	f[k][0] += deriv*dk[0];
	f[k][1] += deriv*dk[1];
	f[k][2] += deriv*dk[2];
	f[l][0] += deriv*dl[0];
	f[l][1] += deriv*dl[1];
	f[l][2] += deriv*dl[2];
      }
      if (force_constants != NULL) {
	double deriv2 = -n*n*param[3]*(cos_n_phi*cos_phase 
				      + sin_n_phi_ratio*sin_phi*sin_phase);
	double *fcii = force_constants + 9*natoms*i+3*i;
	double *fcjj = force_constants + 9*natoms*j+3*j;
	double *fckk = force_constants + 9*natoms*k+3*k;
	double *fcll = force_constants + 9*natoms*l+3*l;
	double *fcij, *fcik, *fcil, *fcjk, *fcjl, *fckl;
	int swapij, swapik, swapil, swapjk, swapjl, swapkl;
	vector ga, fa, gb, hb;
	tensor aga, afa, bgb, bhb, gg, fg, hg, temp;
	double ff, gg1, gg2, gg3, gg4, hh;
	int i1, i2;
	if (swapij = (i > j))
	  fcij = force_constants + 9*natoms*j+3*i;
	else
	  fcij = force_constants + 9*natoms*i+3*j;
	if (swapik = (i > k))
	  fcik = force_constants + 9*natoms*k+3*i;
	else
	  fcik = force_constants + 9*natoms*i+3*k;
	if (swapil = (i > l))
	  fcil = force_constants + 9*natoms*l+3*i;
	else
	  fcil = force_constants + 9*natoms*i+3*l;
	if (swapjk = (j > k))
	  fcjk = force_constants + 9*natoms*k+3*j;	
	else
	  fcjk = force_constants + 9*natoms*j+3*k;
	if (swapjl = (j > l))
	  fcjl = force_constants + 9*natoms*l+3*j;	
	else
	  fcjl = force_constants + 9*natoms*j+3*l;
	if (swapkl = (k > l))
	  fckl = force_constants + 9*natoms*l+3*k;	
	else
	  fckl = force_constants + 9*natoms*k+3*l;
	for (i1 = 0; i1 < 3; i1++)
	  for (i2 = 0; i2 < 3; i2++) {
	    int o = 3*natoms*i1 + i2;
	    fcii[o] += deriv2*di[i1]*di[i2];
	    fcjj[o] += deriv2*dj[i1]*dj[i2];
	    fckk[o] += deriv2*dk[i1]*dk[i2];
	    fcll[o] += deriv2*dl[i1]*dl[i2];
	    if (swapij)
	      fcij[o] += deriv2*dj[i1]*di[i2];
	    else
	      fcij[o] += deriv2*di[i1]*dj[i2];
	    if (swapik)
	      fcik[o] += deriv2*dk[i1]*di[i2];
	    else
	      fcik[o] += deriv2*di[i1]*dk[i2];
	    if (swapil)
	      fcil[o] += deriv2*dl[i1]*di[i2];
	    else
	      fcil[o] += deriv2*di[i1]*dl[i2];
	    if (swapjk)
	      fcjk[o] += deriv2*dk[i1]*dj[i2];
	    else
	      fcjk[o] += deriv2*dj[i1]*dk[i2];
	    if (swapjl)
	      fcjl[o] += deriv2*dl[i1]*dj[i2];
	    else
	      fcjl[o] += deriv2*dj[i1]*dl[i2];
	    if (swapkl)
	      fckl[o] += deriv2*dl[i1]*dk[i2];
	    else
	      fckl[o] += deriv2*dk[i1]*dl[i2];
	  }
	/************/
	cross(ga, rkj, rij_cross_rkj);
	cross(fa, rij_cross_rkj, rij);
	cross(gb, rkj, rkj_cross_rkl);
	cross(hb, rkj_cross_rkl, rlk);
	symmetric_tensor_product(aga, rij_cross_rkj, ga, -lrkj);
	symmetric_tensor_product(afa, rij_cross_rkj, fa, -1.);
	symmetric_tensor_product(bgb, rkj_cross_rkl, gb, -lrkj);
	symmetric_tensor_product(bhb, rkj_cross_rkl, hb, -1.);
	/************/
	ff = lrkj/sqr(sqr(lm));
	gg1 = 0.5/(cube(lrkj)*sqr(lm));
	gg2 = -dot_rij_rkj/sqr(sqr(lm));
	gg3 = -0.5/(cube(lrkj)*sqr(ln));
	gg4 = dot_rlk_rkj/sqr(sqr(ln));
	hh = -lrkj/sqr(sqr(ln));
	tensor_copy(gg, aga);
	tensor_scale(gg, gg1);
	tensor_add(gg, afa, gg2);
	tensor_add(gg, bgb, gg3);
	tensor_add(gg, bhb, gg4);
	add_fc_tensor(fcii, natoms, 0, aga, ff*deriv);
	add_fc_tensor(fcjj, natoms, 0, aga, ff*deriv);
	add_fc_tensor(fcij, natoms, swapij, aga, -ff*deriv);
	add_fc_tensor(fcjj, natoms, 0, gg, deriv);
	add_fc_tensor(fckk, natoms, 0, gg, deriv);
	add_fc_tensor(fcjk, natoms, swapjk, gg, -deriv);
	add_fc_tensor(fckk, natoms, 0, bgb, hh*deriv);
	add_fc_tensor(fcll, natoms, 0, bgb, hh*deriv);
	add_fc_tensor(fckl, natoms, swapkl, bgb, -hh*deriv);
	/************/
	tensor_product(fg, fa, rij_cross_rkj, lrkj);
	tensor_product(temp, rij_cross_rkj, ga, -dot_rij_rkj*lrkj);
	tensor_add(fg, temp, 1.);
	tensor_scale(fg, 1./sqr(sqr(lm)));
	tensor_product(hg, hb, rkj_cross_rkl, lrkj);
	tensor_product(temp, rkj_cross_rkl, gb, -dot_rlk_rkj*lrkj);
	tensor_add(hg, temp, 1.);
	tensor_scale(hg, -1./sqr(sqr(ln)));
	/************/
	add_fc_tensor(fcij, natoms, swapij, fg, deriv);
	add_fc_tensor(fcjj, natoms, 0, fg, -deriv);
	add_fc_tensor(fcjj, natoms, 1, fg, -deriv);
	add_fc_tensor(fcik, natoms, swapik, fg, -deriv);
	add_fc_tensor(fcjk, natoms, swapjk, fg, deriv);
	add_fc_tensor(fcjk, natoms, !swapjk, hg, -deriv);
	add_fc_tensor(fckk, natoms, 1, hg, deriv);
	add_fc_tensor(fckk, natoms, 0, hg, deriv);
	add_fc_tensor(fcjl, natoms, !swapjl, hg, deriv);
	add_fc_tensor(fckl, natoms, !swapkl, hg, -deriv);
	/************/
      }
    }
    index += 4;
    param += 4;
  }
  self->last_energy = energy;
  return energy;
}
---------------------------------------------------------------------------

-- 
-------------------------------------------------------------------------------
Konrad Hinsen                          | E-Mail: hinsen@ibs.ibs.fr
Laboratoire de Dynamique Moleculaire   | Tel.: +33-4.76.88.99.28
Institut de Biologie Structurale       | Fax:  +33-4.76.88.54.94
41, av. des Martyrs                    | Deutsch/Esperanto/English/
38027 Grenoble Cedex 1, France         | Nederlands/Francais
-------------------------------------------------------------------------------

-------------------------------------------------------------
Will Ware <wware@world.std.com> web <http://world.std.com/~wware/>
PGP fingerprint   45A8 722C D149 10CC   F0CF 48FB 93BF 7289

From wware@world.std.com Mon Mar 17 14:05:00 1997
Return-Path: <wware@world.std.com>
Received: from europe.std.com by services.xionics.com 
          id <05465-0@services.xionics.com>; Mon, 17 Mar 1997 14:04:59 -0500
Received: from world.std.com by europe.std.com (8.7.6/BZS-8-1.0) id OAA07950;
          Mon, 17 Mar 1997 14:04:56 -0500 (EST)
Received: by world.std.com (5.65c/Spike-2.0) id AA05154;
          Mon, 17 Mar 1997 14:04:53 -0500
Date: Mon, 17 Mar 1997 14:04:53 -0500
From: wware@world.std.com (Will Ware)
Message-Id: <199703171904.AA05154@world.std.com>
To: wware@xionics.com
Subject: Brad Lucier stuff 3/17
Status: R

>From lucier@MATH.Purdue.EDU  Mon Mar 17 16:36:00 1997
Received: from gauss.math.purdue.edu by world.std.com (5.65c/Spike-2.0)
	id AA03835; Mon, 17 Mar 1997 11:36:18 -0500
Received: from newton.math.purdue.edu (newton.math.purdue.edu [128.210.3.6]) by gauss.math.purdue.edu (8.8.5/Purdue_Math) with ESMTP id LAA29893; Mon, 17 Mar 1997 11:36:08 -0500 (EST)
From: Brad Lucier <lucier@MATH.Purdue.EDU>
Received: (lucier@localhost) by newton.math.purdue.edu (8.6.10/Purdue_Math-1.0) id LAA06539; Mon, 17 Mar 1997 11:36:00 -0500
Date: Mon, 17 Mar 1997 11:36:00 -0500
Message-Id: <199703171636.LAA06539@newton.math.purdue.edu>
To: wware@world.std.com
Subject: ncad023
Cc: lucier@MATH.Purdue.EDU
Status: R

Will:

I downloaded ncad023 from your ftp site and took a look at it.

I'm still interested in hacking and playing with NanoCAD for a while,
but I don't want to keep inserting what I consider to be fixes into
each new version; I'd rather you integrated my suggested changes into
your continuing version of ncad.  I just don't have the time to keep
making the same trivial changes to get it to work well with gambit.

So here are my comments about your new version; these come from diffs
to my hacked version of ncad022:

forces.scm:
33,45d32
< (define (create-diff-dist m n)
<   (let* ((ma (atm-position m))
< 	 (na (atm-position n))
< 	 (diff (vdiff ma na))
< 	 (dist (vlen diff)))
<     (make-lambda (x)
<       (case x
< 	('diff diff)
< 	('distance dist)))))
< 
< (define (dd-diff dd) (funcall dd 'diff))
< (define (dd-dist dd) (funcall dd 'distance))
< 

This is an implementation of a specific data structure, and so should be
in the header file with the other data structure implementations, to my
mind.  That way, I can implement it with structures in gambit, as you
do in CL, and as I did with the other data structure code.

81,98c70,87
<   '((1 5 460 1.113)
<     (1 1 440 1.523)
<     (2 2 960 1.337)
<     (4 4 1560 1.212)
<     (1 6 536 1.402)
<     (1 8 510 1.438)
<     (3 7 1080 1.208)
<     (1 11 510 1.392)
<     (1 12 323 1.795)
<     (1 13 230 1.949)
<     (1 14 220 2.149)
<     (8 20 610 0.6)
<     (8 8 560 1.381)
<     (6 20 460 0.6)
<     (6 21 460 0.942)
<     (6 6 781 1.470)
<     (1 19 297 1.880)
<     (1 25 291 1.856)
---
>   '((1 5 460. 1.113)
>     (1 1 440. 1.523)
>     (2 2 960. 1.337)
>     (4 4 1560. 1.212)
>     (1 6 536. 1.402)
>     (1 8 510. 1.438)
>     (3 7 1080. 1.208)
>     (1 11 510. 1.392)
>     (1 12 323. 1.795)
>     (1 13 230. 1.949)
>     (1 14 220. 2.149)
>     (8 20 610. 0.6)
>     (8 8 560. 1.381)
>     (6 20 460. 0.6)
>     (6 21 460. 0.942)
>     (6 6 781. 1.470)
>     (1 19 297. 1.880)
>     (1 25 291. 1.856)
100,101c89,90
<     (19 19 185 2.332)
<     (22 22 440 1.501)))
---
>     (19 19 185. 2.332)
>     (22 22 440. 1.501)))

Please change the coefficients to be floats rather than integers.

110c101
<    '(400 1.3)
---
>    '(400. 1.3)

ditto

217c216,219
<   (real-part (sqrt x)))
---
>   (declare (flonum))
>   (if (>= x 0.0)
>       (sqrt x)
>       0.0))

Like I said before, I think this is faster and clearer.  (Ignore the
(declare (flonum)))

332c342
< 	 (du-dth (* kth (* tdif (+ 1 (* 1.508 tdif tdif)))))
---
> 	 (du-dth (* kth (* tdif (+ 1.0 (* 1.508 tdif tdif)))))

Again, you're using mixed-mode arithmetic where it isn't necessary.

402,403c413,414
< 			      (* -2 v2 (sin (* 2 w)))
< 			      (* 3 v3 (sin (* 3 w))))))
---
> 			      (* -2. v2 (sin (* 2. w)))
> 			      (* 3. v3 (sin (* 3. w))))))

ditto

443c456
< 	     (du-dr (* 0.006 evdw r_recip r6 (- 1 (* 2 r6))))
---
> 	     (du-dr (* 0.006 evdw r_recip r6 (- 1. (* 2. r6))))

ditto

hackv.scm:
102c133
<     (atm-add-force a2 (vscale fvec -1))))
---
>     (atm-add-force a2 (vscale fvec -1.))))

ditto

140,142c174,178
< (define (external-forces)
<   (repulsion atom-1 atom-2
< 	     (if (> (fmod _t period) (* 0.5 period)) 3 -3)))
---
> (set! external-forces
>       (lambda ()
> 	(declare (flonum))
> 	(repulsion atom-1 atom-2
> 		   (if (> (fmod _t period) (* 0.5 period)) 3. -3.))))

again

145,146c181,182
< (if (defined? 'update-display)
<     (define (blab) (update-display true))
---
> ;;;(if (defined? 'update-display)
> ;;;    (define (blab) (update-display true))

(if A (define B ...) (define C ...)) is not standard scheme; this should
be a macro.

Brad

>From lucier@MATH.Purdue.EDU  Mon Mar 17 17:07:19 1997
Received: from gauss.math.purdue.edu by world.std.com (5.65c/Spike-2.0)
	id AA05267; Mon, 17 Mar 1997 12:07:29 -0500
Received: from newton.math.purdue.edu (newton.math.purdue.edu [128.210.3.6]) by gauss.math.purdue.edu (8.8.5/Purdue_Math) with ESMTP id MAA01864; Mon, 17 Mar 1997 12:07:27 -0500 (EST)
From: Brad Lucier <lucier@MATH.Purdue.EDU>
Received: (lucier@localhost) by newton.math.purdue.edu (8.6.10/Purdue_Math-1.0) id MAA06619; Mon, 17 Mar 1997 12:07:19 -0500
Date: Mon, 17 Mar 1997 12:07:19 -0500
Message-Id: <199703171707.MAA06619@newton.math.purdue.edu>
To: wware@world.std.com
Subject: ncad023
Cc: lucier@MATH.Purdue.EDU
Status: R

I guess I missed the changes in ncad023.scm.  I think it's a big mistake to
hardwire a specific lambda-based implementation of structures into ncad, e.g.,

(define (create-bond order first second)
  (entering "make-bond")
  (make-lambda (x)
    (case x
      ('order order)
      ('first first)
      ('second second))))
 
(define (bond-order b)  (funcall b 'order))
(define (bond-first b)  (funcall b 'first))
(define (bond-second b) (funcall b 'second))

In any scheme with built-in structures (like gambit), you can translate
this trivially to much faster code, e.g.,

(define-structure bond order first second)

(define create-bond make-bond)

will create the access functions bond-order, bond-first, bond-second, the
creator make-bond (which is why I defined create-bond to make-bond), and
the setters bond-order-set!, etc. (which you don't really use).  In gambit
these are just type-checked vector lookups, and are much faster than the
lambda-based versions of the same thing, i.e., they can be inlined, if
you make the right declarations they are not type-checked, etc.

Brad

-------------------------------------------------------------
Will Ware <wware@world.std.com> web <http://world.std.com/~wware/>
PGP fingerprint   45A8 722C D149 10CC   F0CF 48FB 93BF 7289

