示例#1
0
int parse_imprlist(NLEnergy *p, Tcl_Interp *interp,
    Tcl_Obj *const obj, boolean invert) {
  char *imprsel = Array_data(&(p->imprsel));
  char *invsel = Array_data(&(p->invsel));
  char *sel = (invert ? invsel : imprsel);
  const int32 nimprs = Topology_impr_array_length(&(p->topo));
  int32 id;
  Tcl_Obj **objv;
  int objc, n;

  if (invert) {
    memset(invsel, 0, nimprs);
  }
  if ((id=parse_impr(p,interp,obj)) >= 0) {  /* could be a singleton */
    sel[id] = TRUE;
  }
  else {  /* its a list of imprs */
    if (TCL_ERROR==Tcl_ListObjGetElements(interp, obj, &objc, &objv)) {
      return FAIL;
    }
    for (n = 0;  n < objc;  n++) {
      if ((id=parse_impr(p,interp,objv[n])) < 0) {
        return FAIL;
      }
      sel[id] = TRUE;
    }
  }
  if (invert) {
    for (id = 0;  id < nimprs;  id++) {
      if (FALSE==invsel[id]) imprsel[id] = TRUE;
    }
  }
  return OK;
}
示例#2
0
CAMLprim value win_write
(value fd, value buf, value ofs, value len, value id) {
  CAMLparam4(fd, buf, ofs, len);
  struct caml_bigarray *buf_arr = Bigarray_val(buf);

  if (Field(fd, 1) == Val_long(0))
    overlapped_action (WRITE_OVERLAPPED, Long_val(id), Handle(fd),
                       Array_data (buf_arr, ofs), Long_val(len));
  else
    thread_io (WRITE, Long_val(id), Field(fd, 1), Handle(fd),
               Array_data (buf_arr, ofs), Long_val(len));
  CAMLreturn (Val_unit);
}
示例#3
0
CAMLprim value ml_blit_buffer_to_string
(value a, value i, value s, value j, value l)
{
  char *src = Array_data(Bigarray_val(a), i);
  char *dest = String_val(s) + Long_val(j);
  memcpy(dest, src, Long_val(l));
  return Val_unit;
}
示例#4
0
static int setup_atomid_map(NLEnergy *p, Tcl_Interp *interp, int32 natoms) {
  char script[64];
  Tcl_Obj *obj;
  Tcl_Obj **objv;
  int32 *atomid, *extatomid;
  int32 atomidlen;
  int objc, i, s;

  INT(natoms);
  if (natoms <= 0) return ERROR(ERR_EXPECT);
  if ((s=Array_resize(&(p->extatomid),natoms)) != OK) return ERROR(s);
  extatomid = Array_data(&(p->extatomid));
  snprintf(script, sizeof(script), "%s list", p->aselname);
  if (TCL_OK != Tcl_EvalEx(interp, script, -1, 0) ||
      NULL==(obj = Tcl_GetObjResult(interp)) ||
      TCL_OK != Tcl_ListObjGetElements(interp, obj, &objc, &objv) ||
      objc != natoms) {
    return ERROR(ERR_EXPECT);
  }
  for (i = 0;  i < objc;  i++) {
    long n;
    if (TCL_OK != Tcl_GetLongFromObj(interp, objv[i], &n)) {
      return ERROR(ERR_EXPECT);
    }
    extatomid[i] = (int32) n;
    ASSERT(0==i || extatomid[i-1] < extatomid[i]);
  }
  ASSERT(i == natoms);
  p->firstid = extatomid[0];
  p->lastid = extatomid[natoms-1];
  INT(p->firstid);
  INT(p->lastid);
  atomidlen = p->lastid - p->firstid + 1;
  ASSERT(atomidlen >= natoms);
  if ((s=Array_resize(&(p->atomid),atomidlen)) != OK) return ERROR(s);
  atomid = Array_data(&(p->atomid));
  for (i = 0;  i < atomidlen;  i++) {  /* initialize */
    atomid[i] = FAIL;
  }
  for (i = 0;  i < natoms;  i++) {
    atomid[ extatomid[i] - p->firstid ] = i;
  }
  return OK;
}
示例#5
0
int atomlist_contrib(NLEnergy *p) {
  char *atomsel = Array_data(&(p->atomsel));
  const char *nonbsel = Array_data_const(&(p->nonbsel));
  const char *bondsel = Array_data_const(&(p->bondsel));
  const char *anglesel = Array_data_const(&(p->anglesel));
  const char *dihedsel = Array_data_const(&(p->dihedsel));
  const char *imprsel = Array_data_const(&(p->imprsel));
  const Topology *topo = &(p->topo);
  const Bond *bond = Topology_bond_array(topo);
  const Angle *angle = Topology_angle_array(topo);
  const Dihed *dihed = Topology_dihed_array(topo);
  const Impr *impr = Topology_impr_array(topo);
  const int32 natoms = Topology_atom_array_length(topo);
  const int32 nbonds = Topology_bond_array_length(topo);
  const int32 nangles = Topology_angle_array_length(topo);
  const int32 ndiheds = Topology_dihed_array_length(topo);
  const int32 nimprs = Topology_impr_array_length(topo);
  int32 i;

  memset(atomsel, 0, natoms);
  for (i = 0;  i < natoms;  i++) {
    if (nonbsel[i]) atomsel[i]=TRUE;
  }
  for (i = 0;  i < nbonds;  i++) {
    if (bondsel[i]) {
      atomsel[ bond[i].atomID[0] ] = TRUE;
      atomsel[ bond[i].atomID[1] ] = TRUE;
    }
  }
  for (i = 0;  i < nangles;  i++) {
    if (anglesel[i]) {
      atomsel[ angle[i].atomID[0] ] = TRUE;
      atomsel[ angle[i].atomID[1] ] = TRUE;
      atomsel[ angle[i].atomID[2] ] = TRUE;
    }
  }
  for (i = 0;  i < ndiheds;  i++) {
    if (dihedsel[i]) {
      atomsel[ dihed[i].atomID[0] ] = TRUE;
      atomsel[ dihed[i].atomID[1] ] = TRUE;
      atomsel[ dihed[i].atomID[2] ] = TRUE;
      atomsel[ dihed[i].atomID[3] ] = TRUE;
    }
  }
  for (i = 0;  i < nimprs;  i++) {
    if (imprsel[i]) {
      atomsel[ impr[i].atomID[0] ] = TRUE;
      atomsel[ impr[i].atomID[1] ] = TRUE;
      atomsel[ impr[i].atomID[2] ] = TRUE;
      atomsel[ impr[i].atomID[3] ] = TRUE;
    }
  }
  return OK;
}
示例#6
0
int parse_atomlist(NLEnergy *p, Tcl_Interp *interp,
    Tcl_Obj *const obj, boolean invert, int mark) {
  char *atomsel = Array_data(&(p->atomsel));
  char *nonbsel = Array_data(&(p->nonbsel));
  char *asel = (mark > 0 ? nonbsel : atomsel);
  char *invsel = Array_data(&(p->invsel));
  char *sel = (invert ? invsel : asel);
  const int32 natoms = Topology_atom_array_length(&(p->topo));
  int32 id;
  Tcl_Obj **objv;
  int objc, n;
  int m = (mark > 0 ? mark : -mark);

  if (invert) {
    memset(invsel, 0, natoms);
  }
  if ((id=parse_atom(p,interp,obj)) >= 0) {  /* could be a singleton */
    sel[id] |= (char)m;
  }
  else {  /* its a list of atoms */
    if (TCL_ERROR==Tcl_ListObjGetElements(interp, obj, &objc, &objv)) {
      return FAIL;
    }
    for (n = 0;  n < objc;  n++) {
      if ((id=parse_atom(p,interp,objv[n])) < 0) {
        return FAIL;
      }
      sel[id] |= (char)m;
    }
  }
  if (invert) {
    for (id = 0;  id < natoms;  id++) {
      if (FALSE==invsel[id]) asel[id] |= (char)m;
    }
  }
  return OK;
}
示例#7
0
CAMLprim value win_readdirtorychanges
(value fd_val, value buf_val, value recursive, value flags, value id_val) {
  CAMLparam5(fd_val, buf_val, recursive, flags, id_val);
  struct caml_bigarray *buf_arr = Bigarray_val(buf_val);
  long id = Long_val(id_val);
  HANDLE fd = Handle_val(fd_val);
  char * buf = Array_data (buf_arr, 0);
  long len = buf_arr->dim[0];
  long action = READDIRECTORYCHANGES;
  BOOL res;
  long err;
  int notify_filter = convert_flag_list(flags, notify_filter_flags);
  completionData * d = GlobalAlloc(GPTR, sizeof(completionData));
  if (d == NULL) {
    errno = ENOMEM;
    uerror(action_name[action], Nothing);
  }
  d->id = id;
  d->action = action;

  D(printf("Starting %s: id %ld, len %ld\n", action_name[action], id, len));

  res = ReadDirectoryChangesW (fd, buf, len, Bool_val(recursive),
                               notify_filter, NULL, &(d->overlapped),
                               overlapped_completion);

  if (!res) {
    err = GetLastError ();
    if (err != ERROR_IO_PENDING) {
      win32_maperr (err);
  D(printf("Action %s failed: id %ld -> err %d (errCode %ld)\n",
           action_name[action], id, errno, err));
      uerror("ReadDirectoryChangesW", Nothing);
    }
  }
  CAMLreturn (Val_unit);
}
示例#8
0
CAMLprim value win_parse_directory_changes (value buf_val) {
  CAMLparam1(buf_val);
  CAMLlocal4(lst, tmp, elt, filename);
  struct caml_bigarray *buf_arr = Bigarray_val(buf_val);
  char * pos = Array_data (buf_arr, 0);
  FILE_NOTIFY_INFORMATION * entry;

  lst = Val_long(0);
  while (1) {
    entry = (FILE_NOTIFY_INFORMATION *)pos;
    elt = caml_alloc_tuple(2);
    filename = caml_alloc_string(entry->FileNameLength);
    memmove(String_val(filename), entry->FileName, entry->FileNameLength);
    Store_field (elt, 0, filename);
    Store_field (elt, 1, Val_long(entry->Action - 1));
    tmp = caml_alloc_tuple(2);
    Store_field (tmp, 0, elt);
    Store_field (tmp, 1, lst);
    lst = tmp;
    if (entry->NextEntryOffset == 0) break;
    pos += entry->NextEntryOffset;
  }
  CAMLreturn(lst);
}
示例#9
0
int select_from_atomlist(NLEnergy *p) {
  char *atomsel = Array_data(&(p->atomsel));
  char *nonbsel = Array_data(&(p->nonbsel));
  char *bondsel = Array_data(&(p->bondsel));
  char *anglesel = Array_data(&(p->anglesel));
  char *dihedsel = Array_data(&(p->dihedsel));
  char *imprsel = Array_data(&(p->imprsel));
  const Topology *topo = &(p->topo);
  const Bond *bond = Topology_bond_array(topo);
  const Angle *angle = Topology_angle_array(topo);
  const Dihed *dihed = Topology_dihed_array(topo);
  const Impr *impr = Topology_impr_array(topo);
  const int32 natoms = Topology_atom_array_length(topo);
  int32 i, id;
  Idseq seq;
  int32 numelec, numelec_b, numvdw, numvdw_b;
  boolean overlap;
  int s;

  for (i = 0;  i < natoms;  i++) {
    nonbsel[i] |= atomsel[i];
    /* select bonds */
    if ((s=Idseq_init(&seq, Topology_atom_bondlist(topo, i))) != OK) {
      return ERROR(s);
    }
    while ((id=Idseq_getid(&seq)) >= 0) {
      if (atomsel[ bond[id].atomID[0] ]
          && atomsel[ bond[id].atomID[1] ]) {
        bondsel[id] = TRUE;
      }
    }
    Idseq_done(&seq);
    /* select angles */
    if ((s=Idseq_init(&seq, Topology_atom_anglelist(topo, i))) != OK) {
      return ERROR(s);
    }
    while ((id=Idseq_getid(&seq)) >= 0) {
      if (atomsel[ angle[id].atomID[0] ]
          && atomsel[ angle[id].atomID[1] ]
          && atomsel[ angle[id].atomID[2] ]) {
        anglesel[id] = TRUE;
      }
    }
    Idseq_done(&seq);
    /* select dihedrals */
    if ((s=Idseq_init(&seq, Topology_atom_dihedlist(topo, i))) != OK) {
      return ERROR(s);
    }
    while ((id=Idseq_getid(&seq)) >= 0) {
      if (atomsel[ dihed[id].atomID[0] ]
          && atomsel[ dihed[id].atomID[1] ]
          && atomsel[ dihed[id].atomID[2] ]
          && atomsel[ dihed[id].atomID[3] ]) {
        dihedsel[id] = TRUE;
      }
    }
    Idseq_done(&seq);
    /* select impropers */
    if ((s=Idseq_init(&seq, Topology_atom_imprlist(topo, i))) != OK) {
      return ERROR(s);
    }
    while ((id=Idseq_getid(&seq)) >= 0) {
      if (atomsel[ impr[id].atomID[0] ]
          && atomsel[ impr[id].atomID[1] ]
          && atomsel[ impr[id].atomID[2] ]
          && atomsel[ impr[id].atomID[3] ]) {
        imprsel[id] = TRUE;
      }
    }
    Idseq_done(&seq);
  }

  /* check validity of nonbonded selection */
  numelec = 0;
  numelec_b = 0;
  numvdw = 0;
  numvdw_b = 0;
  overlap = TRUE;
  //INT(natoms);
  for (i = 0;  i < natoms;  i++) {
    if ((nonbsel[i] & (ASEL_ELEC | ASEL_ELEC_B))
        == (ASEL_ELEC | ASEL_ELEC_B) ||
        (nonbsel[i] & (ASEL_VDW | ASEL_VDW_B))
        == (ASEL_VDW | ASEL_VDW_B)) {
      return ERROR(ERR_EXPECT);
    }
    if (overlap && nonbsel[i] != 0 &&
        nonbsel[i] != ASEL_NONB && nonbsel[i] != ASEL_NONB_B) {
      overlap = FALSE;
    }
    //INT(i);
    //HEX(nonbsel[i]);
    if (nonbsel[i] & ASEL_ELEC)   numelec++;
    if (nonbsel[i] & ASEL_VDW)    numvdw++;
    if (nonbsel[i] & ASEL_ELEC_B) numelec_b++;
    if (nonbsel[i] & ASEL_VDW_B)  numvdw_b++;
  }
  if ((0==numelec && numelec_b > 0) || (0==numvdw && numvdw_b > 0)) {
    INT(numelec);
    INT(numelec_b);
    INT(numvdw);
    INT(numvdw_b);
    return ERROR(ERR_EXPECT);
  }
  INT(numvdw);

  p->nb_overlap = overlap;
  //INT(p->nb_overlap);
  p->fnbcut_all = (natoms==numelec ? FNBCUT_ELEC : 0)
    | (natoms==numvdw ? FNBCUT_VDW : 0);
  //HEX(p->fnbcut_all);
  p->fnbcut_subset =
    (0 < numelec && numelec < natoms && 0==numelec_b ? FNBCUT_ELEC : 0)
    | (0 < numvdw && numvdw < natoms && 0==numvdw_b ? FNBCUT_VDW : 0);
  //HEX(p->fnbcut_subset);
  p->fnbcut_disjoint = (numelec > 0 && numelec_b > 0 ? FNBCUT_ELEC : 0)
    | (numvdw > 0 && numvdw_b > 0 ? FNBCUT_VDW : 0);
  //HEX(p->fnbcut_disjoint);

  /* start by resetting all index array lengths */
  if ((s=Array_resize(&(p->idnonb), 0)) != OK) return ERROR(s);
  if ((s=Array_resize(&(p->idnonb_b), 0)) != OK) return ERROR(s);
  if ((s=Array_resize(&(p->idnbvdw), 0)) != OK) return ERROR(s);
  if ((s=Array_resize(&(p->idnbvdw_b), 0)) != OK) return ERROR(s);

  if ((p->fnbcut_all & FNBCUT_ELEC)==0) {
    if ((p->fnbcut_subset & FNBCUT_ELEC) ||
        (p->fnbcut_disjoint & FNBCUT_ELEC)) {
      if ((s=Array_resize(&(p->idnonb), numelec)) != OK) return ERROR(s);
      /* reset uselen for Array_append() */
      if ((s=Array_resize(&(p->idnonb), 0)) != OK) return ERROR(s);
      for (i = 0;  i < natoms;  i++) {
        if ((nonbsel[i] & ASEL_ELEC)
            && (s=Array_append(&(p->idnonb), &i)) != OK) {
          return ERROR(s);
        }
      }
    }
    if ((p->fnbcut_disjoint & FNBCUT_ELEC)) {
      if ((s=Array_resize(&(p->idnonb_b), numelec_b)) != OK) return ERROR(s);
      /* reset uselen for Array_append() */
      if ((s=Array_resize(&(p->idnonb_b), 0)) != OK) return ERROR(s);
      for (i = 0;  i < natoms;  i++) {
        if ((nonbsel[i] & ASEL_ELEC_B)
            && (s=Array_append(&(p->idnonb_b), &i)) != OK) {
          return ERROR(s);
        }
      }
    }
  }

  if (!overlap && (p->fnbcut_all & FNBCUT_VDW)==0) {
    if ((p->fnbcut_subset & FNBCUT_VDW) ||
        (p->fnbcut_disjoint & FNBCUT_VDW)) {
      if ((s=Array_resize(&(p->idnbvdw), numvdw)) != OK) return ERROR(s);
      /* reset uselen for Array_append() */
      if ((s=Array_resize(&(p->idnbvdw), 0)) != OK) return ERROR(s);
      for (i = 0;  i < natoms;  i++) {
        if ((nonbsel[i] & ASEL_VDW)
            && (s=Array_append(&(p->idnbvdw), &i)) != OK) {
          return ERROR(s);
        }
      }
    }
    if ((p->fnbcut_disjoint & FNBCUT_VDW)) {
      if ((s=Array_resize(&(p->idnbvdw_b), numvdw_b)) != OK) return ERROR(s);
      /* reset uselen for Array_append() */
      if ((s=Array_resize(&(p->idnbvdw_b), 0)) != OK) return ERROR(s);
      for (i = 0;  i < natoms;  i++) {
        if ((nonbsel[i] & ASEL_VDW_B)
            && (s=Array_append(&(p->idnbvdw_b), &i)) != OK) {
          return ERROR(s);
        }
      }
    }
  }

  return OK;
}
示例#10
0
int NLEnergy_parse_eval(NLEnergy *p, Tcl_Interp *interp,
    int objc, Tcl_Obj *const objv[], int evalType) {
  enum { KEYWD, ATOM, BOND, ANGLE, DIHED, IMPR, ELEC, VDW, NONB };
  const Topology *topo = &(p->topo);
  const int32 natoms = Topology_atom_array_length(topo);
  const int32 nbonds = Topology_bond_array_length(topo);
  const int32 nangles = Topology_angle_array_length(topo);
  const int32 ndiheds = Topology_dihed_array_length(topo);
  const int32 nimprs = Topology_impr_array_length(topo);
  int32 ninvs;
  char *atomsel, *nonbsel, *bondsel, *anglesel, *dihedsel, *imprsel, *invsel;
  int32 i;
  int state = KEYWD, s;
  int setnum = 0, mark = FALSE;
  boolean invert = FALSE;

  TEXT("eval");
  if (Array_length(&(p->atomsel)) != natoms
      && (s=Array_resize(&(p->atomsel), natoms)) != OK) return ERROR(s);
  atomsel = Array_data(&(p->atomsel));
  if (Array_length(&(p->nonbsel)) != natoms
      && (s=Array_resize(&(p->nonbsel), natoms)) != OK) return ERROR(s);
  nonbsel = Array_data(&(p->nonbsel));
  if (Array_length(&(p->bondsel)) != nbonds
      && (s=Array_resize(&(p->bondsel), nbonds)) != OK) return ERROR(s);
  bondsel = Array_data(&(p->bondsel));
  if (Array_length(&(p->anglesel)) != nangles
      && (s=Array_resize(&(p->anglesel), nangles)) != OK) return ERROR(s);
  anglesel = Array_data(&(p->anglesel));
  if (Array_length(&(p->dihedsel)) != ndiheds
      && (s=Array_resize(&(p->dihedsel), ndiheds)) != OK) return ERROR(s);
  dihedsel = Array_data(&(p->dihedsel));
  if (Array_length(&(p->imprsel)) != nimprs
      && (s=Array_resize(&(p->imprsel), nimprs)) != OK) return ERROR(s);
  imprsel = Array_data(&(p->imprsel));

  /* find max length for inverse selection array */
  ninvs = natoms;
  if (ninvs < nbonds)  ninvs = nbonds;
  if (ninvs < nangles) ninvs = nangles;
  if (ninvs < ndiheds) ninvs = ndiheds;
  if (ninvs < nimprs)  ninvs = nimprs;
  if (Array_length(&(p->invsel)) != ninvs
      && (s=Array_resize(&(p->invsel), ninvs)) != OK) return ERROR(s);
  invsel = Array_data(&(p->invsel));

  if (0 == objc) {
    memset(atomsel, 0, natoms);
    memset(nonbsel, ASEL_NONB, natoms);
    memset(bondsel, TRUE, nbonds);
    memset(anglesel, TRUE, nangles);
    memset(dihedsel, TRUE, ndiheds);
    memset(imprsel, TRUE, nimprs);
  }
  else {
    const char *t = NULL;
    state = KEYWD;
    memset(atomsel, 0, natoms);
    memset(nonbsel, 0, natoms);
    memset(bondsel, 0, nbonds);
    memset(anglesel, 0, nangles);
    memset(dihedsel, 0, ndiheds);
    memset(imprsel, 0, nimprs);
    i = 0;
    INT(objc);
    while (i <= objc) {
      INT(i);
      switch (state) {
        case KEYWD:
          if (i == objc) { i++; break; }
          t = Tcl_GetString(objv[i]);
          setnum = 0;
          invert = FALSE;
          if ('-'==t[0]) { invert = TRUE;  t++; }
          else if ('+'==t[0])  { t++; }
          if (strcmp(t,"atom")==0)       state = ATOM;
          else if (strcmp(t,"bond")==0)  state = BOND;
          else if (strcmp(t,"angle")==0) state = ANGLE;
          else if (strcmp(t,"dihed")==0) state = DIHED;
          else if (strcmp(t,"impr")==0)  state = IMPR;
          else if (strcmp(t,"elec")==0)  state = ELEC;
          else if (strcmp(t,"vdw")==0)   state = VDW;
          else if (strcmp(t,"nonb")==0)  state = NONB;
          else return ERROR(ERR_EXPECT);
          i++;
          break;
        case BOND:
          s = FAIL;
          if (i<objc && (s=parse_bondlist(p,interp,objv[i],invert))==OK) i++;
          //else if (s < FAIL) return ERROR(s);
          else if ( ! invert ) memset(bondsel, TRUE, nbonds);
          state = KEYWD;
          break;
        case ANGLE:
          s = FAIL;
          if (i<objc && (s=parse_anglelist(p,interp,objv[i],invert))==OK) i++;
          //else if (s < FAIL) return ERROR(s);
          else if ( ! invert ) memset(anglesel, TRUE, nangles);
          state = KEYWD;
          break;
        case DIHED:
          s = FAIL;
          if (i<objc && (s=parse_dihedlist(p,interp,objv[i],invert))==OK) i++;
          //else if (s < FAIL) return ERROR(s);
          else if ( ! invert ) memset(dihedsel, TRUE, ndiheds);
          state = KEYWD;
          break;
        case IMPR:
          s = FAIL;
          if (i<objc && (s=parse_imprlist(p,interp,objv[i],invert))==OK) i++;
          //else if (s < FAIL) return ERROR(s);
          else if ( ! invert ) memset(imprsel, TRUE, nimprs);
          state = KEYWD;
          break;
        default:  /* ATOM, ELEC, VDW, or NONB */
          if (i==objc && setnum > 0) { state = KEYWD; continue; }
          if (ATOM==state) mark = (0==setnum ? -ASEL_NONB : -ASEL_NONB_B);
          else if (ELEC==state) mark = (0==setnum ? ASEL_ELEC : ASEL_ELEC_B);
          else if (VDW==state)  mark = (0==setnum ? ASEL_VDW  : ASEL_VDW_B);
          else                  mark = (0==setnum ? ASEL_NONB : ASEL_NONB_B);
          INT(ASEL_NONB==mark);
          INT(ASEL_NONB_B==mark);
          s = FAIL;
          if (i<objc && (s=parse_atomlist(p,interp,objv[i],invert,mark))==OK) {
            i++;
            setnum++;
            if (invert || 2==setnum) state = KEYWD;
          }
#if 0
          else if (s < FAIL) {
            if (setnum > 0) continue;
            else return ERROR(s);
          }
#endif
          else if (0==setnum &&  !invert) {
            if (mark > 0) {
              memset(nonbsel, mark, natoms);
            }
            else {
              memset(atomsel, -mark, natoms);
            }
            state = KEYWD;
          }
          else state = KEYWD;
      } /* switch */
    } /* while */
  } /* else */

  if ((s=select_from_atomlist(p)) != OK) return ERROR(s);

  /* evaluation */
  if (EVAL_ENERGY==evalType || EVAL_FORCE==evalType) {
    if ((s=NLEnergy_eval_force(p)) != OK) return ERROR(s);
  }
  else {
    /* minimize not yet supported */
    return ERROR(ERR_EXPECT);
  }

  /* output */
  if (EVAL_ENERGY==evalType) {
    Tcl_Obj *a = NULL;
    if ((s=NLEnergy_new_obj_dreal(interp, &a,
            p->ener.pe * ENERGY_EXTERNAL)) != OK) {
      return ERROR(s);
    }
    if ((s=NLEnergy_set_obj_result(interp, a)) != OK) return ERROR(s);
  }
  else if (EVAL_FORCE==evalType || EVAL_MINIMIZE==evalType) {
    const dvec *f = Coord_force_const(&(p->coord));
    Tcl_Obj *r = NULL;  /* return list of lists */
    Tcl_Obj *a = NULL;  /* list of atom index */
    Tcl_Obj *b = NULL;  /* list of force or potentials (MINIMIZE) */
    if ((s=atomlist_contrib(p)) != OK) return ERROR(s);
    if ((s=new_list(interp, &r)) != OK) return ERROR(s);
    if ((s=new_list(interp, &a)) != OK) return ERROR(s);
    if ((s=new_list(interp, &b)) != OK) return ERROR(s);
    for (i = 0;  i < natoms;  i++) {
      if (atomsel[i]) {
        if ((s=list_append_atomid(p,interp,a,i)) != OK) return ERROR(s);
        if (EVAL_FORCE==evalType) {
          dvec fs;
          VECMUL(fs, ENERGY_EXTERNAL, f[i]);
          if ((s=list_append_dvec(interp,b,&fs)) != OK) return ERROR(s);
        }
      }
    }
    if (EVAL_MINIMIZE==evalType) {
      return ERROR(ERR_EXPECT);
    }
    if ((s=list_append_obj(interp, r, a)) != OK) return ERROR(s);
    if ((s=list_append_obj(interp, r, b)) != OK) return ERROR(s);
    if ((s=set_obj_result(interp, r)) != OK) return ERROR(s);
  }
  else {
    /* nothing else is supported */
    return ERROR(ERR_EXPECT);
  }

#if 0
  if (objc >= 1) {
    const char *t = Tcl_GetString(objv[0]);
    if (strcmp(t,"bond")==0) {
      return NLEnergy_energy_bond(p, interp, objc-1, objv+1);
    }
    if (strcmp(t,"angle")==0) {
      return NLEnergy_energy_angle(p, interp, objc-1, objv+1);
    }
    if (strcmp(t,"dihed")==0) {
      return NLEnergy_energy_dihed(p, interp, objc-1, objv+1);
    }
    if (strcmp(t,"impr")==0) {
      return NLEnergy_energy_impr(p, interp, objc-1, objv+1);
    }
    if (strcmp(t,"elec")==0) {
      return NLEnergy_energy_nonbonded(p, FNBCUT_ELEC, interp, objc-1, objv+1);
    }
    if (strcmp(t,"vdw")==0) {
      return NLEnergy_energy_nonbonded(p, FNBCUT_VDW, interp, objc-1, objv+1);
    }
    if (strcmp(t,"nonbonded")==0) {
      return NLEnergy_energy_nonbonded(p, FNBCUT_ELEC | FNBCUT_VDW,
	  interp, objc-1, objv+1);
    }
  }
  return ERROR(ERR_EXPECT);
#endif

  return OK;
}
示例#11
0
int main(int argc, char *argv[]) {
  Array arr;
  Random ran;
  unsigned long seed;
  int len, range, i, s, debug;
  SortElem *a;

  if (argc > 5) {
    NL_fprintf(stderr, "syntax: %s [N RANGE SEED debug?]\n", argv[0]);
    exit(1);
  }
  len = (argc >= 2 ? atoi(argv[1]) : DEFLEN);
  range = (argc >= 3 ? atoi(argv[2]) : DEFRANGE);
  seed = (argc >= 4 ? atoi(argv[3]) : DEFSEED);
  debug = (argc >= 5);

  if (len <= 0) {
    NL_fprintf(stderr, "nelems must be positive\n");
    exit(1);
  }

  if ((s=Array_init(&arr, sizeof(SortElem))) != OK) {
    NL_fprintf(stderr, "Array_init() failed\n");
    exit(1);
  }
  if ((s=Array_resize(&arr, len)) != OK) {
    NL_fprintf(stderr, "Array_resize() failed for len=%d\n", len);
    exit(1);
  }

  if ((s=Random_initseed(&ran, seed)) != OK) {
    NL_fprintf(stderr, "Random_initseed() failed\n");
    exit(1);
  }

  a = (SortElem *) Array_data(&arr);
  NL_printf("creating random array of %d elements...\n", len);
  for (i = 0;  i < len;  i++) {
    a[i].key = (int32) (Random_uniform(&ran) * range);
    a[i].value = i;
  }
  if (debug) {
    for (i = 0;  i < len;  i++) {
      NL_printf(" %d", a[i].key);
    }
    NL_printf("\n");
  }

  NL_printf("calling quicksort...\n");
  Sort_quick(a, len);

  NL_printf("testing sort condition...\n");
  if (debug) {
    for (i = 0;  i < len;  i++) {
      NL_printf(" %d", a[i].key);
    }
    NL_printf("\n");
  }

  for (i = 1;  i < len;  i++) {
    if (a[i-1].key > a[i].key) {
      NL_fprintf(stderr, "failed sort condition for pair (%d,%d):\n"
          "a[%d]=%d  a[%d]=%d\n", i-1, i, i-1, a[i-1].key, i, a[i].key);
      exit(1);
    }
  }

  NL_printf("success!\n");
  return 0;
}