fortranclient.c

Go to the documentation of this file.

/* $Id: fortranclient.c,v 1.8 2007/07/24 19:24:32 yarkhan Exp $ */
/* $UTK_Copyright: $ */

#include <stdarg.h>

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif /* HAVE_CONFIG_H */

#include "netsolveclient.h"
#include "grpc.h"

void
fnetsl(char *nickname, ...)
{
  va_list argptr;
  char *buf;
  int *return_value, len;

  grpc_set_default_major("COL");

  /* Getting the problem's nickname */
  va_start(argptr, nickname);

#ifdef F2CSTRCRAYSTYLE
  va_arg(argptr, int);
#endif

  /* Get the address of the return value */
  return_value = (int *) va_arg(argptr, int *);

  /* The trailing "()" in the problem name signifies the end of the
   * string.  Strip this off since it isn't used by the GridRPC client.
   */
  buf = nickname;
  while((*buf != '(') && (*buf != '\0'))
    buf++;

  len = (int) (buf - nickname + 2);

  buf = (char *) malloc(len + 1);

  if(!buf) {
    *return_value = NetSolveSystemError;
    return;
  }

  memcpy(buf, nickname, len);
  buf[len] = '\0';

  *return_value = netslX(buf, argptr, GS_CALL_FROM_FORTRAN,
                         NS_BLOCK, NS_NOASSIGNMENT);

  free(buf);

  return;
}

void
fnetslerr(int *info)
{
  fprintf(stderr, "%s\n", netsolveErrorMessage(*info));
}

void
fnetslmajor(char *maj)
{
  netslmajor(maj);
}

void
fnetslnb(char *nickname, ...)
{
  va_list argptr;
  char *buf;
  int *return_value, len;

  grpc_set_default_major("COL");

  /* Getting the problem's nickname */
  va_start(argptr, nickname);

#if defined(F2CSTRCRAYSTYLE)
  va_arg(argptr, int);
#endif

  /* Get the address of the return value */
  return_value = (int *) va_arg(argptr, int *);

  buf = nickname;
  while((*buf != '(') && (*buf != '\0'))
    buf++;

  len = (int) (buf - nickname + 2);

  buf = (char *) malloc(len + 1);

  if(!buf) {
    *return_value = NetSolveSystemError;
    return;
  }

  memcpy(buf, nickname, len);
  buf[len] = '\0';

  *return_value = netslX(buf, argptr, GS_CALL_FROM_FORTRAN,
                         NS_NOBLOCK, NS_NOASSIGNMENT);

  free(buf);

  return;
}

void
fnetslpr(int *request_id, int *info)
{
  if(!info || !request_id) return;

  *info = netslpr(*request_id);
  return;
}


void
fnetslwt(int *request_id, int *info)
{
  if(!info || !request_id) return;

  *info = netslwt(*request_id);
  return;
}