diff --git a/difrac.c b/difrac.c deleted file mode 100644 index 8b3213fd..00000000 --- a/difrac.c +++ /dev/null @@ -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 -#include -#include -#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; -} diff --git a/difrac.h b/difrac.h deleted file mode 100644 index 35ef1515..00000000 --- a/difrac.h +++ /dev/null @@ -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 diff --git a/ecbcounter.c b/ecbcounter.c deleted file mode 100644 index e616c4d6..00000000 --- a/ecbcounter.c +++ /dev/null @@ -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 -#include -#include -#include -#include -#include -#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; -} diff --git a/ecbcounter.h b/ecbcounter.h deleted file mode 100644 index cbfad223..00000000 --- a/ecbcounter.h +++ /dev/null @@ -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 diff --git a/tacov.c b/tacov.c deleted file mode 100644 index e0126ffd..00000000 --- a/tacov.c +++ /dev/null @@ -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__ */