linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remove .{h,c} files to match with PSI cleanup

Browse Source
This commit is contained in:
Douglas Clowes
2015-03-19 11:42:50 +11:00
parent 42500aca38
commit 3661e1fc77
5 changed files with 0 additions and 1761 deletions
Download Patch File Download Diff File Expand all files Collapse all files

481
difrac.c
View File

@ -1,481 +0,0 @@
/*-------------------------------------------------------------------------
D I F R A C
A four-circle diffractometer requires sophicticated procedures for
searching peaks, orienting crystals and for performing data collection.
Rather then invent all of this again the DIFRAC-F77 program written by
Peter White and Eric Gabe has been incoporated into SICS. This module
provides the C-language side of the interface between DIFRAC and SICS.
DIFRAC can only be included once into SICS, it is not possible to have
more then one copy of this. This is why there is file static global data
here.
copyright: see copyright.h
Mark Koennecke, November 1999
--------------------------------------------------------------------------*/
#include <stdlib.h>
#include <assert.h>
#include <ctype.h>
#include "fortify.h"
#include "sics.h"
#include "motor.h"
#include "counter.h"
#include "status.h"
#include "splitter.h"
#include "difrac.h"
/*--------------------------------------------------------------------------
In order to deal with multiple request to the DIFRAC subsystem we need to
keep the connection objects on a stack. This stack is defined here.
---------------------------------------------------------------------------*/
#define MAXSTACK 50
static SConnection *ConStack[MAXSTACK];
static int iConStackPtr = -1;
/*--------------------------------------------------------------------------
In order to do the four circle work we need to know the motors of the
eulerian cradle and access to the counter. Furthermore we need to know
about the omega2theta motor and the scanning routine.
These data structures are initialized by the installation routine.
---------------------------------------------------------------------------*/
static pMotor pTTH, pOM, pCHI, pPHI;
static pCounter counter;
/*---------------------------------------------------------------------------
The following routines will be called from F77. Their names take care of the
system dependent name mangling scheme for calling C from F77. This may
need adjustment when porting to another system
---------------------------------------------------------------------------*/
/*========= read angles */
void sicsanget_(float *fTH, float *fOM, float *fCHI, float *fPHI)
{
int iRet;
/* this is just security, may never happen */
if (iConStackPtr < 0) {
return;
}
if (ConStack[iConStackPtr] == NULL) {
return;
}
iRet = MotorGetSoftPosition(pTTH, ConStack[iConStackPtr], fTH);
if (iRet != 1) {
SCWrite(ConStack[iConStackPtr],
"ERROR: failed to read two theta, DIFRAC may be confused now",
eError);
}
iRet = MotorGetSoftPosition(pOM, ConStack[iConStackPtr], fOM);
if (iRet != 1) {
SCWrite(ConStack[iConStackPtr],
"ERROR: failed to read omega, DIFRAC may be confused now",
eError);
}
iRet = MotorGetSoftPosition(pCHI, ConStack[iConStackPtr], fCHI);
if (iRet != 1) {
SCWrite(ConStack[iConStackPtr],
"ERROR: failed to read chi, DIFRAC may be confused now",
eError);
}
iRet = MotorGetSoftPosition(pPHI, ConStack[iConStackPtr], fPHI);
if (iRet != 1) {
SCWrite(ConStack[iConStackPtr],
"ERROR: failed to read two theta, DIFRAC may be confused now",
eError);
}
}
#define ABS(x) (x < 0 ? -(x) : (x))
/*=========== check angles */
void sicsangcheck_(float *fTH, float *fOM, float *fCHI, float *fPHI,
int *iInvalid)
{
int iRet;
SConnection *pCon = NULL;
float fHard;
char pBueffel[256], pError[131];
/* this is just security, may never happen */
if (iConStackPtr < 0) {
return;
}
if (ConStack[iConStackPtr] == NULL) {
return;
}
pCon = ConStack[iConStackPtr];
*iInvalid = 0;
iRet = MotorCheckBoundary(pTTH, *fTH, &fHard, pError, 131);
if (iRet != 1) {
sprintf(pBueffel,
"ERROR: %6.2f %6.2f %6.2f %6.2f violates twotheta limits",
*fTH, *fOM, *fCHI, *fPHI);
SCWrite(pCon, pBueffel, eError);
*iInvalid = 4;
return;
}
iRet = MotorCheckBoundary(pOM, *fOM, &fHard, pError, 131);
if (iRet != 1) {
sprintf(pBueffel,
"ERROR: %6.2f %6.2f %6.2f %6.2f violates omega limits",
*fTH, *fOM, *fCHI, *fPHI);
SCWrite(pCon, pBueffel, eError);
*iInvalid = 4;
return;
}
iRet = MotorCheckBoundary(pCHI, *fCHI, &fHard, pError, 131);
if (iRet != 1) {
sprintf(pBueffel,
"ERROR: %6.2f %6.2f %6.2f %6.2f violates chi limits",
*fTH, *fOM, *fCHI, *fPHI);
SCWrite(pCon, pBueffel, eError);
*iInvalid = 4;
return;
}
iRet = MotorCheckBoundary(pPHI, *fPHI, &fHard, pError, 131);
if (iRet != 1) {
sprintf(pBueffel,
"ERROR: %6.2f %6.2f %6.2f %6.2f violates phi limits",
*fTH, *fOM, *fCHI, *fPHI);
SCWrite(pCon, pBueffel, eError);
*iInvalid = 4;
return;
}
}
/*======== set angles */
void sicsangset_(float *fTTH, float *fOM, float *fCHI, float *fPHI,
int *icol)
{
pDummy pDum;
int iRet;
SConnection *pCon = NULL;
float fT1, fT2, fT3, fT4;
*icol = 0;
/* this is just security, may never happen */
if (iConStackPtr < 0) {
return;
}
if (ConStack[iConStackPtr] == NULL) {
return;
}
pCon = ConStack[iConStackPtr];
/* check if this is possible, if not complain */
sicsangcheck_(fTTH, fOM, fCHI, fPHI, &iRet);
if (iRet >= 4) {
*icol = 1;
return;
}
/* start */
pDum = (pDummy) pTTH;
iRet = StartDevice(pServ->pExecutor, "TTH",
pDum->pDescriptor, pDum, pCon, *fTTH);
if (!iRet) {
SCWrite(pCon, "ERROR: cannot start two theta motor", eError);
StopExe(pServ->pExecutor, "all");
*icol = 10;
}
pDum = (pDummy) pOM;
iRet = StartDevice(pServ->pExecutor, "OM",
pDum->pDescriptor, pDum, pCon, *fOM);
if (!iRet) {
SCWrite(pCon, "ERROR: cannot start omega motor", eError);
StopExe(pServ->pExecutor, "all");
*icol = 10;
}
pDum = (pDummy) pCHI;
iRet = StartDevice(pServ->pExecutor, "CHI",
pDum->pDescriptor, pDum, pCon, *fCHI);
if (!iRet) {
SCWrite(pCon, "ERROR: cannot start chi motor", eError);
StopExe(pServ->pExecutor, "all");
*icol = 10;
}
pDum = (pDummy) pPHI;
iRet = StartDevice(pServ->pExecutor, "PHI",
pDum->pDescriptor, pDum, pCon, *fPHI);
if (!iRet) {
SCWrite(pCon, "ERROR: cannot start two theta motor", eError);
StopExe(pServ->pExecutor, "all");
*icol = 10;
}
/* wait for end of it */
iRet = Wait4Success(pServ->pExecutor);
switch (iRet) {
case DEVINT:
if (SCGetInterrupt(pCon) == eAbortOperation) {
SCSetInterrupt(pCon, eContinue);
SCSetError(pCon, OKOK);
}
break;
case DEVDONE:
break;
default:
break;
}
/*
As TRICS has such a shitty cradle check angles and report error
if bad
*/
sicsanget_(&fT1, &fT2, &fT3, &fT4);
if (ABS(fT1 - *fTTH) > .2) {
*icol = 10;
}
if (ABS(fT2 - *fOM) > .2) {
*icol = 10;
}
if (ABS(fT3 - *fCHI) > .2) {
*icol = 10;
}
if (ABS(fT4 - *fPHI) > .2) {
*icol = 10;
}
}
/*=========== count */
void sicscount_(float *fPreset, float *fCounts)
{
pDummy pDum;
int iRet;
SConnection *pCon = NULL;
long lTask;
/* this is just security, may never happen */
if (iConStackPtr < 0) {
return;
}
if (ConStack[iConStackPtr] == NULL) {
return;
}
pCon = ConStack[iConStackPtr];
pDum = (pDummy) counter;
SetCounterPreset(counter, *fPreset);
iRet = StartDevice(pServ->pExecutor,
"DifracCount",
pDum->pDescriptor, counter, pCon, *fPreset);
if (!iRet) {
SCWrite(pCon, "ERROR: Failed to start counting ", eError);
return;
}
SetStatus(eCounting);
/* wait for finish */
lTask = GetDevexecID(pServ->pExecutor);
if (lTask > 0);
{
TaskWait(pServ->pTasker, lTask);
}
*fCounts = (float) GetCounts(counter, pCon);
}
/*========= sicswrite */
void sicswrite_(int *iText, int *iLen)
{
SConnection *pCon = NULL;
char pBueffel[256];
int i;
if (*iLen > 255)
return;
for (i = 0; i < *iLen; i++) {
pBueffel[i] = (char) iText[i];
}
pBueffel[i] = '\0';
/* this is just security, may never happen */
if (iConStackPtr < 0) {
puts(pBueffel);
return;
}
if (ConStack[iConStackPtr] == NULL) {
puts(pBueffel);
return;
}
pCon = ConStack[iConStackPtr];
SCWrite(pCon, pBueffel, eValue);
}
/*========== sicsgetline */
void sicsgetline_(int *iText, int *iLen)
{
SConnection *pCon = NULL;
char pBueffel[256];
int i, iRet;
/* this is just security, may never happen */
if (iConStackPtr < 0) {
return;
}
if (ConStack[iConStackPtr] == NULL) {
return;
}
pCon = ConStack[iConStackPtr];
iRet = SCPrompt(pCon, "Enter data please >>", pBueffel, 255);
/* difrac cannot handle an interrupted input operation */
if (iRet == 0) {
SCSetInterrupt(pCon, eContinue);
}
for (i = 0; i < strlen(pBueffel); i++) {
iText[i] = (int) pBueffel[i];
}
*iLen = strlen(pBueffel);
}
/*============= checkint */
void checkint_(int *iK)
{
SConnection *pCon = NULL;
char pBueffel[256];
int i;
/* this is just security, may never happen */
if (iConStackPtr < 0) {
*iK = 0;
return;
}
if (ConStack[iConStackPtr] == NULL) {
return;
}
pCon = ConStack[iConStackPtr];
if (SCGetInterrupt(pCon) >= eAbortScan) {
*iK = 0;
} else {
*iK = 1;
}
}
/*--------------------------------------------------------------------------
DifracAction is the interface routine between the SICS interpreter and
the DIFRAC subsystem. What it basically does is: pop the connection onto
the stack. Concatenate all pending command line data to a string. Then
call DIFRAC with this string as an parameter. On return, remove the
connection from the stack again and return.
-------------------------------------------------------------------------*/
/* some protoypes for things defined in F77 */
extern void difini_(void);
extern void difint_(int *iText, int *iLen);
int DifracAction(SConnection * pCon, SicsInterp * pSics, void *pData,
int argc, char *argv[])
{
char pInput[256];
int iInput[256];
int iLen, i;
if (argc < 2) {
SCWrite(pCon, "ERROR: dif expects at least one argument", eError);
return 0;
}
/* user privilege required */
if (!SCMatchRights(pCon, usUser)) {
return 0;
}
/* steal: redirect the I/O to me */
strcpy(pInput, argv[1]);
strtolower(pInput);
if (strcmp(pInput, "steal") == 0) {
if (iConStackPtr >= 0) {
ConStack[iConStackPtr] = pCon;
}
SCSendOK(pCon);
return 1;
}
iConStackPtr++;
ConStack[iConStackPtr] = pCon;
Arg2Text(argc - 1, &argv[1], pInput, 255);
iLen = strlen(pInput);
for (i = 0; i < iLen; i++) {
iInput[i] = toupper((int) pInput[i]);
}
/* do difrac */
difint_(iInput, &iLen);
SCWrite(pCon, "Difrac subsystem finished", eWarning);
iConStackPtr--;
if (SCGetInterrupt(pCon) != eContinue) {
return 0;
} else {
return 1;
}
}
/*-------------------- The initialization routine ----------------------*/
int MakeDifrac(SConnection * pCon, SicsInterp * pSics, void *pData,
int argc, char *argv[])
{
CommandList *pCom = NULL;
pICountable pCts = NULL;
int iRet;
if (argc < 6) {
SCWrite(pCon,
"ERROR: Insufficient number of arguments to MakeDifrac",
eError);
return 0;
}
/* find motors */
pTTH = FindMotor(pSics, argv[1]);
if (!pTTH) {
SCWrite(pCon, "ERROR: cannot find two theta motor", eError);
return 0;
}
pOM = FindMotor(pSics, argv[2]);
if (!pOM) {
SCWrite(pCon, "ERROR: cannot find omega motor", eError);
return 0;
}
pCHI = FindMotor(pSics, argv[3]);
if (!pTTH) {
SCWrite(pCon, "ERROR: cannot find chi motor", eError);
return 0;
}
pPHI = FindMotor(pSics, argv[4]);
if (!pTTH) {
SCWrite(pCon, "ERROR: cannot find phi motor", eError);
return 0;
}
/* locate counter */
pCom = FindCommand(pSics, argv[5]);
if (pCom == NULL) {
SCWrite(pCon, "ERROR: counter not found in MakeDifrac", eError);
return 0;
}
pCts = GetCountableInterface(pCom->pData);
if (!pCts) {
SCWrite(pCon, "ERROR: argument to MakeDifrac is no counter", eError);
return 0;
}
counter = (pCounter) pCom->pData;
/* initialize difrac */
difini_();
/* install command */
iRet = AddCommand(pSics, "dif", DifracAction, NULL, NULL);
if (!iRet) {
SCWrite(pCon, "ERROR: duplicate command dif NOT created", eError);
}
return iRet;
}

14
difrac.h
View File

@ -1,14 +0,0 @@
/*--------------------------------------------------------------------------
D I F R A C
Header file for the interface between SICS and the F77 package
DIFRAC. Only the factory routine is defined.
Mark Koennecke, November 1999
--------------------------------------------------------------------------*/
#ifndef DIFRAC
#define DIFRAC
int MakeDifrac(SConnection * pCon, SicsInterp * pSics, void *pData,
int argc, char *argv[]);
#endif

622
ecbcounter.c
View File

@ -1,622 +0,0 @@
/*----------------------------------------------------------------------------
This is a single counter implemented on top of the Risoe ECB electronic
copyright: see file COPYRIGHT
Mark Koennecke, January-February 2003
---------------------------------------------------------------------------*/
#include <stdlib.h>
#include <assert.h>
#include <errno.h>
#include <tcl.h>
#include <math.h>
#include <unistd.h>
#include "fortify.h"
#include "sics.h"
#include "status.h"
#include "psi/ecb.h"
#include "countdriv.h"
/*------------------ our private data structure ------------------------*/
typedef struct {
pECB ecb; /* the ECB system we talk to */
unsigned char prescaler[8]; /* an array for the prescaler values */
int tfreq; /* timer frequency */
unsigned char control; /* marks the control monitor */
int state; /* current counting state */
} ECBCounter, *pECBCounter;
/*----------------- private defines ------------------------------------*/
#define STFRD 137
#define STREAD 138
#define STOPS 136
#define STCLEA 134
#define PRELOA 139
#define STLOAD 156
#define STCPRE 133
#define STARTS 135
#define SPCSTA 169
/*------------------ state codes --------------------------------------*/
#define IDLE 0
#define COUNT 2
#define NOBEAM 3
/*--------------------------------------------------------------------*/
#define MAX_COUNT 4294967295.0
/*------------------ error codes --------------------------------------*/
#define COMMERROR -300
#define TOMANYCOUNTS -301
#define NOSEND -302
#define INVALIDCOUNTER -304
#define INVALIDPRESCALER -305
#define BADFREQ -306
/*======================================================================*/
static int readScaler(pECBCounter pPriv, int scaler, int *count)
{
int status;
Z80_reg in, out;
Ecb_pack data;
in.c = (unsigned char) scaler;
status = ecbExecute(pPriv->ecb, STREAD, in, &out);
if (status != 1) {
return COMMERROR;
}
data.b.byt3 = out.c;
data.b.byt2 = out.b;
data.b.byt1 = out.d;
data.b.byt0 = out.e;
if (scaler == 0) {
*count = data.result / pPriv->tfreq;
} else {
*count = data.result;
}
return 1;
}
/*---------------------------------------------------------------------*/
static int check4Beam(struct __COUNTER *pCter, int *beam)
{
Z80_reg in, out;
pECBCounter self = NULL;
int status;
self = (pECBCounter) pCter->pData;
assert(self);
in.c = 1;
status = ecbExecute(self->ecb, SPCSTA, in, &out);
if (status != 1) {
pCter->iErrorCode = COMMERROR;
return HWFault;
}
*beam = (int) out.d;
return 1;
}
/*----------------------------------------------------------------------*/
static int stopScalers(pECBCounter self)
{
int status;
Z80_reg in, out;
status = ecbExecute(self->ecb, STOPS, in, &out);
if (status != 1) {
return COMMERROR;
}
return 1;
}
/*========================================================================
These two functions currently rely on the idea that the ECB stops
and starts without clearing counters in between. The sequence of
things necessary to start it, suggests this. If this is not the case then
this will not work.
===========================================================================*/
static int ECBPause(struct __COUNTER *self)
{
int status;
pECBCounter pPriv = NULL;
assert(self);
pPriv = (pECBCounter) self->pData;
assert(pPriv);
if ((status = stopScalers(pPriv)) <= 0) {
self->iErrorCode = status;
return HWFault;
}
return OKOK;
}
/*=======================================================================*/
static int ECBContinue(struct __COUNTER *self)
{
int status;
pECBCounter pPriv = NULL;
Z80_reg in, out;
assert(self);
pPriv = (pECBCounter) self->pData;
assert(pPriv);
status = ecbExecute(pPriv->ecb, STARTS, in, &out);
if (status != 1) {
self->iErrorCode = status;
return HWFault;
}
return OKOK;
}
/*-----------------------------------------------------------------------*/
static int ECBGetStatus(struct __COUNTER *self, float *fControl)
{
pECBCounter pPriv = (pECBCounter) self->pData;
int status, result, scaler;
Z80_reg in, out;
int count, beam;
assert(pPriv);
/*
This can happen after a stop
*/
if (pPriv->state == IDLE) {
ECBTransfer(self);
return HWIdle;
}
/*
read status bit
*/
status = ecbExecute(pPriv->ecb, STFRD, in, &out);
if (status != 1) {
self->iErrorCode = COMMERROR;
pPriv->state = IDLE;
return HWFault;
}
/*
read beam status
*/
status = check4Beam(self, &beam);
if (status != 1) {
self->iErrorCode = COMMERROR;
return HWFault;
}
beam &= 1;
/*
sophisticated logic in order to keep track of the various states
the thing can be in. Complicated by the fact that the status becomes
idle (out.d = 0) when the measurement is paused due to the lack of
beam.
*/
if (pPriv->state == COUNT && beam == 1) {
ECBPause(self);
pPriv->state = NOBEAM;
SetStatus(eOutOfBeam);
result = HWNoBeam;
}
if (pPriv->state == NOBEAM && beam == 0) {
ECBContinue(self);
pPriv->state = COUNT;
SetStatus(eCounting);
return HWBusy;
}
if (pPriv->state == NOBEAM && beam == 1) {
return HWNoBeam;
}
if (out.d == 0 && pPriv->state == COUNT) {
result = HWIdle;
ECBTransfer(self);
pPriv->state = IDLE;
} else {
result = HWBusy;
}
/*
select which scaler to read
*/
if (self->eMode == eTimer) {
scaler = 0;
} else {
scaler = pPriv->control;
}
readScaler(pPriv, scaler, &count);
/*
ignore errors on this one
*/
*fControl = (float) count;
return result;
}exit
/*=====================================================================*/
static int clearScalers(pECBCounter self)
{
int status;
Z80_reg in, out;
status = ecbExecute(self->ecb, STCLEA, in, &out);
if (status != 1) {
return COMMERROR;
}
return 1;
}
/*----------------------------------------------------------------------*/
static int loadPrescalers(pECBCounter self)
{
Z80_reg in, out;
int status, i;
for (i = 0; i < 8; i++) {
in.c = (unsigned char) i;
in.d = self->prescaler[i];
status = ecbExecute(self->ecb, PRELOA, in, &out);
if (status != 1) {
return COMMERROR;
}
}
return 1;
}
/*----------------------------------------------------------------------*/
static int loadPreset(pECBCounter self, int preset, unsigned char control)
{
Z80_reg in, out;
Ecb_pack data;
int status, i;
data.result = preset;
in.c = data.b.byt3;
in.b = data.b.byt2;
in.e = data.b.byt1;
in.d = data.b.byt0;
status = ecbExecute(self->ecb, STLOAD, in, &out);
if (status != 1) {
return COMMERROR;
}
in.b = data.b.byt2;
in.e = data.b.byt1;
in.d = data.b.byt0;
in.c = 4 * control;
status = ecbExecute(self->ecb, STCPRE, in, &out);
if (status != 1) {
return COMMERROR;
}
return 1;
}
/*-----------------------------------------------------------------------*/
static int ECBStart(struct __COUNTER *self)
{
pECBCounter pPriv = NULL;
int preset, status, controlUnit;
Z80_reg in, out;
assert(self);
pPriv = (pECBCounter) self->pData;
assert(pPriv);
/*
check if the preset is permissible
*/
preset = (int) rint(self->fPreset);
if (preset > MAX_COUNT) {
self->iErrorCode = TOMANYCOUNTS;
return HWFault;
}
if (self->eMode == eTimer) {
controlUnit = 0;
preset *= pPriv->tfreq;
if (preset > MAX_COUNT) {
self->iErrorCode = TOMANYCOUNTS;
return HWFault;
}
} else {
controlUnit = pPriv->control;
}
if ((status = stopScalers(pPriv)) <= 0) {
self->iErrorCode = status;
return HWFault;
}
if ((status = clearScalers(pPriv)) <= 0) {
self->iErrorCode = status;
return HWFault;
}
if ((status = loadPrescalers(pPriv)) <= 0) {
self->iErrorCode = status;
return HWFault;
}
if ((status =
loadPreset(pPriv, preset, (unsigned char) controlUnit)) <= 0) {
self->iErrorCode = status;
return HWFault;
}
status = ecbExecute(pPriv->ecb, STARTS, in, &out);
if (status != 1) {
self->iErrorCode = status;
return HWFault;
}
pPriv->state = COUNT;
return OKOK;
}
/*=======================================================================*/
static int ECBHalt(struct __COUNTER *self)
{
int status;
pECBCounter pPriv = NULL;
assert(self);
pPriv = (pECBCounter) self->pData;
assert(pPriv);
pPriv->state = IDLE;
if ((status = stopScalers(pPriv)) <= 0) {
self->iErrorCode = status;
return HWFault;
}
return OKOK;
}
/*=======================================================================*/
static int ECBTransfer(struct __COUNTER *self)
{
int status, count, i;
pECBCounter pPriv = NULL;
assert(self);
pPriv = (pECBCounter) self->pData;
assert(pPriv);
/*
read time
*/
status = readScaler(pPriv, 0, &count);
if (status <= 0) {
self->iErrorCode = COMMERROR;
return HWFault;
}
self->fTime = (float) count;
/*
read other scalers
*/
for (i = 1; i < 8; i++) {
status = readScaler(pPriv, i, &count);
if (status <= 0) {
self->iErrorCode = COMMERROR;
return HWFault;
}
self->lCounts[i - 1] = count;
}
return OKOK;
}
/*======================================================================*/
static int ECBGetError(struct __COUNTER *self, int *iCode,
char *errorText, int errlen)
{
char pBueffel[132];
*iCode = self->iErrorCode;
switch (self->iErrorCode) {
case COMMERROR:
strlcpy(errorText, "Communication error with ECB", errlen);
break;
case TOMANYCOUNTS:
strlcpy(errorText, "Preset is to high!", errlen);
break;
case NOSEND:
strlcpy(errorText, "Cannot send naked data to ECB", errlen);
break;
case UNKNOWNPAR:
strlcpy(errorText, "parameter unknown", errlen);
break;
case INVALIDCOUNTER:
strlcpy(errorText, "Invalid counter number requested, 0-7 allowed",
errlen);
break;
case INVALIDPRESCALER:
strlcpy(errorText, "Invalid prescaler value, allowed 1 or 10", errlen);
break;
case BADFREQ:
strlcpy(errorText, "Bad timer frequency: 10 or 1000 allowed", errlen);
break;
default:
sprintf(pBueffel, "Unknown error code %d", self->iErrorCode);
strlcpy(errorText, pBueffel, errlen);
break;
}
return 1;
}
/*=======================================================================*/
static int ECBFixIt(struct __COUNTER *self, int iCode)
{
return COTERM;
}
/*======================================================================*/
/*******************************************************************************
* Load the parameters 'dot' and 'divide' for a motor or an encoder.
* 'dot' specifies the placement of a punctuation mark on the display
* of f.ex a motor position. 'divide' specifies how many times the po-
* sition is to be divided by two before it is displayed.
******************************************************************************/
static void Dot_divide(int device, int data, pECB ecb)
{
int function, dot, divide;
Z80_reg x_inreg, out;
if (data == 0) /* If zero, dont send dot/divide) */
return;
dot = 0;
while ((data % 10) == 0) {
dot++;
data /= 10;
}
divide = 0;
while ((data % 2) == 0) {
divide++;
data /= 2;
}
if (data != 1) /* If != 1, not a binary No. */
return;
if (dot > 0)
dot = 8 - dot;
x_inreg.c = 0; /* Specify input */
x_inreg.b = (unsigned char) device;
x_inreg.d = (unsigned char) dot; /* Dot position */
x_inreg.e = (unsigned char) divide; /* No. of times to divide by 2 */
ecbExecute(ecb, 170, x_inreg, &out);
return;
}
/*-----------------------------------------------------------------------*/
static int ECBSet(struct __COUNTER *self, char *name,
int iCter, float fVal)
{
pECBCounter pPriv = NULL;
int iVal;
assert(self);
pPriv = (pECBCounter) self->pData;
assert(pPriv);
iVal = (int) rint(fVal);
if (strcmp(name, "prescaler") == 0) {
if (iCter < 0 || iCter > 7) {
self->iErrorCode = INVALIDCOUNTER;
return HWFault;
}
if (iVal != 1 && iVal != 10) {
self->iErrorCode = INVALIDPRESCALER;
return HWFault;
}
pPriv->prescaler[iCter] = (unsigned char) iVal;
return OKOK;
} else if (strcmp(name, "tfreq") == 0) {
if (fVal == 1000) {
pPriv->prescaler[0] = 1;
pPriv->tfreq = 1000;
Dot_divide(64, 1000, pPriv->ecb);
return OKOK;
} else if (fVal == 10) {
pPriv->tfreq = 10;
pPriv->prescaler[0] = 10;
Dot_divide(64, 10, pPriv->ecb);
return OKOK;
} else {
self->iErrorCode = BADFREQ;
return HWFault;
}
} else {
self->iErrorCode = UNKNOWNPAR;
return HWFault;
}
}
/*===================================================================*/
static int ECBGet(struct __COUNTER *self, char *name,
int iCter, float *fVal)
{
pECBCounter pPriv = NULL;
assert(self);
pPriv = (pECBCounter) self->pData;
assert(pPriv);
if (strcmp(name, "prescaler") == 0) {
*fVal = (float) pPriv->prescaler[iCter];
return OKOK;
} else if (strcmp(name, "tfreq") == 0) {
*fVal = (float) pPriv->tfreq;
return OKOK;
} else {
self->iErrorCode = UNKNOWNPAR;
return HWFault;
}
}
/*=====================================================================*/
static int ECBSend(struct __COUNTER *self, char *text,
char *reply, int replylen)
{
strlcpy(reply, "ECB does not feast on ASCII strings, refused!",
replylen);
return OKOK;
}
/*====================================================================*/
pCounterDriver MakeECBCounter(char *ecb)
{
pECBCounter pPriv = NULL;
pCounterDriver self = NULL;
int i;
/*
memory for everybody
*/
self = CreateCounterDriver("ecb", "ecb");
pPriv = (pECBCounter) malloc(sizeof(ECBCounter));
if (self == NULL || pPriv == NULL) {
return NULL;
}
memset(pPriv, 0, sizeof(ECBCounter));
/*
initialize private data structure
*/
pPriv->ecb = (pECB) FindCommandData(pServ->pSics, ecb, "ECB");
if (pPriv->ecb == NULL) {
DeleteCounterDriver(self);
free(pPriv);
return NULL;
}
for (i = 0; i < 8; i++) {
pPriv->prescaler[i] = 1;
}
pPriv->tfreq = 1000;
pPriv->control = 1;
/*
assign function pointers
*/
self->GetStatus = ECBGetStatus;
self->Start = ECBStart;
self->Pause = ECBPause;
self->Continue = ECBContinue;
self->Halt = ECBHalt;
self->ReadValues = ECBTransfer;
self->GetError = ECBGetError;
self->TryAndFixIt = ECBFixIt;
self->Set = ECBSet;
self->Get = ECBGet;
self->Send = ECBSend;
self->KillPrivate = NULL;
self->pData = pPriv;
return self;
}

17
ecbcounter.h
View File

@ -1,17 +0,0 @@
/*-------------------------------------------------------------------------
Header file for the counter driver for the Risoe ECB system.
copyright: see file COPYRIGHT
Mark Koennecke, January 2003
-------------------------------------------------------------------------*/
#ifndef ECBCOUNTER
#define ECBCOUNTER
#include "countdriv.h"
pCounterDriver MakeECBCounter(char *ecb);
void KillECBCounter(CounterDriver * pDriv);
#endif

627
tacov.c
View File

@ -1,627 +0,0 @@
/* tacov.f -- translated by f2c (version 20000817).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
integer inx;
real c1rx, c2rx, rmin, rmax, cl1r;
} curve_;
#define curve_1 curve_
/* Table of constant values */
static doublereal c_b7 = 1.;
static doublereal c_b9 = 360.;
/* ----------------------------------------------------------------------- */
/* FILE T_CONV */
/* SUBROUTINE T_CONV(EI,AKI,EF,AKF,QHKL,EN,HX,HY,HZ,IF1,IF2,LDK,LDH,LDF */
/* 1 LPA,DM,DA,HELM,F1H,F1V,F2H,F2V,F,IFX,ISS,ISM,ISA, */
/* 2 T_A,T_RM,T_ALM,LDRA,LDR_RM,LDR_ALM,P_IH,C_IH,IER) */
/* SUBROUTINE EX_CASE(DX,ISX,AKX,AX1,AX2,RX,ALX,IER) */
/* SUBROUTINE SAM_CASE(QT,QM,QS,AKI,AKF,AX3,AX4,ISS,IER) */
/* SUBROUTINE HELM_CASE(HX,HY,HZ,P_IH,AKI,AKF,A4,QM,HELM,IER) */
/* SUBROUTINE FLIP_CASE(IF1,IF2,P_IH,F1V,F1H,F2V,F2H,AKI,AKF,IER) */
/* ----------------------------------------------------------------------- */
/* Subroutine */ int t_conv__(real * ei, real * aki, real * ef, real * akf,
real *
qhkl, real * en, real * hx, real * hy,
real * hz, integer * if1, integer * if2,
logical * ldk, logical * ldh, logical * ldf,
logical * lpa, real * dm, real * da,
real * helm, real * f1h, real * f1v,
real * f2h, real * f2v, real * f,
integer * ifx, integer * iss, integer * ism,
integer * isa, real * t_a__, real * t_rm__,
real * t_alm__, real * qm, logical * ldra,
logical * ldr_rm__, logical * ldr_alm__,
real * p_ih__, real * c_ih__, integer * ier)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static doublereal edef[2], dakf, daki;
static integer imod;
extern /* Subroutine */ int sam_case__(doublereal *, doublereal *,
doublereal *, doublereal *,
doublereal *, doublereal *,
doublereal *, integer *,
integer *);
static integer i__;
static doublereal akdef[2];
extern /* Subroutine */ int helm_case__(real *, real *, real *, real *,
real *, real *, real *,
doublereal *, real *, real *,
integer *);
static doublereal dqhkl[3];
extern /* Subroutine */ int flip_case__(integer *, integer *, real *,
real *, real *, real *, real *,
real *, real *, integer *);
static logical lmoan[2];
static doublereal a1, a2, a3, a4, a5, a6;
static integer id;
static doublereal ra;
extern /* Subroutine */ int rl2spv_(doublereal *, doublereal *,
doublereal *, doublereal *,
integer *);
static integer iq;
static doublereal rm;
static logical lqhkle;
extern /* Subroutine */ int erreso_(integer *, integer *);
static doublereal dda, ala, def, dei, ddm, alm, dqm;
extern /* Subroutine */ int ex_case__(doublereal *, integer *, doublereal
*, doublereal *, doublereal *,
doublereal *, doublereal *,
integer *);
static doublereal dqt[3], dqs;
/* ----------------------------------------------------------------------- */
/* INPUT */
/* EI,AKI,EF,AKF,QHKL,EN,HX,HY,HZ : POTENTIAL TARGETS */
/* IF1,IF2 Status of flippers On (1) Off (0) */
/* LDK(8) LOGICAL INDICATING IF (ENERGY,K OR Q) ARE DRIVEN */
/* LDH,LDF LOGICAL INDICATING IF (HX,HY,HZ) OR (F1,F2) ARE DRIVEN */
/* configuration of the machine */
/* LPA LOGICAL TRUE IF MACHINE IN POLARIZATION MODE */
/* DM,DA,HELM,F1H,F1V,F2H,F2V,F,IFX,ISS,ISM,ISA,QM (F ENERGY UNIT) */
/* OUTPUT */
/* T_A TARGETS OF ANGLES A1-A6 */
/* T_RM,T_ALM TARGETS OF RM ,LM */
/* QM TARGETS OF QM */
/* LDRA LOGICAL INDICATING WHICH ANGLES ARE TO BE DRIVEN */
/* LDR_RM,LDR_ALM LOGICAL INDICATING IF RM OR ALM ARE TO BE DRIVEN */
/* P_IH TARGETS OF CURRENTS FOR FLIPPERS AND HELMOTZ (8 CURRENTS) */
/* C_IH CONVERSION FACTORS FOR HELMOTZ (4 CURRENTS) */
/* SPECIAL OUTPUTS */
/* TARGET OF EI(EF) IS UPDATED IS KI(KF) IS DRIVEN */
/* TARGET OF VARIABLE ENERGY IS UPDATED IF EN IS DRIVEN */
/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */
/* PASSED PARAMETERS */
/* ----------------------------------------------------------------------- */
/* LOCAL VARIABLES */
/* ----------------------------------------------------------------------- */
/* SET UP */
/* IMOD INDEX FOR ERROR TREATMENAT BY ERRESO */
/* LDQHKLE : LOGICAL INDICATING THAT WE ARE DEALING WITH A MOVE */
/* IN RECIPROCICAL SPACE */
/* WE REMAP THE ENERGY PB AS FIXED ENERGY IN EDEF(1) */
/* AND VARIABLE ENERGY IN EDEF(2) */
/* IF ISA IS NUL SET IFX TO 1 AND PUT EF,KF, EQUAL TO EI,KI */
/* Parameter adjustments */
--c_ih__;
--p_ih__;
--ldra;
--t_a__;
--ldk;
--qhkl;
/* Function Body */
imod = 3;
ddm = *dm;
dda = *da;
for (i__ = 1; i__ <= 2; ++i__) {
lmoan[i__ - 1] = FALSE_;
}
lqhkle = FALSE_;
for (iq = 5; iq <= 8; ++iq) {
lqhkle = lqhkle || ldk[iq];
}
daki = *aki;
dakf = *akf;
if (*isa == 0) {
*ifx = 1;
}
edef[*ifx - 1] = *ei;
akdef[*ifx - 1] = *aki;
edef[3 - *ifx - 1] = *ef;
akdef[3 - *ifx - 1] = *akf;
if (*isa == 0) {
edef[1] = edef[0];
akdef[1] = akdef[0];
ldk[3] = TRUE_;
ldk[4] = TRUE_;
t_a__[5] = 0.f;
t_a__[6] = 0.f;
ldra[5] = TRUE_;
ldra[6] = TRUE_;
}
/* ----------------------------------------------------------------------- */
/* FIRST TAKE IN ACCOUNT THE FIXED ENERGY PB */
if (ldk[(*ifx << 1) - 1] || ldk[*ifx * 2]) {
lmoan[*ifx - 1] = TRUE_;
if (ldk[(*ifx << 1) - 1]) {
*ier = 1;
if (edef[0] < .1) {
goto L999;
}
*ier = 0;
akdef[0] = sqrt(edef[0] / *f);
} else {
*ier = 1;
if (akdef[0] < .1) {
goto L999;
}
*ier = 0;
/* Computing 2nd power */
d__1 = akdef[0];
edef[0] = *f * (d__1 * d__1);
}
}
/* ----------------------------------------------------------------------- */
/* NOW TAKE IN ACCOUNT THE VARIABLE ENERGY PB */
/* VARIABLE ENERGUY IS DRIVEN EITHER EXPLICITLY */
/* E.G. BY DRIVING EI OR KI WITH IFX=2 */
/* ( AND WE MUST CALCULATE EN FROM EVAR) */
/* THE RULE IS : EI=EF+EN : EN IS THE ENERGY LOSS OF NEUTRONS */
/* OR ENERGY GAIN OF SAMPLE */
/* OR IMPLICITLY BY DRIVING THE TRANSFERED ENERGY EN */
/* ( AND WE MUST CALCULATE EVAR FROM EN) */
/* IF KI IS CONSTANT USE THE CURRENT VALUE CONTAINED IN POSN ARRAY */
/* TO CALCULATE THE NON-"CONSTANT" K. */
/* IF KF IS CONSTANT USE ALWAYS THE VALUE IN TARGET AND */
/* DO A DRIVE OF KF TO KEEP A5/A6 IN RIGHT POSITION */
if (ldk[5 - (*ifx << 1)] || ldk[6 - (*ifx << 1)]) {
lmoan[3 - *ifx - 1] = TRUE_;
if (ldk[5 - (*ifx << 1)]) {
*ier = 1;
if (edef[1] < 1e-4) {
goto L999;
}
*ier = 0;
akdef[1] = sqrt(edef[1] / *f);
} else {
*ier = 1;
if (akdef[1] < 1e-4) {
goto L999;
}
*ier = 0;
/* Computing 2nd power */
d__1 = akdef[1];
edef[1] = *f * (d__1 * d__1);
}
*en = (3 - (*ifx << 1)) * (edef[0] - edef[1]);
} else if (lqhkle) {
lmoan[3 - *ifx - 1] = TRUE_;
edef[1] = edef[0] + ((*ifx << 1) - 3) * *en;
*ier = 1;
if (edef[1] < 1e-4) {
goto L999;
}
*ier = 0;
akdef[1] = sqrt(edef[1] / *f);
}
/* ----------------------------------------------------------------------- */
/* CALCULATE MONOCHROMATOR AND ANALYSER ANGLES */
if (lmoan[0]) {
dei = edef[*ifx - 1];
daki = akdef[*ifx - 1];
ex_case__(&ddm, ism, &daki, &a1, &a2, &rm, &alm, ier);
if (*ier == 0) {
*aki = daki;
*ei = dei;
t_a__[1] = a1;
t_a__[2] = a2;
*t_rm__ = rm;
*t_alm__ = alm;
ldra[1] = TRUE_;
ldra[2] = TRUE_;
*ldr_rm__ = TRUE_;
*ldr_alm__ = TRUE_;
} else {
goto L999;
}
}
if (lmoan[1]) {
def = edef[3 - *ifx - 1];
dakf = akdef[3 - *ifx - 1];
ex_case__(&dda, isa, &dakf, &a5, &a6, &ra, &ala, ier);
if (*ier == 0) {
*akf = dakf;
*ef = def;
t_a__[5] = a5;
t_a__[6] = a6;
ldra[5] = TRUE_;
ldra[6] = TRUE_;
} else {
goto L999;
}
}
/* ----------------------------------------------------------------------- */
/* USE (QH,QK,QL) TO CALCULATE A3 AND A4 */
/* CALCULATE Q1 AND Q2 IN SCATTERING PLANE */
imod = 2;
if (lqhkle) {
for (id = 1; id <= 3; ++id) {
dqhkl[id - 1] = qhkl[id];
}
rl2spv_(dqhkl, dqt, &dqm, &dqs, ier);
if (*ier != 0) {
goto L999;
}
sam_case__(dqt, &dqm, &dqs, &daki, &dakf, &a3, &a4, iss, ier);
if (*ier == 0) {
t_a__[3] = a3;
t_a__[4] = a4;
ldra[3] = TRUE_;
ldra[4] = TRUE_;
*qm = dqm;
} else {
goto L999;
}
}
/* ----------------------------------------------------------------------- */
/* DEAL WITH FLIPPERS AND HELMOTZ COILS IF LPA */
if (*lpa && (lmoan[0] || lmoan[1])) {
if (*ldf) {
flip_case__(if1, if2, &p_ih__[1], f1v, f1h, f2v, f2h, aki, akf, ier);
}
if (*ldh) {
helm_case__(hx, hy, hz, &p_ih__[1], &c_ih__[1], aki, akf, &a4, qm,
helm, ier);
}
}
/* ----------------------------------------------------------------------- */
L999:
if (*ier != 0) {
erreso_(&imod, ier);
}
return 0;
} /* t_conv__ */
/* Subroutine */ int ex_case__(doublereal * dx, integer * isx,
doublereal * akx,
doublereal * ax1, doublereal * ax2,
doublereal * rx, doublereal * alx,
integer * ier)
{
/* System generated locals */
doublereal d__1, d__2;
/* Builtin functions */
double asin(doublereal), sin(doublereal), cos(doublereal),
sqrt(doublereal);
/* Local variables */
static doublereal dcl1r, dc1rx, dc2rx, drmin, drmax, arg;
/* ----------------------------------------------------------------------- */
/* CALCULATE ANGLES ON MONO/ANALYSER */
/* CALCULATE AX1 AX2 */
/* CALCULATE RX LX MONO CURVATURE AND LM FOR IN8 */
/* INPUT */
/* DX D-SPACINGS */
/* ISX SENS OF SCATTERING ON CRYSTAL */
/* AKX TARGET OF MOMENTUM */
/* OUTPUT */
/* AX1 AX2 THETA 2*THETA ANGLES */
/* RX MONO OR ANALYSER CURVATURE */
/* ALX SPECIAL TRANSLATION FOR IN8 */
/* IER */
/* 1 ' KI OR KF CANNOT BE OBTAINED CHECK D-SPACINGS', */
/* 2 ' KI OR KF TOO SMALL', */
/* 3 ' KI OR KF TOO BIG', */
/* ----------------------------------------------------------------------- */
/* Values of parameters */
/* INX=1 IN8 , INX=0 others instruments */
/* C1RX C2RX constants values to calculate RM on all instruments */
/* RMIN, RMAX min max on RNM */
/* CL1R constant value to calculate LM for IN8 */
/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */
/* PASSED PARAMETERS */
/* ----------------------------------------------------------------------- */
/* LOCAL VAR */
/* ----------------------------------------------------------------------- */
/* INIT AND TEST */
*ier = 0;
dc1rx = curve_1.c1rx;
dc2rx = curve_1.c2rx;
drmin = curve_1.rmin;
drmax = curve_1.rmax;
dcl1r = curve_1.cl1r;
if (*dx < .1f) {
*ier = 1;
}
if (*akx < .1f) {
*ier = 2;
}
arg = 3.1415926535897932384626433832795f / (*dx * *akx);
if (abs(arg) > 1.f) {
*ier = 3;
}
if (*ier != 0) {
goto L999;
}
/* ----------------------------------------------------------------------- */
/* CALCULATION OF THE TWO ANGLES */
*ax1 = asin(arg) * *isx * 57.29577951308232087679815481410517f;
*ax2 = *ax1 * 2.;
/* ----------------------------------------------------------------------- */
/* CALCULATION OF MONO CURVATURE RM OR ANALYSER CURVATURE RA */
/* STANDARD LAW IS C1RX+C2RX/SIN(A1/RD) */
/* C1RX AND C2RX ARE CONSTANTS DEPENDING ON MONO AND MACHINES */
/* C1RX=.47 */
/* C2RX=.244 */
/* RMIN=0. */
/* RMAX=20. */
/* IN1/IN3/IN12/IN14/IN20 CASE */
if (curve_1.inx == 0) {
/* Computing MIN */
/* Computing MAX */
d__2 = dc1rx + dc2rx / sin(abs(*ax1) /
57.29577951308232087679815481410517f);
d__1 = max(d__2, drmin);
*rx = min(d__1, drmax);
} else {
/* IN8 CASE */
*alx =
dcl1r / sin(*ax2 / 57.29577951308232087679815481410517f) *
cos(*ax2 / 57.29577951308232087679815481410517f);
*rx = dc2rx * sqrt(sin(*ax2 / 57.29577951308232087679815481410517f))
- dc1rx;
}
/* ----------------------------------------------------------------------- */
L999:
return 0;
} /* ex_case__ */
/* ========================================================================= */
/* Subroutine */ int sam_case__(doublereal * qt, doublereal * qm,
doublereal *
qs, doublereal * aki, doublereal * akf,
doublereal * ax3, doublereal * ax4,
integer * iss, integer * ier)
{
/* System generated locals */
doublereal d__1, d__2;
/* Builtin functions */
double acos(doublereal), atan2(doublereal, doublereal), d_sign(doublereal
*,
doublereal
*),
d_mod(doublereal *, doublereal *);
/* Local variables */
static doublereal arg, sax3;
/* ----------------------------------------------------------------------- */
/* DEAL WITH SAMPLE ANGLES CALCULATION FROM Q VERTOR IN C-N PLANE */
/* CALCULATE A3 AND A4 */
/* INPUT */
/* QT Q-VECTOR IN SCATTERING PLANE */
/* QM,QS Q MODULUS AND QMODULUS SQUARED */
/* AKI,AKF MOMEMTA ON MONO AND ANYLSER */
/* ISS SENS OF SCATTERING ON SAMPLE */
/* OUTPUT */
/* AX3 AX4 ANGLES ON SAMPLES */
/* IER SAME ERROR AS RL2SPV */
/* IER */
/* 1 ' MATRIX S NOT OK', */
/* 2 ' Q NOT IN SCATTERING PLANE', */
/* 3 ' Q MODULUS TOO SMALL', */
/* 4 ' Q MODULUS TOO BIG', */
/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */
/* PASSED PARAMETERS */
/* ----------------------------------------------------------------------- */
/* INIT AND TEST */
/* Parameter adjustments */
--qt;
/* Function Body */
*ier = 0;
if (abs(*qs) < 1e-6 || abs(*qm) < .001) {
*ier = 3;
goto L999;
}
/* ----------------------------------------------------------------------- */
/* CALCULATE A3 AND MOVE IT INTHE -180 ,+180 INTERVAL */
/* Computing 2nd power */
d__1 = *aki;
/* Computing 2nd power */
d__2 = *akf;
arg = (d__1 * d__1 + d__2 * d__2 - *qs) / (*aki * 2. * *akf);
if (abs(arg) > 1.) {
*ier = 4;
goto L999;
} else {
*ax4 = acos(arg) * *iss * 57.29577951308232087679815481410517;
}
/* Computing 2nd power */
d__1 = *akf;
/* Computing 2nd power */
d__2 = *aki;
*ax3 =
(-atan2(qt[2], qt[1]) -
acos((d__1 * d__1 - *qs -
d__2 * d__2) / (*qm * -2. * *aki)) * d_sign(&c_b7,
ax4)) *
57.29577951308232087679815481410517;
sax3 = d_sign(&c_b7, ax3);
d__1 = *ax3 + sax3 * 180.;
*ax3 = d_mod(&d__1, &c_b9) - sax3 * 180.;
/* IF(LPLATE) AX3=-ATAN(SIN(AX4/RD)/(LSA*TAN(AX5/RD)/(ALMS*C */
/* 1 TAN(AX1/RD))*(AKI/KF)**2-COS(AX4/RD)))*RD !PLATE FOCALIZATION OPTION */
/* IF(AXX3.GT.180.D0) AX3=AX3-360.D0 */
/* IF( A3.LT.-180.D0) AX3=AX3+360.D0 */
/* IF(LPLATE.AND.A3.GT.0.0) AX3=AX3-180 */
/* C----------------------------------------------------------------------- */
L999:
return 0;
} /* sam_case__ */
/* ============================================================================ */
/* Subroutine */ int helm_case__(real * hx, real * hy, real * hz,
real * t_ih__,
real * c_ih__, real * aki, real * akf,
doublereal * a4, real * qm, real * helm,
integer * ier)
{
/* System generated locals */
real r__1, r__2;
/* Builtin functions */
double cos(doublereal), sin(doublereal), atan2(doublereal, doublereal),
sqrt(doublereal);
/* Local variables */
static real hrad, hdir, qpar, hdir2, qperp;
static integer ic;
static real phi;
/* ----------------------------------------------------------------------- */
/* DEAL WITH HELMOTZ COIL FIELD CALCULATIONS */
/* CALCULATE HX HY HZ */
/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */
/* PASSED PARAMETERS */
/* ----------------------------------------------------------------------- */
/* INIT AND TEST */
/* Parameter adjustments */
--c_ih__;
--t_ih__;
/* Function Body */
*ier = 1;
if (dabs(*qm) < 1e-4f) {
goto L999;
}
*ier = 0;
for (ic = 1; ic <= 4; ++ic) {
if (c_ih__[ic] < 1e-4f) {
*ier = 2;
}
}
if (*ier != 0) {
goto L999;
}
/* ----------------------------------------------------------------------- */
/* CALCULATE MODULE AND ANGLES OF IN PLANE FIELD H */
/* PHI !ANGLE BETWEEN Q AND KI */
/* HRAD !RADIAL COMP. OF H */
/* HDIR !DIRECTION OF H (IN RADIANS) */
/* HDIR2 !ANGLE BETWEEN FIELD AND AXE OF COIL 1 */
qpar = *aki - *akf * cos(*a4 / 57.29577951308232087679815481410517f);
qperp = *akf * sin(*a4 / 57.29577951308232087679815481410517f);
phi = atan2(qpar, qperp);
/* Computing 2nd power */
r__1 = *hx;
/* Computing 2nd power */
r__2 = *hy;
hrad = sqrt(r__1 * r__1 + r__2 * r__2);
if (hrad > 1e-4f) {
hdir = atan2(*hy, *hx);
}
hdir2 = phi + hdir + *helm / 57.29577951308232087679815481410517f +
1.5707963267948966f;
/* ----------------------------------------------------------------------- */
/* !CALC CURRENTS */
/* !POSITION OF PSP FOR COIL I */
for (ic = 1; ic <= 3; ++ic) {
t_ih__[ic + 4] = cos(hdir2 + (ic - 1) * 2.f *
3.1415926535897932384626433832795f / 3.f) * hrad /
c_ih__[ic]
/ 1.5f;
}
t_ih__[8] = *hz / c_ih__[4];
/* ----------------------------------------------------------------------- */
L999:
return 0;
} /* helm_case__ */
/* Subroutine */ int flip_case__(integer * if1, integer * if2,
real * t_ih__,
real * f1v, real * f1h, real * f2v,
real * f2h, real * aki, real * akf,
integer * ier)
{
/* ----------------------------------------------------------------------- */
/* DEAL WITH FLIPPER COIL CALCULATIONS */
/* CALCULATE P_IF CURRENTS FOR THE TWO FLIPPERS */
/* ----------------------------------------------------------------------- */
/* PASSED PARAMETERS */
/* ----------------------------------------------------------------------- */
/* INIT AND TEST */
/* Parameter adjustments */
--t_ih__;
/* Function Body */
*ier = 0;
/* ----------------------------------------------------------------------- */
if (*if1 == 1) {
t_ih__[1] = *f1v;
t_ih__[2] = *aki * *f1h;
} else {
t_ih__[1] = 0.f;
t_ih__[2] = 0.f;
}
if (*if2 == 1) {
t_ih__[3] = *f2v;
t_ih__[4] = *akf * *f2h;
} else {
t_ih__[3] = 0.f;
t_ih__[4] = 0.f;
}
/* ----------------------------------------------------------------------- */
/* L999: */
return 0;
} /* flip_case__ */