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

- Added back calculation from motor positions to Q/E variables into

Browse Source 
TAS code.
- Fixed communication problems in SerPortServer, mainly with terminator
  detection.
- Added SPS switched motors for TOPSI
- Debugged Power-PC histogram memory software for TRICS
This commit is contained in:
cvs
2001-05-18 14:12:32 +00:00
parent 8b4a022881
commit 2d16479717
31 changed files with 1951 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -47,7 +47,7 @@ SOBJ = network.o ifile.o conman.o SCinter.o splitter.o passwd.o \
hklscan.o xytable.o amor2t.o nxamor.o amorscan.o amorstat.o \
circular.o el755driv.o maximize.o sicscron.o tecsdriv.o sanscook.o \
tasinit.o tasutil.o t_rlp.o t_conv.o d_sign.o d_mod.o \
tasdrive.o tasscan.o synchronize.o definealias.o
tasdrive.o tasscan.o synchronize.o definealias.o swmotor.o t_update.o
MOTOROBJ = motor.o el734driv.o simdriv.o el734dc.o pipiezo.o pimotor.o
COUNTEROBJ = countdriv.o simcter.o counter.o

1
conman.c
View File

@ -918,6 +918,7 @@ extern pServer pServ;
}
pBuf = (char *)malloc((iDataLen + iDataLen/10 + 50)*sizeof(char));
memset(pBuf,0,(iDataLen + iDataLen/10 + 50)*sizeof(char) );
compStream.next_in = (Bytef *)pData;
compStream.next_out = (Bytef *)pBuf;
compStream.avail_in = iDataLen;

2
danu.dat
View File

@ -1,3 +1,3 @@
7674
7740
NEVER, EVER modify or delete this file
You'll risk eternal damnation and a reincarnation as a cockroach!|n

6
el734driv.c
View File

@ -124,7 +124,7 @@
EL734Error2Text converts between an EL734 error code to text
-----------------------------------------------------------------------------*/
/* extern char EL734_IllgText[256]; */
extern char EL734_IllgText[256];
static void EL734Error2Text(char *pBuffer, int iErr)
{
@ -154,9 +154,9 @@
break;
case EL734__BAD_ILLG:
strcat(pBuffer,"EL734__BAD_ILLG ");
/*
strcat(pBuffer,EL734_IllgText);
*/
break;
case EL734__BAD_LOC:
strcat(pBuffer,"EL734__BAD_LOC");

2
hardsup/el734_utility.c
View File

@ -1899,7 +1899,7 @@
rply_ptr0 = AsynSrv_GetReply (
&info_ptr->asyn_info, &info_ptr->from_host, NULL);
if (rply_ptr0 == NULL) rply_ptr0 = "?no_response";
if (*rply_ptr0 == '\0') {
if (*rply_ptr0 == '\0' || *rply_ptr0 == '\r' ) {
/*
** The command was accepted - so zero the statistics
** fields in the handle and return to caller.

16
hardsup/el737_utility.c
View File

@ -805,7 +805,7 @@
if (rply_ptr0 == NULL) rply_ptr0 = "?";
if (rply_ptr1 == NULL) rply_ptr1 = "?";
if ((*rply_ptr0 == '\0') &&
if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) &&
(sscanf (rply_ptr1, "%d", status) == 1)) {
if (EL737_errcode != 0) return False;
EL737_call_depth--;
@ -851,7 +851,7 @@
rply_ptr0 = AsynSrv_GetReply (
&info_ptr->asyn_info, &info_ptr->from_host, NULL);
if (rply_ptr0 == NULL) rply_ptr0 = "?";
if (*rply_ptr0 == '\0') {
if ( (*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) {
EL737_call_depth--;
return True;
}
@ -1343,7 +1343,7 @@
if (rply_ptr0 == NULL) rply_ptr0 = "?";
if (rply_ptr1 == NULL) rply_ptr1 = "?";
if ((*rply_ptr0 == '\0') &&
if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) &&
(sscanf (rply_ptr1, "%d", status) == 1)) {
if (EL737_errcode != 0) return False;
EL737_call_depth--;
@ -1472,7 +1472,7 @@
rply_ptr0 = AsynSrv_GetReply (
&info_ptr->asyn_info, &info_ptr->from_host, NULL);
if (rply_ptr0 == NULL) rply_ptr0 = "?";
if (*rply_ptr0 == '\0') {
if ( (*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) {
if (val >= 0) return EL737_EnableThresh (handle, indx);
EL737_call_depth--;
return True;
@ -1519,7 +1519,7 @@
if (rply_ptr0 == NULL) rply_ptr0 = "?";
if (rply_ptr1 == NULL) rply_ptr1 = "?";
if ((*rply_ptr0 == '\0') &&
if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) &&
(sscanf (rply_ptr1, "%d", status) == 1)) {
if (EL737_errcode != 0) return False;
EL737_call_depth--;
@ -1569,7 +1569,7 @@
if (rply_ptr0 == NULL) rply_ptr0 = "?";
if (rply_ptr1 == NULL) rply_ptr1 = "?";
if ((*rply_ptr0 == '\0') &&
if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == 'r') ) &&
(sscanf (rply_ptr1, "%d", status) == 1)) {
if (EL737_errcode != 0) return False;
EL737_call_depth--;
@ -1635,7 +1635,7 @@
info_ptr->c5 = info_ptr->c6 = info_ptr->c7 = info_ptr->c8 = 0;
nvals = 9;
}
if ((*rply_ptr0 == '\0') &&
if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') )&&
(sscanf (rply_ptr1, "%d", rs) == 1) &&
(nvals == 9)) {
if (EL737_errcode != 0) return False;
@ -1682,7 +1682,7 @@
if (rply_ptr0 == NULL) rply_ptr0 = "?";
if (*rply_ptr0 == '\0') {
if ( (*rply_ptr0 == '\0' || (*rply_ptr0 == '\r') ) ) {
if (EL737_errcode != 0) return False;
EL737_call_depth--;
return True;

8
matrix/Makefile
View File

@ -8,12 +8,12 @@ OBJ= matadd.o matcreat.o matdet.o matdump.o matdurbn.o materr.o \
mattran.o
#---------- for Redhat linux
CC= gcc
CFLAGS= -I/usr/local/include -I. -I../ -DLINUX -g -c
#CC= gcc
#CFLAGS= -I/usr/local/include -I. -I../ -DLINUX -g -c
#------------ for DigitalUnix
#CC=cc
#CFLAGS= -I/data/koenneck/include -I. -I../ -std1 -g -c
CC=cc
CFLAGS= -I/data/koenneck/include -I. -I../ -std1 -g -c
#------------ for DigitalUnix with Fortify
#CFLAGS= -I/data/koenneck/include -DFORTIFY -I. -I../ -std1 -g -c

9
motor.c
View File

@ -967,7 +967,7 @@ extern MotorDriver *MakePiPiezo(Tcl_Interp *pTcl, char *pArray);
return 1;
}
/* ----------------- some private functions used in MotorAction -------------*/
static void MotorListLL(pMotor self, SConnection *pCon)
void MotorListLL(pMotor self, SConnection *pCon)
{
char pBueffel[512];
int i, iLen;
@ -988,7 +988,7 @@ extern MotorDriver *MakePiPiezo(Tcl_Interp *pTcl, char *pArray);
}
/*--------------------------------------------------------------------------*/
static void MotorReset(pMotor pM)
void MotorReset(pMotor pM)
{
ObParInit(pM->ParArray,SLOW,"softlowerlim",pM->pDriver->fLower,usUser);
ObParInit(pM->ParArray,SUPP,"softupperlim",pM->pDriver->fUpper,usUser);
@ -1215,3 +1215,8 @@ extern MotorDriver *MakePiPiezo(Tcl_Interp *pTcl, char *pArray);
return 0;
}

2
nxutil.c
View File

@ -250,7 +250,7 @@
}
else
{
/* it can still be a simpel variable */
/* it can still be a simple variable */
pVar = (pSicsVariable)pCom->pData;
fMean = pVar->fVal;
}

3
ofac.c
View File

@ -105,6 +105,7 @@
#include "tas.h"
#include "synchronize.h"
#include "definealias.h"
#include "swmotor.h"
/*----------------------- Server options creation -------------------------*/
static int IFServerOption(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[])
@ -282,6 +283,7 @@
AddCommand(pInter,"MakeLin2Ang",MakeLin2Ang,NULL,NULL);
AddCommand(pInter,"MakeTAS",TASFactory,NULL,NULL);
AddCommand(pInter,"MakeSync",MakeSync,NULL,NULL);
AddCommand(pInter,"MakeSWMotor",MakeSWMotor,NULL,NULL);
}
/*---------------------------------------------------------------------------*/
static void KillIniCommands(SicsInterp *pSics)
@ -336,6 +338,7 @@
RemoveCommand(pSics,"MakeLin2Ang");
RemoveCommand(pSics,"MakeTAS");
RemoveCommand(pSics,"MakeSync");
RemoveCommand(pSics,"MakeSWMotor");
}

6
sinqhm/SinqHM_bootParamsConfig.c
View File

@ -368,13 +368,13 @@
sbpc_showHelp (errmsg);
return False;
} /* xOff*/
if ((sscanf (p_arg2, "%i", &xOff) != 1) || (xOff <= 0)) {
if ((sscanf (p_arg2, "%i", &xOff) != 1)) {
sprintf (errmsg, "The value for <#-xOff>, \"%s\", is illegal!\n"
"It must be a positive integer.", p_arg1);
sbpc_showHelp (errmsg);
return False;
} /* xFac */
if ((sscanf (p_arg3, "%i", &xFac) != 1) || (xFac <= 0)) {
if ((sscanf (p_arg3, "%i", &xFac) != 1)|| xFac <= 0) {
sprintf (errmsg, "The value for <#-xFac>, \"%s\", is illegal!\n"
"It must be a positive integer.", p_arg1);
sbpc_showHelp (errmsg);
@ -387,7 +387,7 @@
sbpc_showHelp (errmsg);
return False;
} /* yOff*/
if ((sscanf (p_arg5, "%i", &yOff) != 1) || (yOff <= 0)) {
if ((sscanf (p_arg5, "%i", &yOff) != 1)) {
sprintf (errmsg, "The value for <#-yOff>, \"%s\", is illegal!\n"
"It must be a positive integer.", p_arg1);
sbpc_showHelp (errmsg);

4
sinqhm/SinqHM_def.h
View File

@ -214,11 +214,13 @@
#define LWL_TOF_C9 (0x09000000) /* TOF-Mode 9 chan dgrm hdr */
#define LWL_PSD_TSI 0x0E000000 /* PSD-Mode TSI datagram */
#define LWL_PSD_DATA 0x13000000 /* PSD-mode data datagram */
#define LWL_PSD_DATA 0x12000000 /* PSD-mode data datagram */
#define LWL_PSD_PWF 0x20000000 /* PSD-mode Power Fail bit */
#define LWL_PSD_TIME 0x000fffff /* PSD-mode time stamp extraction
mask */
#define LWL_PSD_FLASH_MASK 0x00ff /* mask for flash count */
#define LWL_PSD_XORF 0x2000 /* mask for TDC-XORF bit */
#define LWL_PSD_CONF 0x0100 /* mask for TDC-CONF flag */
#define LWL_SM_NC (0x10000000) /* Strobo-Mode/No-Coinc 0 chan dgrm hdr */
#define LWL_SM_NC_C1 (0x11000000) /* Strobo-Mode/No-Coinc 1 chan dgrm hdr */

3
sinqhm/SinqHM_gbl.h
View File

@ -185,7 +185,8 @@
int psdFlashCount;
int psdHitCount;
int psdXSize;
int psdYSize;
int psdYSize;
int psdXORF, psdConf;
/*========================== Define the function prototypes ================*/
void catch_int_signal (

34
sinqhm/SinqHM_srv_filler.c
View File

@ -167,13 +167,16 @@
if (lwl_hdr.ui4 == LWL_FIFO_EMPTY) {
taskDelay (0); /* If FIFO is empty, we can take a breather! */
}else if ((lwl_hdr.ui4 & LWL_HDR_TYPE_MASK) == LWL_HM_NC_C1) {
/* Histo data, single channel */
VmioBase[VMIO_PORT_A] = 0xff; /* Set timer level (if present) */
for (i=0; i<1000; i++) {
for (i=0; i<1000000; i++) {
lwl_data.ui4 = *Lwl_fifo; /* Get the 16 bits of data */
if (lwl_data.ui4 != LWL_FIFO_EMPTY) break;
taskDelay (0); /* But wait if FIFO is slow! */
if (lwl_data.ui4 != LWL_FIFO_EMPTY) {
break;
}
taskDelay (0); /* But wait if FIFO is slow! */
}
if (lwl_data.ui4 == LWL_FIFO_EMPTY) {
printf ("Time-out getting histogram data word! Event # = %d\n",
N_events);
@ -239,20 +242,24 @@
VmioBase[VMIO_PORT_A] = 0x00; /* Reset timer level (if present) */
N_events++;
}else if ((lwl_hdr.ui4 & LWL_HDR_TYPE_MASK) == LWL_TSI_HM_NC) {
process_no_coinc_tsi (lwl_hdr.ui4); /* We have found a "normal"
** TSI (Timing-Status-Info) header. Process
** it.
*/
}else if ((lwl_hdr.ui4 & LWL_HDR_TYPE_MASK) == LWL_TSI_HM_C) {
process_coinc_tsi (lwl_hdr.ui4); /* We have found a "coincidence"
** type TSI header. The packet has 10 bytes
** altogether. Process it.
*/
}else { /* Anything else gets flushed */
lwl_Packet_Read (lwl_hdr.ui4, my_buff);
}
if (FillTimer_expired) {
/* if (FillTimer_expired) { */
if (0) {
if (Print_hdr) printf ("\nTaking data in Digitised Histogramming Mode\n"
" #-Events #-Skip #-TSI Dead-Time Sync-Status\n");
Print_hdr = False;
@ -711,7 +718,7 @@
*/
void SinqHM_filler_daq_psd () {
/* =====================
** Routine to handle Time-of-flight Mode
** Routine to handle PSD-TOF Mode
** Note:
** Lwl_fifo could, in principle, be accessed via a register for better
** efficiency. However, this can cause trouble with the GDB debugger
@ -727,6 +734,7 @@
} lwl_hdr, xData, yData;
int xPos, yPos, iTime, dataPos;
signed int sPosx, sPosy;
int i, j, is, ts, left, right, middl, not_finished;
uint *edge_pntr;
char er_eol[] = {ESC, '[', '0', 'J'}; /* Erase to End-of-Line */
@ -793,8 +801,16 @@
/*
We have a valid PSD packet. Find and check positions.
*/
xPos = (xData.ui2[1] - psdXOffset)/psdXFactor;
yPos = (yData.ui2[1] - psdYOffset)/psdYFactor;
xPos = xData.ui2[1];
if(xPos >= 32767)
xPos -= 65536;
yPos = yData.ui2[1];
if(yPos >= 32767)
yPos -= 65536;
xPos = (xPos + psdXOffset)/psdXFactor;
yPos = (yPos + psdYOffset)/psdYFactor;
if(xPos < 0 || xPos > psdXSize)
{
printf("X position out of range: %d, alllowed 0 - %d\n",
@ -896,6 +912,8 @@
if ((Tsi_flags & STATUS_FLAGS__SYNC0) != 0) printf (" SYNC0");
if ((Tsi_flags & STATUS_FLAGS__UD) != 0) printf (" UD");
if ((Tsi_flags & STATUS_FLAGS__GU) != 0) printf (" GU");
if(psdXORF) printf(" XORF");
if(psdConf) printf(" CONF");
is = timer_settime (FillTimerId, ~TIMER_ABSTIME, &FillerTime, NULL);
if (is != 0) {

19
sinqhm/SinqHM_srv_routines.c
View File

@ -3469,7 +3469,9 @@
for (j=0; j<3; j++) { /* Get the remaining 6 bytes */
for (i=0; i<1000; i++) {
lwl_data.ui4 = *Lwl_fifo; /* Get the last 16 bits */
if (lwl_data.ui4 != LWL_FIFO_EMPTY) break;
if (lwl_data.ui4 != LWL_FIFO_EMPTY) {
break;
}
taskDelay (0); /* But wait if FIFO is slow! */
}
if (lwl_data.ui4 == LWL_FIFO_EMPTY) {
@ -3533,6 +3535,7 @@
}
words[j] = lwl_data.ui2[1];
}
/* printf(" %X %X %X\n", words[0], words[1], words[2]); */
N_coin_tsi++;
Dt_or_dts.both = hdr & LWL_TSI_DT_MSK;
@ -3554,6 +3557,16 @@
*/
psdHitCount += words[1];
psdFlashCount += words[2] & LWL_PSD_FLASH_MASK;
if((words[2] & LWL_PSD_XORF) != 0) {
psdXORF = 1;
}else {
psdXORF = 0;
}
if((words[2] & LWL_PSD_CONF) != 0) {
psdConf = 0;
}else {
psdConf = 1;
}
}
/*
@ -3575,7 +3588,9 @@
for (i=0; i<1000; i++) {
lwl_data.ui4 = *Lwl_fifo; /* Get the last 16 bits */
if (lwl_data.ui4 != LWL_FIFO_EMPTY) break;
if (lwl_data.ui4 != LWL_FIFO_EMPTY) {
break;
}
taskDelay (0); /* But wait if FIFO is slow! */
}
if (lwl_data.ui4 == LWL_FIFO_EMPTY) {

1
sinqhm/lwl_client.c
View File

@ -360,6 +360,7 @@
printf ("\nCycle %5d", i+1);
for (j = 0; j < nrec; j++) {
status = send (Cnct_skt, p_recs[j], (*p_recs[j])+1, 0);
sleep(2);
}
}
printf ("\nDone.\n");

5
sinqhmdriv.c
View File

@ -568,15 +568,16 @@
{
return HWPause;
}
/*
else if(iDaq == 1)
{
status = HWBusy;
}
}
*/
else if(iDaq == 0)
{
status = HWIdle;
}
return status;
}

97
switchedmotor.w Normal file
View File

@ -0,0 +1,97 @@
\subsection{Switched Motors}
At TOPSI there is a set of motors which share a single EL734 motor slot. Which
motor is adressed is switched via a SPS. The idea was to save money but really
this is a pain in the ass. Especially as the motors do not have own encoders.
This module implements sofwtare support for this setup. Virtual motors are
defined for the slave motors. The algorithm implemented works as follows:
There is always an active motor which is currently adressed. When
{\bf reading } the motor either a stored value is returned (when the
motor is not adressed) or the real value is read from the motor. When
driving a motor the following things happen:
\begin{itemize}
\item If the motor is active the motor is directly driven.
\item If the motor is not active:
\begin{itemize}
\item The correct motor is switched to in the SPS.
\item A reference run is made.
\item The motor is finally driven.
\end{itemize}
\end{itemize}
In order to do all this we need yet another data structure:
@d swdata @{
typedef struct __SWMOT {
pObjectDescriptor pDes;
pIDrivable pDriv;
pMotor pMaster;
int *selectedMotor;
int myNumber;
float positions[3];
char slaves[3][80];
char *switchFunc;
int errCode;
} SWmot, *pSWmot;
@}
The fields are:
\begin{description}
\item[pDes] The standard SICS object descriptor.
\item[pDriv] The drivable interface.
\item[pMaster] The EL734 motor used as the master motor for driving
the slaves.
\item[myNumber] The number of the motor implemented by this object.
\item[selectedMotor] The number of the selected motor. This must be a
pointer in order to be shared among multiple copies of this.
\item[slaves] The names of the slave motors.
\item[switchFunc] is the name of a interpreter function which does
the switching to another motor. Usually this will be implemented in
Tcl. This gives some level of portability to other setups. The syntax
shall be : status = switchFun motNumber. status will either hold OK on
return or the error encountered.
\item[errCode] is an internal error code.
\end{description}
Of course there will be three copies of this structure for the three
slave motors.
Most feautures of this module will be implemented in the functions of
the drivable interface or internal functions. The only additional
functions needed provide the interface for the interpreter:
@d swint @{
int MakeSWMotor(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
int SWMotorAction(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
@}
@o swmotor.h @{
/*----------------------------------------------------------------------
TOPSI switched motors. Three motors share a EL734 motor. Between is
switched through a SPS.
Mark Koennecke, May 2001
-----------------------------------------------------------------------*/
#ifndef SWMOTOR
#define SWMOTOR
#include "obdes.h"
#include "interface.h"
#include "motor.h"
@<swint@>
#endif
@}
@o swmotor.i @{
/* ----------------------------------------------------------------------
Internal data structure for the switched motor module. For
documentation see swmotor.tex.
Mark Koennecke, May 2001
----------------------------------------------------------------------*/
@<swdata@>
@}

547
swmotor.c Normal file
View File

@ -0,0 +1,547 @@
/*--------------------------------------------------------------------------
TOPSI switched motors implementation module. Three motors share a common
EL734 motor. The actual motor is selected through a SPS. More information in
file switchedmotor.tex or with Jochen Stahn.
copyright: see file copyright.h
Mark Koennecke, May 2001
--------------------------------------------------------------------------*/
#include <stdlib.h>
#include <assert.h>
#include <stdio.h>
#include <tcl.h>
#include "fortify.h"
#include "sics.h"
#include "SCinter.h"
#include "splitter.h"
#include "hardsup/sinq_prototypes.h"
#include "hardsup/rs232c_def.h"
#include "hardsup/el734_def.h"
#include "hardsup/el734fix.h"
#include "modriv.h"
#include "swmotor.h"
#include "swmotor.i"
/*========================================================================
We start of by implementing the interface functions for the various
interfaces this module has to implement.
==========================================================================*/
static int SWHalt(void *pData)
{
pSWmot self = (pSWmot)pData;
assert(self);
return self->pMaster->pDrivInt->Halt(self->pMaster);
}
/*--------------------------------------------------------------------*/
static int SWCheckLimits(void *pData, float fVal, char *error, int iErrLen)
{
pSWmot self = (pSWmot)pData;
assert(self);
return self->pMaster->pDrivInt->CheckLimits(self->pMaster,
fVal,error,iErrLen);
}
/*--------------------------------------------------------------------*/
static int SWCheckStatus(void *pData, SConnection *pCon)
{
pSWmot self = (pSWmot)pData;
assert(self);
return self->pMaster->pDrivInt->CheckStatus(self->pMaster,
pCon);
}
/*---------------------------------------------------------------------*/
static int SWSaveStatus(void *pData, char *name, FILE *fd)
{
pSWmot self = (pSWmot)pData;
assert(self);
fprintf(fd,"%s savedValue = %f\n", name,
self->positions[self->myNumber]);
return 1;
}
/*-----------------------------------------------------------------------*/
static void *SWGetInterface(void *pData, int ID)
{
pSWmot self = (pSWmot)pData;
assert(self);
if(ID == DRIVEID)
{
return self->pDriv;
}
return NULL;
}
/*----------------------------------------------------------------------*/
static float SWGetValue(void *pData, SConnection *pCon)
{
pSWmot self = (pSWmot)pData;
float fVal;
assert(self);
/*
we are not selected: return stored data:
*/
if(self->myNumber != self->selectedMotor[0])
{
SCWrite(pCon,"WARNING: motor not activem returning stored value",
eWarning);
return self->positions[self->myNumber];
}
else
{
fVal = self->pMaster->pDrivInt->GetValue(self->pMaster, pCon);
self->positions[self->myNumber] = fVal;
return fVal;
}
}
/*-----------------------------------------------------------------------*/
static long SWSetValue(void *pData, SConnection *pCon, float fVal)
{
pSWmot self = (pSWmot)pData;
char pCommand[256], pError[132];
int status;
EL734Driv *pElli;
Tcl_Interp *pTcl;
assert(self);
self->errCode = 1;
/*
first case: we are already selected
*/
if(self->myNumber == self->selectedMotor[0])
{
return self->pMaster->pDrivInt->SetValue(self->pMaster,pCon,fVal);
}
else
{
/*
second case: switch to the requested motor, do a reference run
and then execute Set command
*/
sprintf(pCommand,"Switching to motor number %d", self->myNumber);
SCWrite(pCon,pCommand,eWarning);
sprintf(pCommand,"%s %d",self->switchFunc, self->myNumber);
pTcl = (Tcl_Interp *)pServ->pSics->pTcl;
status = Tcl_Eval(pTcl,pCommand);
strncpy(pError,pTcl->result, 131);
if(status != TCL_OK || strstr(pError,"OK") == NULL)
{
sprintf(pCommand,"ERROR: %s while switching motor", pError);
SCWrite(pCon,pCommand, eError);
self->errCode = -1001;
return HWFault;
}
self->selectedMotor[0] = self->myNumber;
/*
switch done! Start a reference run
*/
SicsWait(10);
SCWrite(pCon,"Standby, starting reference run... ", eWarning);
pElli = (EL734Driv *)self->pMaster->pDriver;
sprintf(pCommand,"R %d\r",pElli->iMotor);
status = EL734_SendCmnd(&(pElli->EL734struct),
pCommand,
pError, 131);
if(status != 1)
{
sprintf(pCommand,"ERROR: %s while trying to start reference run",
pError);
SCWrite(pCon,pCommand,eError);
self->errCode = -1002;
return HWFault;
}
/*
now loop forever until reference run is done. This is either when the
motors stops being busy or when the user interrupts.
*/
sprintf(pCommand,"SS %d\r",pElli->iMotor);
for( ; ;)
{
status = EL734_SendCmnd(&(pElli->EL734struct),
pCommand,
pError, 131);
if(status != 1)
{
sprintf(pCommand,"ERROR: %s during reference run",
pError);
SCWrite(pCon,pCommand,eError);
self->errCode = -1003;
return HWFault;
}
if(strstr(pError,"?BSY") == NULL)
break;
if(SCGetInterrupt(pCon) != eContinue)
{
self->errCode = -1004;
SCWrite(pCon,"ERROR: user interrupted reference run",eError);
return HWFault;
}
SicsWait(2);
}
/*
now this is finished. We can really start driving the motor
*/
SCWrite(pCon,"Reference run completed, starting to drive motor..",
eWarning);
return self->pMaster->pDrivInt->SetValue(self->pMaster,pCon,fVal);
}
}
/*----------------------------------------------------------------------*/
static void KillSWFull(void *pData)
{
pSWmot self = (pSWmot)pData;
if(self == NULL)
return;
if(self->pDriv)
free(self->pDriv);
if(self->pDes)
DeleteDescriptor(self->pDes);
if(self->selectedMotor)
free(self->selectedMotor);
if(self->switchFunc)
free(self->switchFunc);
free(self);
}
/*---------------------------------------------------------------------*/
static void KillSWHalf(void *pData)
{
pSWmot self = (pSWmot)pData;
if(self)
free(self);
}
/*----------------------------------------------------------------------
Alright, now the interpreter functions follow
Usage:
MakeSWMotor master switchFunc slave1 slave2 slave3
-----------------------------------------------------------------------*/
int MakeSWMotor(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[])
{
pSWmot sw1, sw2, sw3;
char pBueffel[256];
int i, status;
/*
check that we have enough arguments
*/
if(argc < 6)
{
SCWrite(pCon,"ERROR: insufficient number of arguments to MakeSWMotor",
eError);
return 0;
}
/*
allocate a new data structure
*/
sw1 = (pSWmot)malloc(sizeof(SWmot));
if(sw1 == NULL)
{
SCWrite(pCon,"ERROR: out of memory in MakeSWMotor",eError);
return 0;
}
memset(sw1,0,sizeof(SWmot));
/*
fill it up with stuff
*/
sw1->pDes = CreateDescriptor("Sparbroetchen");
sw1->pDriv = CreateDrivableInterface();
sw1->selectedMotor = (int *)malloc(sizeof(int));
if(!sw1->pDes || ! sw1->pDriv || !sw1->selectedMotor)
{
SCWrite(pCon,"ERROR: out of memory in MakeSWMotor",eError);
return 0;
}
sw1->selectedMotor[0] = -1;
sw1->pMaster = FindMotor(pSics,argv[1]);
if(!sw1->pMaster)
{
sprintf(pBueffel,"ERROR: cannot find master motor %s", argv[1]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
sw1->switchFunc = strdup(argv[2]);
for(i = 0; i < 3; i++)
{
strcpy(sw1->slaves[i],argv[3+i]);
}
/*
initialize function pointers
*/
sw1->pDes->SaveStatus = SWSaveStatus;
sw1->pDes->GetInterface = SWGetInterface;
sw1->pDriv->GetValue = SWGetValue;
sw1->pDriv->SetValue = SWSetValue;
sw1->pDriv->Halt = SWHalt;
sw1->pDriv->CheckStatus = SWCheckStatus;
sw1->pDriv->CheckLimits = SWCheckLimits;
/*
create clones of the new data structure ofr the other slaves
*/
sw2 = (pSWmot)malloc(sizeof(SWmot));
sw3 = (pSWmot)malloc(sizeof(SWmot));
if(!sw2 || !sw2)
{
SCWrite(pCon,"ERROR: out of memory in MakeSWMotor",eError);
return 0;
}
memcpy(sw2,sw1,sizeof(SWmot));
sw2->myNumber = 1;
memcpy(sw3,sw1,sizeof(SWmot));
sw3->myNumber = 2;
/*
install commands
*/
status = AddCommand(pSics, argv[3], SWMotorAction, KillSWFull, sw1);
if(!status)
{
sprintf(pBueffel,"ERROR: command %s already exists!",argv[3]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
status = AddCommand(pSics, argv[4], SWMotorAction, KillSWHalf, sw2);
if(!status)
{
sprintf(pBueffel,"ERROR: command %s already exists!",argv[4]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
status = AddCommand(pSics, argv[5], SWMotorAction, KillSWHalf, sw3);
if(!status)
{
sprintf(pBueffel,"ERROR: command %s already exists!",argv[3]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
return 1;
}
/*-------------------------------------------------------------------
some prototypes from functions implemented in motor.c
--------------------------------------------------------------------*/
void MotorListLL(pMotor self, SConnection *pCon);
void MotorReset(pMotor pM);
/*---------------------------------------------------------------------*/
int SWMotorAction(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[])
{
char pBueffel[512];
TokenList *pList = NULL;
TokenList *pCurrent;
TokenList *pName;
int iRet;
pSWmot self = NULL;
float fValue;
long lID;
assert(pCon);
assert(pSics);
assert(pData);
self = (pSWmot)pData;
/* create Tokenlist */
argtolower(argc,argv);
pList = SplitArguments(argc,argv);
if(!pList)
{
SCWrite(pCon,"Error parsing argument list in SWMotorAction",eError);
return 0;
}
/* first argument can be one of list, reset or parameter name */
pCurrent = pList->pNext;
if(!pCurrent) /* no argument, print value */
{
fValue = self->pDriv->GetValue(self,pCon);
if(fValue < -990.)
{
sprintf(pBueffel,"Error obtaining position for %s",argv[0]);
SCWrite(pCon,pBueffel,eValue);
DeleteTokenList(pList);
return 0;
}
sprintf(pBueffel,"%s = %f",argv[0],fValue);
SCWrite(pCon,pBueffel,eValue);
DeleteTokenList(pList);
return 1;
}
/* check for list */
if(strcmp(pCurrent->text,"list") == 0)
{
MotorListLL(self->pMaster,pCon);
DeleteTokenList(pList);
return 1;
} /* check for reset */
else if(strcmp(pCurrent->text,"reset") == 0)
{
if(!SCMatchRights(pCon,usUser))
{
sprintf(pBueffel,"Insufficient privilege to reset %s",
argv[0]);
SCWrite(pCon,pBueffel,eError);
DeleteTokenList(pList);
return 0;
}
MotorReset(self->pMaster);
DeleteTokenList(pList);
SCSendOK(pCon);
return 1;
}
else if(strcmp(pCurrent->text,"savedValue") == 0)
{
pCurrent = pCurrent->pNext;
if(!pCurrent)
{
/*
print Value
*/
sprintf(pBueffel,"%s.savedValue = %f", argv[0],
self->positions[self->myNumber]);
SCWrite(pCon,pBueffel,eValue);
DeleteTokenList(pList);
return 1;
}
else
{
/*
set saveValue, must be a numeric parameter
*/
if(pCurrent->Type == eInt)
{
fValue = (float)pCurrent->iVal;
}
else if(pCurrent->Type == eFloat)
{
fValue = pCurrent->fVal;
}
else
{
sprintf(pBueffel,"Wrong argument type for %s %s ",
argv[0],"saveValue");
SCWrite(pCon,pBueffel,eError);
DeleteTokenList(pList);
return 0;
}
self->positions[self->myNumber] = fValue;
SCSendOK(pCon);
return 1;
}
}
else if(strcmp(pCurrent->text,"selected") == 0)
{
pCurrent = pCurrent->pNext;
if(!pCurrent)
{
/*
print Value
*/
sprintf(pBueffel,"%s.selected = %d", argv[0],
self->selectedMotor[0]);
SCWrite(pCon,pBueffel,eValue);
DeleteTokenList(pList);
return 1;
}
else
{
/*
set selected, must be a numeric parameter
*/
if(pCurrent->Type == eInt)
{
fValue = (float)pCurrent->iVal;
}
else if(pCurrent->Type == eFloat)
{
fValue = pCurrent->fVal;
}
else
{
sprintf(pBueffel,"Wrong argument type for %s %s ",
argv[0],"selected");
SCWrite(pCon,pBueffel,eError);
DeleteTokenList(pList);
return 0;
}
self->selectedMotor[0] = (int)fValue;
SCSendOK(pCon);
return 1;
}
}
else /* one of the parameter commands or error left now */
{
pName = pCurrent;
pCurrent = pCurrent->pNext;
if(!pCurrent) /* no third par: print val */
{
/* deal with position first */
if(strcmp(pName->text,"position") == 0)
{
fValue = self->pDriv->GetValue(self,pCon);
if(fValue < 999.)
{
sprintf(pBueffel,"Error obtaining position for %s",argv[0]);
SCWrite(pCon,pBueffel,eValue);
DeleteTokenList(pList);
return 0;
}
sprintf(pBueffel,"%s.SoftPosition = %f",argv[0],fValue);
SCWrite(pCon,pBueffel,eValue);
DeleteTokenList(pList);
return 1;
}
iRet = MotorGetPar(self->pMaster,pName->text,&fValue);
if(!iRet)
{
sprintf(pBueffel,"Parameter %s not found ",pName->text);
SCWrite(pCon,pBueffel,eValue);
DeleteTokenList(pList);
return 0;
}
else
{
sprintf(pBueffel, " %s.%s = %f",argv[0],pName->text,fValue);
SCWrite(pCon,pBueffel,eValue);
DeleteTokenList(pList);
return 1;
}
}
else /* set */
{ /* set command */
/* parameter must be numerical value */
if(pCurrent->Type == eInt)
{
fValue = (float)pCurrent->iVal;
}
else if(pCurrent->Type == eFloat)
{
fValue = pCurrent->fVal;
}
else
{
sprintf(pBueffel,"Wrong argument type for %s %s set",
argv[0],pName->text);
SCWrite(pCon,pBueffel,eError);
DeleteTokenList(pList);
return 0;
}
iRet = MotorSetPar(self->pMaster,pCon,pName->text,fValue);
DeleteTokenList(pList);
if(iRet)
SCSendOK(pCon);
return iRet;
}
}
return 0;
}

20
swmotor.h Normal file
View File

@ -0,0 +1,20 @@
/*----------------------------------------------------------------------
TOPSI switched motors. Three motors share a EL734 motor. Between is
switched through a SPS.
Mark Koennecke, May 2001
-----------------------------------------------------------------------*/
#ifndef SWMOTOR
#define SWMOTOR
#include "obdes.h"
#include "interface.h"
#include "motor.h"
int MakeSWMotor(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
int SWMotorAction(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
#endif

21
swmotor.i Normal file
View File

@ -0,0 +1,21 @@
/* ----------------------------------------------------------------------
Internal data structure for the switched motor module. For
documentation see swmotor.tex.
Mark Koennecke, May 2001
----------------------------------------------------------------------*/
typedef struct __SWMOT {
pObjectDescriptor pDes;
pIDrivable pDriv;
pMotor pMaster;
int *selectedMotor;
int myNumber;
float positions[3];
char slaves[3][80];
char *switchFunc;
int errCode;
} SWmot, *pSWmot;

489
t_update.c Normal file
View File

@ -0,0 +1,489 @@
/* t_update.f -- translated by f2c (version 20000817).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "f2c.h"
#include <math.h>
/* Subroutine */ int t_update__(real *p_a__, real *p_ih__, real *c_ih__,
logical *lpa, real *dm, real *da, integer *isa, real *helm, real *f1h,
real *f1v, real *f2h, real *f2v, real *f, real *ei, real *aki, real *
ef, real *akf, real *qhkl, real *en, real *hx, real *hy, real *hz,
integer *if1, integer *if2, real *qm, integer *ier)
{
static doublereal dakf, daki, dphi;
static integer ieri, imod, ieru;
extern /* Subroutine */ int ex_up__(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, integer *);
static doublereal df;
static integer id;
static real qs;
static doublereal dbqhkl[3];
extern /* Subroutine */ int sam_up__(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *);
static doublereal da2, da3, da4, da6;
extern /* Subroutine */ int erreso_(integer *, integer *);
static doublereal dda, def, dei, ddm, dqm, dhx, dhy, dhz, dqs;
extern /* Subroutine */ int helm_up__(doublereal *, real *, real *, real *
, doublereal *, doublereal *, doublereal *, integer *), flip_up__(
integer *, integer *, real *, real *, real *, real *, real *,
real *, real *, integer *);
/* =================== */
/* dec$ Ident 'V01C' */
/* ------------------------------------------------------------------ */
/* Note: */
/* IF1,If2 changed to Int*4. They were Real*4 in ILL version. */
/* ------------------------------------------------------------------ */
/* Updates: */
/* V01A 7-May-1996 DM. Put error output to IOLUN, use IMPLICIT NONE and */
/* get the code indented so that it is readable! */
/* V01C 12-Oct-1998 DM. Put in Mag Field calculation for SINQ Helmolz coils. */
/* ----------------------------------------------------------------------- */
/* Entry points in this file: */
/* T_UPDATE : USE THE MOTOR ANGLES TO CALCULATE VALUES OF */
/* EI,KI,EF,KF,QH,QK,QL,EN AND TO DETERMINE */
/* WHETHER FLIPPERS F1,F2 ARE 'ON' OR 'OFF'. */
/* EX_UP : CALCULATE EX AND AKX FORM AX2 VALUES. */
/* SAM_UP : CALCULATE THINGS IN RECIPROCICAL LATTICE. */
/* HELM_UP : CALCULATE HELMHOLTZ FIELDS. */
/* FLIP_UP : CHECK IF FLIPPERS ON OR OFF. */
/* ----------------------------------------------------------------------- */
/* T_UPDATE: */
/* ROUTINE TO USE THE MOTOR ANGLES TO */
/* CALCULATE VALUES OF EI,KI,EF,KF,QH,QK,QL,EN */
/* USE CURRENT-SUPPLY VALUES TO COMPUTE HELMHOLTZ FIELDS HX,HY,HZ */
/* AND TO DETERMINE WHETHER FLIPPERS F1,F2 ARE 'ON' OR 'OFF'. */
/* FLIPPERS ARE 'ON' ONLY IF CURRENTS ARE THOSE GIVEN BY */
/* F1V,F1H,F2V,F2H */
/* ----------------------------------------------------------------------- */
/* File [MAD.SRC]T_UPDATE.FOR */
/* cc IMPLICIT DOUBLE PRECISION (A-H,O-Z) */
/* include 'iolsddef.inc' */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* Input: */
/* Positions of angles A1-A6. */
/* .. helmotz (8 currents). */
/* Position of currents for flippers and .. */
/* Configuration of the machine ... */
/* Conversion factors for Helmotz (4 currents). */
/* True if machine in polarization mode. */
/* Monochr. d-spacing */
/* Analyser d-spacing */
/* .. +ve to the left. */
/* Scattering sense at analyser (probably) .. */
/* .. ki (probably). */
/* Angle between axis of Helmolz pair one and .. */
/* .. current is possibly ki*f1h ??) */
/* Flipper 1 hor and vert currents (hor .. */
/* .. current is possibly kf*f2h ??) */
/* Flipper 2 hor and vert currents (hor .. */
/* Output: */
/* Energy unit */
/* Incident neutron energy */
/* Incident neutron wave vector */
/* Final neutron energy */
/* Final neutron wave vector */
/* Components of q in reciprocal space */
/* Energy transfer */
/* Components of Helmolz field on sample */
/* Status of Flippers 1 and 2 */
/* Length of q */
/* ----------------------------------------------------------------------- */
/* Error status */
/* ----------------------------------------------------------------------- */
/* SET UP */
/* Parameter adjustments */
--qhkl;
--c_ih__;
--p_ih__;
--p_a__;
/* Function Body */
ddm = *dm;
dda = *da;
df = *f;
da2 = p_a__[2];
da3 = p_a__[3];
da4 = p_a__[4];
da6 = p_a__[6];
/* ----------------------------------------------------------------------- */
ieri = 0;
ieru = 1;
ex_up__(&ddm, &dei, &daki, &da2, &df, &ieri);
if (ieri == 0) {
*ei = dei;
*aki = daki;
ieru = 0;
} else {
imod = 3;
erreso_(&imod, &ieri);
}
ieri = 0;
ieru = 1;
ex_up__(&dda, &def, &dakf, &da6, &df, &ieri);
if (ieri == 0) {
*ef = def;
*akf = dakf;
ieru = 0;
} else {
if (*isa == 0) {
*ef = dei;
*akf = daki;
def = dei;
dakf = daki;
ieru = 0;
} else {
imod = 3;
erreso_(&imod, &ieri);
}
}
if (*isa == 0) {
*ef = dei;
*akf = daki;
def = dei;
dakf = daki;
ieru = 0;
}
if (ieru == 0) {
*en = dei - def;
}
ieri = 0;
ieru = 1;
sam_up__(dbqhkl, &dqm, &dqs, &dphi, &daki, &dakf, &da3, &da4, &ieri);
if (ieri == 0) {
for (id = 1; id <= 3; ++id) {
qhkl[id] = dbqhkl[id - 1];
}
*qm = dqm;
qs = dqs;
ieru = 0;
} else {
imod = 2;
erreso_(&imod, &ieri);
}
ieri = 0;
if (*lpa) {
ieru = 1;
helm_up__(&dphi, helm, &p_ih__[1], &c_ih__[1], &dhx, &dhy, &dhz, &
ieri);
if (ieri != 0) {
/* WRITE(6,*) 'ERROR IN HELM_UP CHECK COEFF' */
} else {
*hx = dhx;
*hy = dhy;
*hz = dhz;
ieru = 0;
}
flip_up__(if1, if2, &p_ih__[1], f1v, f1h, f2v, f2h, aki, akf, &ieri);
}
/* ----------------------------------------------------------------------- */
*ier = ieru;
return 0;
} /* t_update__ */
/* Subroutine */ int ex_up__(doublereal *dx, doublereal *ex, doublereal *akx,
doublereal *ax2, doublereal *f, integer *ier)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sin(doublereal);
/* Local variables */
static doublereal arg;
/* ================ */
/* ----------------------------------------------------------------------- */
/* CALCULATE EX AND AKX FORM AX2 VALUES */
/* ----------------------------------------------------------------------- */
/* Part of [MAD.SRC]T_UPDATE.FOR */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* Input: */
/* D-SPACING OF CRISTAL */
/* TAKE OFF ANGLE */
/* Output: */
/* ENERGY UNIT */
/* ENERGY */
/* MOMENTUM */
/* ----------------------------------------------------------------------- */
/* Error - IER=1 if DX OR AX TOO SMALL */
/* ----------------------------------------------------------------------- */
arg = *dx * sin(*ax2 / 114.59155902616465);
if(arg < .0)
arg = -arg;
if (arg <= 1e-4) {
*ier = 1;
} else {
*ier = 0;
*akx = 3.1415926535897932384626433832795 / arg;
/* Computing 2nd power */
d__1 = *akx;
*ex = *f * (d__1 * d__1);
}
/* ----------------------------------------------------------------------- */
return 0;
} /* ex_up__ */
/* Subroutine */ int sam_up__(doublereal *qhkl, doublereal *qm, doublereal *
qs, doublereal *phi, doublereal *aki, doublereal *akf, doublereal *a3,
doublereal *a4, integer *ier)
{
/* Builtin functions */
double cos(doublereal), sin(doublereal), atan2(doublereal, doublereal);
/* Local variables */
static doublereal qpar, qperp;
extern /* Subroutine */ int sp2rlv_(doublereal *, doublereal *,
doublereal *, doublereal *, integer *);
static doublereal qt[3];
/* ================= */
/* ----------------------------------------------------------------------- */
/* Part of [MAD.SRC]T_UPDATE.FOR */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* Input: */
/* Actual value of KI */
/* Actual value of KF */
/* Actual value of A3 */
/* Output: */
/* Actual value of A4 */
/* CALCULATED POSITIONS IN RECIP. LATTICE */
/* Q MODULUS */
/* Q MODULUS SQUARED */
/* ANGLE BETWEEN KI AND Q */
/* NOT CALCULATED) */
/* ----------------------------------------------------------------------- */
/* LOCAL PARAMETERS */
/* Error status. IER=1 if QM TOO SMALL (PHI */
/* ----------------------------------------------------------------------- */
/* QPAR AND QPERP ARE COMPONENTS OF Q PARALLEL AND PERP TO KI */
/* TRANSFORM FROM SCATTERING PLANE INTO RECIPROCAL LATTICE */
/* Parameter adjustments */
--qhkl;
/* Function Body */
qpar = *aki - *akf * cos(*a4 / 57.29577951308232087679815481410517);
qperp = -(*akf) * sin(*a4 / 57.29577951308232087679815481410517);
qt[0] = qpar * cos(*a3 / 57.29577951308232087679815481410517) + qperp *
sin(*a3 / 57.29577951308232087679815481410517);
qt[1] = -qpar * sin(*a3 / 57.29577951308232087679815481410517) + qperp *
cos(*a3 / 57.29577951308232087679815481410517);
qt[2] = 0.;
sp2rlv_(&qhkl[1], qt, qm, qs, ier);
*ier = 3;
if (*qm > .001) {
*ier = 0;
}
*phi = 0.;
if (abs(qperp) > .001 && abs(qpar) > .001) {
*phi = atan2(qperp, qpar);
} else if (abs(qpar) < .001) {
if (*a4 > 0.f) {
*phi = -1.5707963267948966;
} else {
*phi = 1.5707963267948966;
}
}
/* ----------------------------------------------------------------------- */
return 0;
} /* sam_up__ */
/* Subroutine */ int helm_up__(doublereal *phi, real *helm, real *p_ih__,
real *c_ih__, doublereal *dhx, doublereal *dhy, doublereal *dhz,
integer *ier)
{
/* System generated locals */
real r__1;
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal), atan2(doublereal, doublereal), cos(doublereal),
sin(doublereal);
/* Local variables */
static doublereal hdir, hmod, hpar, hdir2, h__[4], hperp;
static integer ic;
static logical at_sinq__;
/* ================== */
/* ---------------------------------------------------------------- */
/* HELMHOLTZ COILS UPDATE (ONLY IF LPA IS TRUE) */
/* ---------------------------------------------------------------- */
/* Part of [MAD.SRC]T_UPDATE.FOR */
/* include 'common_sinq.inc' */
/* ----------------------------------------------------------------------- */
/* At ILL: */
/* There are 3 coils for Hx/Hy at 120 degrees to each other. */
/* There is a 4th coil for Hz. */
/* At SINQ: */
/* There is an Hx coil and an Hy coil (actually each is 4 coils powered */
/* in series). They are mounted on a ring (SRO). The value of HELM is */
/* the angle between the Hx coil and ki. */
/* There is a 3rd coil for Hz. */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* Input: */
/* Angle between KI and Q in scatt'g plane (rad) */
/* Angle between first coil and KI (degrees) */
/* with Helmolz coils */
/* Current values of 4 currents associated .. */
/* Output: */
/* Conversion factor between Amperes and Gauss */
/* \ */
/* > The calculated fields */
/* / */
/* ---------------------------------------------------------------- */
/* LOCAL VARIABLES */
/* Error status. IER=1 if C_I HAS A ZERO COEF */
/* ---------------------------------------------------------------- */
/* H !FIELD OF 4 COILS AROUND SAMPLE */
/* HPAR !FIELD PAR COIL 1 */
/* HPERP !FIELD PERP. TO COIL 1 */
/* HDIR2 !ANGLE BETWEEN FIELD AND COIL 1 */
/* HDIR !ANGLE BETWEEN FIELD AND Q */
/* ---------------------------------------------------------------- */
/* Parameter adjustments */
--c_ih__;
--p_ih__;
/* Function Body */
*ier = 0;
at_sinq__ = TRUE_;
if (! at_sinq__) {
for (ic = 1; ic <= 4; ++ic) {
h__[ic - 1] = 0.;
if ((r__1 = c_ih__[ic], dabs(r__1)) > .001) {
h__[ic - 1] = p_ih__[ic + 4] * c_ih__[ic];
} else {
*ier = 1;
}
}
hpar = h__[0] - (h__[1] + h__[2]) * .5;
hperp = sqrt(3.) * .5 * (h__[1] - h__[2]);
*dhz = h__[3];
} else {
for (ic = 1; ic <= 3; ++ic) {
h__[ic - 1] = 0.;
if ((r__1 = c_ih__[ic], dabs(r__1)) > .001) {
h__[ic - 1] = p_ih__[ic + 4] * c_ih__[ic];
} else {
*ier = 1;
}
}
hpar = h__[0];
hperp = h__[1];
*dhz = h__[2];
}
/* Computing 2nd power */
d__1 = hpar;
/* Computing 2nd power */
d__2 = hperp;
hmod = sqrt(d__1 * d__1 + d__2 * d__2);
if (abs(hpar) > .001 && abs(hperp) > .001) {
hdir2 = atan2((abs(hperp)), (abs(hpar)));
if (hpar > 0. && hperp < 0.) {
hdir2 = -hdir2;
} else if (hpar < 0. && hperp > 0.) {
hdir2 = 3.1415926535897932384626433832795 - hdir2;
} else if (hpar < 0. && hperp < 0.) {
hdir2 += -3.1415926535897932384626433832795;
}
} else if (abs(hpar) > .001) {
if (hpar >= 0.f) {
hdir2 = 0.f;
}
if (hpar < 0.f) {
hdir2 = 3.1415926535897932384626433832795;
}
} else if (abs(hperp) > .001) {
if (hperp >= 0.f) {
hdir2 = 1.5707963267948966;
}
if (hperp < 0.f) {
hdir2 = -1.5707963267948966;
}
} else {
hdir2 = 0.f;
}
hdir = hdir2 + *helm / 57.29577951308232087679815481410517 - *phi;
*dhx = hmod * cos(hdir);
*dhy = hmod * sin(hdir);
return 0;
} /* helm_up__ */
/* Subroutine */ int flip_up__(integer *if1, integer *if2, real *p_ih__, real
*f1v, real *f1h, real *f2v, real *f2h, real *aki, real *akf, integer *
ier)
{
/* System generated locals */
real r__1, r__2;
/* ================== */
/* ---------------------------------------------------------------- */
/* FLIPPERS; ONLY IF LPA */
/* ---------------------------------------------------------------- */
/* Part of [MAD.SRC]T_UPDATE.FOR */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* Input: */
/* with flipper coils */
/* Current values of 4 currents associated .. */
/* .. current is possibly aki*f1h ??) */
/* Flipper 1 vert and hor currents (hor .. */
/* .. current is possibly akf*f2h ??) */
/* Flipper 2 vert and hor currents (hor .. */
/* Incident neutron wave vector */
/* Output: */
/* Final neutron wave vector */
/* Status of Flipper 1 (=1 if on and set OK) */
/* Status of Flipper 2 (=1 if on and set OK) */
/* ---------------------------------------------------------------- */
/* Error status. 0 if no error. */
/* Parameter adjustments */
--p_ih__;
/* Function Body */
*ier = 0;
*if1 = 0;
*if2 = 0;
if ((r__1 = p_ih__[1] - *f1v, dabs(r__1)) < .05f && (r__2 = p_ih__[2] - *
aki * *f1h, dabs(r__2)) < .05f) {
*if1 = 1;
}
if ((r__1 = p_ih__[3] - *f2v, dabs(r__1)) < .05f && (r__2 = p_ih__[4] - *
akf * *f2h, dabs(r__2)) < .05f) {
*if2 = 1;
}
/* ----------------------------------------------------------------------- */
return 0;
} /* flip_up__ */

406
t_update.f Executable file
View File

@ -0,0 +1,406 @@
SUBROUTINE T_UPDATE ( ! File [MAD.SRC]T_UPDATE.FOR
c ===================
+ P_A, P_IH, C_IH,
+ LPA ,DM, DA, ISA, HELM, F1H, F1V, F2H, F2V, F,
+ EI, AKI, EF, AKF, QHKL, EN,
+ HX, HY, HZ, IF1, IF2, QM, IER)
c
cdec$ Ident 'V01C'
c------------------------------------------------------------------
c Note:
c IF1,If2 changed to Int*4. They were Real*4 in ILL version.
c------------------------------------------------------------------
c Updates:
c V01A 7-May-1996 DM. Put error output to IOLUN, use IMPLICIT NONE and
c get the code indented so that it is readable!
c V01C 12-Oct-1998 DM. Put in Mag Field calculation for SINQ Helmolz coils.
C-----------------------------------------------------------------------
c Entry points in this file:
C T_UPDATE : USE THE MOTOR ANGLES TO CALCULATE VALUES OF
c EI,KI,EF,KF,QH,QK,QL,EN AND TO DETERMINE
c WHETHER FLIPPERS F1,F2 ARE 'ON' OR 'OFF'.
c EX_UP : CALCULATE EX AND AKX FORM AX2 VALUES.
c SAM_UP : CALCULATE THINGS IN RECIPROCICAL LATTICE.
c HELM_UP : CALCULATE HELMHOLTZ FIELDS.
c FLIP_UP : CHECK IF FLIPPERS ON OR OFF.
C-----------------------------------------------------------------------
c T_UPDATE:
C ROUTINE TO USE THE MOTOR ANGLES TO
C CALCULATE VALUES OF EI,KI,EF,KF,QH,QK,QL,EN
C USE CURRENT-SUPPLY VALUES TO COMPUTE HELMHOLTZ FIELDS HX,HY,HZ
C AND TO DETERMINE WHETHER FLIPPERS F1,F2 ARE 'ON' OR 'OFF'.
C FLIPPERS ARE 'ON' ONLY IF CURRENTS ARE THOSE GIVEN BY
C F1V,F1H,F2V,F2H
C-----------------------------------------------------------------------
IMPLICIT NONE
ccc IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C include 'iolsddef.inc'
C-----------------------------------------------------------------------
c Define the dummy arguments
c Input:
real*4 p_a(6) ! Positions of angles A1-A6.
real*4 p_ih(8) ! Position of currents for flippers and ..
! .. helmotz (8 currents).
real*4 c_ih(4) ! Conversion factors for Helmotz (4 currents).
! Configuration of the machine ...
logical*4 lpa ! True if machine in polarization mode.
real*4 dm ! Monochr. d-spacing
real*4 da ! Analyser d-spacing
integer*4 isa ! Scattering sense at analyser (probably) ..
! .. +ve to the left.
real*4 helm ! Angle between axis of Helmolz pair one and ..
! .. ki (probably).
real*4 f1h, f1v ! Flipper 1 hor and vert currents (hor ..
! .. current is possibly ki*f1h ??)
real*4 f2h, f2v ! Flipper 2 hor and vert currents (hor ..
! .. current is possibly kf*f2h ??)
real*4 f ! Energy unit
c Output:
real*4 ei ! Incident neutron energy
real*4 aki ! Incident neutron wave vector
real*4 ef ! Final neutron energy
real*4 akf ! Final neutron wave vector
real*4 qhkl(3) ! Components of q in reciprocal space
real*4 en ! Energy transfer
real*4 hx, hy, hz ! Components of Helmolz field on sample
integer*4 if1, if2 ! Status of Flippers 1 and 2
real*4 qm ! Length of q
integer*4 ier ! Error status
C-----------------------------------------------------------------------
double precision dbqhkl(3), dhx, dhy, dhz
double precision ddm, dda, df
double precision da2, da3, da4, da6
double precision dei, daki, def, dakf
double precision dqm, dqs, dphi
real*4 qs
c
integer*4 ieri, ieru, imod, id
C-----------------------------------------------------------------------
C SET UP
C
DDM=DM
DDA=DA
DF=F
DA2=P_A(2)
DA3=P_A(3)
DA4=P_A(4)
DA6=P_A(6)
C-----------------------------------------------------------------------
C
IERI=0
IERU=1
CALL EX_UP(DDM,DEI,DAKI,DA2,DF,IERI)
IF (IERI.EQ.0) THEN
EI=DEI
AKI=DAKI
IERU=0
ELSE
IMOD=3
CALL ERRESO(IMOD,IERI)
ENDIF
IERI=0
IERU=1
CALL EX_UP(DDA,DEF,DAKF,DA6,DF,IERI)
IF (IERI.EQ.0) THEN
EF=DEF
AKF=DAKF
IERU=0
ELSE
IF (ISA.EQ.0) THEN
EF=DEI
AKF=DAKI
DEF=DEI
DAKF=DAKI
IERU=0
ELSE
IMOD=3
CALL ERRESO(IMOD,IERI)
ENDIF
ENDIF
IF (ISA.EQ.0) THEN
EF=DEI
AKF=DAKI
DEF=DEI
DAKF=DAKI
IERU=0
ENDIF
IF (IERU.EQ.0) EN=DEI-DEF
IERI=0
IERU=1
CALL SAM_UP(DBQHKL,DQM,DQS,DPHI,DAKI,DAKF,DA3,DA4,IERI)
IF (IERI.EQ.0) THEN
DO ID=1,3
QHKL(ID)=DBQHKL(ID)
ENDDO
QM=DQM
QS=DQS
IERU=0
ELSE
IMOD=2
CALL ERRESO(IMOD,IERI)
ENDIF
C
IERI=0
IF (LPA) THEN
IERU=1
CALL HELM_UP(DPHI,HELM,P_IH,C_IH,DHX,DHY,DHZ,IERI)
IF (IERI.NE.0) THEN
C WRITE(6,*) 'ERROR IN HELM_UP CHECK COEFF'
ELSE
HX=DHX
HY=DHY
HZ=DHZ
IERU=0
ENDIF
CALL FLIP_UP(IF1,IF2,P_IH,F1V,F1H,F2V,F2H,AKI,AKF,IERI)
ENDIF
C-----------------------------------------------------------------------
IER=IERU
RETURN
END
c
SUBROUTINE EX_UP(DX,EX,AKX,AX2,F,IER) ! Part of [MAD.SRC]T_UPDATE.FOR
c ================
c
C-----------------------------------------------------------------------
C CALCULATE EX AND AKX FORM AX2 VALUES
C-----------------------------------------------------------------------
implicit none
c
DOUBLE PRECISION PI
PARAMETER (PI=3.1415926535897932384626433832795E0)
DOUBLE PRECISION RD
PARAMETER (RD=57.29577951308232087679815481410517E0)
DOUBLE PRECISION EPS4
PARAMETER (EPS4=1.D-4)
C-----------------------------------------------------------------------
c Define the dummy arguments
c Input:
DOUBLE PRECISION DX ! D-SPACING OF CRISTAL
DOUBLE PRECISION AX2 ! TAKE OFF ANGLE
DOUBLE PRECISION F ! ENERGY UNIT
c Output:
DOUBLE PRECISION EX ! ENERGY
DOUBLE PRECISION AKX ! MOMENTUM
INTEGER*4 IER ! Error - IER=1 if DX OR AX TOO SMALL
C-----------------------------------------------------------------------
DOUBLE PRECISION ARG
C-----------------------------------------------------------------------
C!!!!!!!!!! This has to be fixed manually after conversion by f2c.
C!!!!!!!!!! The reason is a different definition of the abs function.
C!!!!!!!!!! MK, May 2001
ARG=ABS(DX*SIN(AX2/(2.D0*RD)))
IF(ARG.LE.EPS4) THEN
IER=1
ELSE
IER=0
AKX=PI/ARG
EX=F*AKX**2
ENDIF
C-----------------------------------------------------------------------
RETURN
END
c
SUBROUTINE SAM_UP ( ! Part of [MAD.SRC]T_UPDATE.FOR
c =================
+ QHKL, QM, QS, PHI,
+ AKI, AKF, A3, A4, IER)
C-----------------------------------------------------------------------
implicit none
c
double precision PI
PARAMETER (PI=3.1415926535897932384626433832795D0)
double precision RD
PARAMETER (RD=57.29577951308232087679815481410517D0)
double precision EPS3
PARAMETER (EPS3=1.D-3)
C-----------------------------------------------------------------------
c Define the dummy arguments
c Input:
double precision AKI ! Actual value of KI
double precision AKF ! Actual value of KF
double precision A3 ! Actual value of A3
double precision A4 ! Actual value of A4
c Output:
double precision QHKL(3) ! CALCULATED POSITIONS IN RECIP. LATTICE
double precision QM ! Q MODULUS
double precision QS ! Q MODULUS SQUARED
double precision PHI ! ANGLE BETWEEN KI AND Q
integer*4 IER ! Error status. IER=1 if QM TOO SMALL (PHI
! NOT CALCULATED)
C-----------------------------------------------------------------------
C LOCAL PARAMETERS
double precision QT(3)
double precision QPAR, QPERP
C-----------------------------------------------------------------------
C QPAR AND QPERP ARE COMPONENTS OF Q PARALLEL AND PERP TO KI
C TRANSFORM FROM SCATTERING PLANE INTO RECIPROCAL LATTICE
C
qpar = aki - akf * cos(a4/RD)
qperp = -akf * sin(a4/RD)
qt(1) = qpar * cos(a3/RD) + qperp * sin(a3/RD)
qt(2) = -qpar * sin(a3/RD) + qperp * cos(a3/RD)
qt(3) = 0.d0
call sp2rlv (qhkl, qt, qm, qs, ier)
ier = 3
if (qm .gt. EPS3) ier = 0
phi = 0.d0
if (abs(qperp) .gt. EPS3 .and. abs(qpar) .gt. EPS3) then
phi = atan2 (qperp, qpar)
elseif (abs(qpar) .lt. EPS3) then
if (a4 .gt. 0.0) then
phi = -0.5 * PI
else
phi = 0.5 * PI
endif
endif
c-----------------------------------------------------------------------
return
end
c
SUBROUTINE HELM_UP ( ! Part of [MAD.SRC]T_UPDATE.FOR
c ==================
+ PHI, HELM, P_IH, C_IH,
+ DHX, DHY, DHZ, IER)
c
C----------------------------------------------------------------
C HELMHOLTZ COILS UPDATE (ONLY IF LPA IS TRUE)
C----------------------------------------------------------------
implicit none
c
C include 'common_sinq.inc'
c
double precision PI
PARAMETER (PI = 3.1415926535897932384626433832795D0)
double precision RD
PARAMETER (RD = 57.29577951308232087679815481410517D0)
double precision EPS3
PARAMETER (EPS3 = 1.0D-3)
C-----------------------------------------------------------------------
c At ILL:
c There are 3 coils for Hx/Hy at 120 degrees to each other.
c
c There is a 4th coil for Hz.
c
c At SINQ:
c There is an Hx coil and an Hy coil (actually each is 4 coils powered
c in series). They are mounted on a ring (SRO). The value of HELM is
c the angle between the Hx coil and ki.
c
c There is a 3rd coil for Hz.
C-----------------------------------------------------------------------
c Define the dummy arguments
c Input:
double precision PHI ! Angle between KI and Q in scatt'g plane (rad)
real*4 HELM ! Angle between first coil and KI (degrees)
real*4 P_IH(8) ! Current values of 4 currents associated ..
! with Helmolz coils
real*4 C_IH(4) ! Conversion factor between Amperes and Gauss
c Output:
double precision DHX ! \
double precision DHY ! > The calculated fields
double precision DHZ ! /
integer*4 IER ! Error status. IER=1 if C_I HAS A ZERO COEF
C----------------------------------------------------------------
C LOCAL VARIABLES
integer*4 ic
double precision h(4), hpar, hperp, hmod, hdir, hdir2
LOGICAL AT_SINQ
C----------------------------------------------------------------
C H !FIELD OF 4 COILS AROUND SAMPLE
C HPAR !FIELD PAR COIL 1
C HPERP !FIELD PERP. TO COIL 1
C HDIR2 !ANGLE BETWEEN FIELD AND COIL 1
C HDIR !ANGLE BETWEEN FIELD AND Q
C----------------------------------------------------------------
ier = 0
AT_SINQ = .TRUE.
if (.not. at_sinq) then
do ic = 1, 4
h(ic) = 0.d0
if (abs(c_ih(ic)) .gt. EPS3) then
h(ic) = p_ih(ic+4) * c_ih(ic)
else
ier = 1
endif
enddo
hpar = h(1) - .5d0 * (h(2) + h(3))
hperp = .5d0 * sqrt(3.d0) * (h(2) - h(3))
dhz = h(4)
else
do ic = 1, 3
h(ic) = 0.d0
if (abs(c_ih(ic)) .gt. EPS3) then
h(ic) = p_ih(ic+4) * c_ih(ic)
else
ier = 1
endif
enddo
hpar = h(1)
hperp = h(2)
dhz = h(3)
endif
c
hmod = sqrt (hpar**2 + hperp**2)
if (abs(hpar) .gt. EPS3 .and. abs(hperp) .gt. EPS3) then
hdir2 = atan2 (abs(hperp), abs(hpar))
if (hpar .gt. 0 .and. hperp .lt. 0) then
hdir2 = -hdir2
elseif (hpar .lt. 0 .and. hperp .gt. 0) then
hdir2 = PI - hdir2
elseif (hpar .lt. 0 .and. hperp .lt. 0) then
hdir2 = hdir2 - PI
endif
elseif (abs(hpar) .gt. EPS3) then
if (hpar .ge. 0.0) hdir2 = 0.0
if (hpar .lt. 0.0) hdir2 = PI
elseif (abs(hperp) .gt. EPS3) then
if (hperp .ge. 0.0) hdir2 = 0.5 * PI
if (hperp .lt. 0.0) hdir2 = -0.5 * PI
else
hdir2 = 0.0
endif
hdir = hdir2 + (helm/RD) - phi
dhx = hmod * cos(hdir)
dhy = hmod * sin(hdir)
c
return
end
c
SUBROUTINE FLIP_UP ( ! Part of [MAD.SRC]T_UPDATE.FOR
c ==================
+ IF1, IF2,
+ P_IH, F1V, F1H, F2V, F2H,
+ AKI, AKF, IER)
C----------------------------------------------------------------
C FLIPPERS; ONLY IF LPA
C----------------------------------------------------------------
implicit none
C-----------------------------------------------------------------------
c Define the dummy arguments
c Input:
real*4 p_ih(8) ! Current values of 4 currents associated ..
! with flipper coils
real*4 f1v, f1h ! Flipper 1 vert and hor currents (hor ..
! .. current is possibly aki*f1h ??)
real*4 f2v, f2h ! Flipper 2 vert and hor currents (hor ..
! .. current is possibly akf*f2h ??)
real*4 aki ! Incident neutron wave vector
real*4 akf ! Final neutron wave vector
c Output:
integer*4 if1 ! Status of Flipper 1 (=1 if on and set OK)
integer*4 if2 ! Status of Flipper 2 (=1 if on and set OK)
integer*4 ier ! Error status. 0 if no error.
C----------------------------------------------------------------
IER = 0
IF1 = 0
IF2 = 0
IF ((ABS(P_IH(1) - F1V) .LT. 0.05) .AND.
+ (ABS(P_IH(2) - AKI*F1H) .LT. 0.05)) IF1 = 1
IF ((ABS(P_IH(3) - F2V) .LT. 0.05) .AND.
+ (ABS(P_IH(4) - AKF*F2H) .LT. 0.05)) IF2 = 1
C-----------------------------------------------------------------------
RETURN
END

1
tasdrive.c
View File

@ -273,6 +273,7 @@ int TASDrive(SConnection *pCon, SicsInterp *pSics, void *pData,
wait till we are finished
*/
status = Wait4Success(GetExecutor());
TASUpdate(self,pCon);
if(status == DEVINT)
{
if(SCGetInterrupt(pCon) == eAbortOperation)

1
tasscan.c
View File

@ -598,6 +598,7 @@ static int TASScanDrive(pScanData self, int iPoint)
status = Wait4Success(GetExecutor());
}
TASUpdate(pTAS,self->pCon);
return 1;
}
/*-----------------------------------------------------------------------

7
tasu.h
View File

@ -2,9 +2,11 @@
This is a helper header file which contains the prototypes for some
functions to be used in the implementation of the triple axis spectrometer
module. For more info on the functions see the comments in the
implemntation file tasutil.c
implementation file tasutil.c
Initial Coding: Mark Koennecke, November 2000
Added TASUpdate: Mark Koennecke, May 2001
Mark Koennecke, November 2000
*/
#ifndef TASUSICS
#define TASUSICS
@ -38,6 +40,7 @@ int TASStart(pTASdata self, SConnection *pCon, SicsInterp *pSics,
float motorTargets[20],
unsigned char motorMask[20]);
int TASUpdate(pTASdata self, SConnection *pCon);
#endif

240
tasutil.c
View File

@ -289,7 +289,7 @@ int TASCalc(pTASdata self, SConnection *pCon,
if(self->tasPar[LPA]->iVal > 0)
lpa = (logical)1;
dm = (real)self->tasPar[DM]->fVal;
da = (real)self->tasPar[DM]->fVal;
da = (real)self->tasPar[DA]->fVal;
qm = (real)self->tasPar[QM]->fVal;
helm = (real)self->tasPar[HELM]->fVal;
f1h = (real)self->tasPar[IF1H]->fVal;
@ -303,7 +303,7 @@ int TASCalc(pTASdata self, SConnection *pCon,
/*
initialize the helmholts currents. This needs work when
polarisation anlaysis is really supported.
polarisation analysis is really supported.
*/
for(i = 0; i < 4; i++)
{
@ -474,5 +474,239 @@ int TASStart(pTASdata self, SConnection *pCon, SicsInterp *pSics,
*/
return 1;
}
}
/*------------------ from t_update.f converted to t_update.c -----------*/
extern int t_update__(real *p_a__, real *p_ih__, real *c_ih__,
logical *lpa, real *dm, real *da, integer *isa,
real *helm, real *f1h, real *f1v, real *f2h, real *f2v,
real *f, real *ei, real *aki, real *ef, real *akf,
real *qhkl, real *en, real *hx, real *hy, real *hz,
integer *if1, integer *if2, real *qm, integer *ier);
/*---------------------------------------------------------------------------
TASUpdate calculates the Q/E variables back from the motors A1-A6 and
then proceeds to update the energy variables. It also checks if the
analyzer monochromator motors match up i.e tth = 2*om.
----------------------------------------------------------------------------*/
int TASUpdate(pTASdata self, SConnection *pCon)
{
real sam[16], amot[6], helmCurrent[8], convH[4], dm, da, helm, f1h, f1v;
real f, ei, aki, ef, akf, qhkl[3], en, hx, hy, hz, qm, f2v, f2h;
logical lpa;
integer isa, if1, if2, ier, ifx;
pMotor pMot;
char pBueffel[132];
float fMot, diff;
int i, status;
assert(self);
assert(pCon);
/*
The first thing we need to do is to set up the orientation matrix
from the sample parameters.
*/
sam[0] = (real)self->tasPar[AS]->fVal;
sam[1] = (real)self->tasPar[BS]->fVal;
sam[2] = (real)self->tasPar[CS]->fVal;
sam[3] = (real)self->tasPar[AA]->fVal;
sam[4] = (real)self->tasPar[BB]->fVal;
sam[5] = (real)self->tasPar[CC]->fVal;
sam[6] = (real)self->tasPar[AX]->fVal;
sam[7] = (real)self->tasPar[AY]->fVal;
sam[8] = (real)self->tasPar[AZ]->fVal;
sam[9] = (real)self->tasPar[BX]->fVal;
sam[10] = (real)self->tasPar[BY]->fVal;
sam[11] = (real)self->tasPar[BZ]->fVal;
setrlp_(sam,&ier);
switch(ier)
{
case 1:
SCWrite(pCon,"ERROR: error on lattice parameters",eError);
return 0;
break;
case 2:
SCWrite(pCon,"ERROR: error on lattice angles",eError);
return 0;
break;
case 3:
SCWrite(pCon,"ERROR: error on vectors A1, A2",eError);
return 0;
break;
default:
break;
}
/*
get the motor angles A1-A6
*/
for(i = 0; i < 6; i++)
{
pMot = FindMotor(pServ->pSics,tasMotorOrder[i]);
if(!pMot)
{
sprintf(pBueffel,"ERROR: internal: motor %s NOT found",
tasMotorOrder[i]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
status = MotorGetSoftPosition(pMot,pCon,&fMot);
if(status != 1)
{
sprintf(pBueffel, "ERROR: failed to read motor %s",
tasMotorOrder[i]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
amot[i] = fMot;
}
/*
initialize magnet things to harmless. TODO: update to read properly
when installed.
*/
for(i = 0; i < 4; i++)
{
helmCurrent[i] = .0;
helmCurrent[4+i] = .0;
convH[i] = .0;
}
/*
collect all the other machine parameters needed for a call to
t_update
*/
if(self->tasPar[LPA]->iVal > 0)
lpa = (logical)1;
da = (real)self->tasPar[DA]->fVal;
dm = (real)self->tasPar[DM]->fVal;
isa = (integer)self->tasPar[SA]->iVal;
helm = (real)self->tasPar[HELM]->fVal;
f1h = (real)self->tasPar[IF1H]->fVal;
f1v = (real)self->tasPar[IF1V]->fVal;
f2h = (real)self->tasPar[IF2H]->fVal;
f2v = (real)self->tasPar[IF2V]->fVal;
f = (real)2.072; /* energy unit meV */
ifx = (integer)self->tasPar[FX]->iVal;
/*
now call t_update to do the calculation
*/
t_update__(amot, helmCurrent, convH, &lpa, &dm, &da, &isa, &helm,
&f1h, &f1v, &f2h, &f2v, &f, &ei, &aki, &ef, &akf,
qhkl, &en, &hx, &hy, &hz, &if1, &if2, &qm, &ier);
/*
!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
t_update's function ex_up must be dited manually after conversion
to c by f2c. The reason is a different definition of the abs function.
The line:
arg = (d__1 = *dx * sin(*ax2 / 114.59155902616465, abs(d__1));
has to be changed to:
arg = *dx * sin(*ax2 / 114.59155902616465);
if(arg < .0)
arg = -arg;
!!!!!!!!!!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!!!!!!!!!!!!!*/
/*
error messages taken from erreso
*/
switch(ier)
{
case 1:
SCWrite(pCon,"ERROR: Bad lattice parameters",eError);
return 0;
break;
case 2:
SCWrite(pCon,"ERROR: Bad cell angles",eError);
return 0;
break;
case 3:
SCWrite(pCon,"ERROR: Bad scattering plane ",eError);
return 0;
break;
case 4:
SCWrite(pCon,"ERROR: Bad lattice or lattice plane",eError);
return 0;
break;
case 5:
SCWrite(pCon,"ERROR: Q not in scattering plane",eError);
return 0;
break;
case 6:
SCWrite(pCon,"ERROR: Q modulus to small",eError);
return 0;
break;
case 7:
case 12:
SCWrite(pCon,"ERROR: KI, KF, Q triangle cannot close ",eError);
return 0;
break;
case 8:
SCWrite(pCon,"ERROR: in KI, KF, check d-spacings",eError);
return 0;
break;
case 9:
SCWrite(pCon,"ERROR: KI or KF cannot be obtained",eError);
return 0;
break;
case 10:
SCWrite(pCon,"ERROR: KI or KF to small",eError);
return 0;
break;
case 11:
SCWrite(pCon,"ERROR: KI or KF cannot be obtained",eError);
return 0;
break;
default:
break;
}
/*
update all the energy variables
*/
self->tasPar[EI]->fVal = ei;
self->tasPar[KI]->fVal = aki;
self->tasPar[EF]->fVal = ef;
self->tasPar[KF]->fVal = akf;
self->tasPar[QH]->fVal = qhkl[0];
self->tasPar[QK]->fVal = qhkl[1];
self->tasPar[QL]->fVal = qhkl[2];
self->tasPar[EN]->fVal = en;
self->tasPar[HX]->fVal = hx;
self->tasPar[HY]->fVal = hy;
self->tasPar[HZ]->fVal = hz;
self->tasPar[QM]->fVal = qm;
/*
now check the analyzer or monochromator angles
*/
if(ifx == 1)
{
diff = amot[1]/2 - amot[0];
if(diff < .0)
diff = -diff;
if(diff > .1)
{
sprintf(pBueffel,"WARNING: A2 = %f is not half of A1 = %f",
amot[1], amot[0]);
SCWrite(pCon,pBueffel,eWarning);
}
}
else if (ifx == 2)
{
diff = amot[5]/2 - amot[4];
if(diff < .0)
diff = -diff;
if(diff > .1)
{
sprintf(pBueffel,"WARNING: A6 = %f is not half of A5 = %f",
amot[5], amot[4]);
SCWrite(pCon,pBueffel,eWarning);
}
}
return 1;
}

1
test.tcl
View File

@ -115,6 +115,7 @@ sampledist lock
Motor A1 SIM 15.0 120. .1 2. # Monochromator Theta
Motor A2 SIM -73. 137. .1 1. # Monochromator 2Theta
Motor A3 SIM -360. 360. .1 3. # Sample Omega
#Motor A3 el734 localhost 4000 2 3
Motor A4 SIM -130. 130. .1 1. # Sample 2Theta
Motor A5 SIM -30. 30. .1 3. # ? horiz. Translation
Motor A6 SIM -30. 30. .1 3. # ? vert Translation

2
utils/Makefile
View File

@ -42,7 +42,7 @@ $(BIN)/el734: el734.c
@ echo "el734 needs Motif library. Not yet found on linux"
rm -f $(BIN)/el734
$(CC) $(CFLAGS) -o $(BIN)/el734 \
el734.c $(LFLAGS) -lhlib -lX11 -lXm
el734.c $(LFLAGS) -lhlib -lX11 -lXt -lXm
$(BIN)/el734_test: el734_test.c
rm -f $(BIN)/el734_test

44
utils/SerPortServer.c
View File

@ -69,6 +69,8 @@
** *serPortTrace -trace Turn on tracing.
** *serPortTraceSize -tsize 0x40000 (= 256k) Trace buffer size.
** *serPortPeriod -period 60 Period for writing trace time-stamps
** *serPortMax -max 20 Maximum number of serial ports
** to use
**
** A value given via -name will be converted to lowercase before being used.
**---------------------------------------------------------------------------
@ -173,8 +175,8 @@
#endif
#define RS__MAX_CLIENTS 8 /* Up to 8 clients will be supported */
#define RS__MAX_ASYNCH 20 /* Asynch "ports" 0 - 19 will be allowed */
#define MAX_OPEN_CHANS RS__MAX_ASYNCH
static int RS__MAX_ASYNCH = 20; /* Asynch "ports" 0 - 19 will be allowed */
#define MAX_OPEN_CHANS 20
#define MAX_PKT_SIZE 10000 /* The SerPortServer packet protocol has a
** 4 char ASCII header giving the packet length.
@ -902,6 +904,7 @@
bytes_to_come -= status;
p_nxt_byte += status;
}
if (bytes_to_come != 0) {
printf ("recv: Did not get all of expected data on "
"socket %d.\n", Cl_info[indx].skt);
@ -1254,7 +1257,7 @@
char *buff, /* In -- Pntr to buffer to search */
int nch) { /* In -- The number of chars in buff */
int i, j;
int i, j, noTerm = -1, nLen = -1;
if (nterm <= 0) {
*len = nch; /* No terminator. So return complete string */
@ -1262,13 +1265,18 @@
return False;
}else { /* Search string for a terminator */
for (i = 0; i < nch; i++) {
for (j = 0; j < nterm; j++) if (buff[i] == terms[j]) break;
if (buff[i] == terms[j]) break;
for (j = 0; j < nterm; j++) {
if (buff[i] == terms[j]) {
/* replace terminator with NIL */
buff[i] = NIL; /* replace terminator with NIL */
noTerm = j;
break;
}
}
}
*len = i;
if (buff[i] == terms[j]) { /* Was a terminator found? */
*term = terms[j]; /* Yes. Return it */
buff[i] = NIL; /* Replace the terminator with a NIL */
if (noTerm >= 0 ) { /* Was a terminator found? */
*term = terms[noTerm]; /* Yes. Return it */
*len += 1; /* And include the term in the length */
return True;
}else {
@ -1585,7 +1593,7 @@
}
Cl_info[cl_indx].nxt_cmnd_ptr = nxt_cmnd_ptr;
Cl_info[cl_indx].nxt_rply_ptr0 = nxt_rply_ptr0;
Cl_info[cl_indx].nxt_rply_ptr1 = nxt_rply_ptr1;
Cl_info[cl_indx].nxt_rply_ptr1 = nxt_rply_ptr1;
if (Ts_info[ts_indx].tmo < Next_tmo_secs)
Next_tmo_secs = Ts_info[ts_indx].tmo;
@ -1745,6 +1753,7 @@
{"-tsize", ".serPortTraceSize", XrmoptionSepArg, (XPointer) NULL},
{"-period", ".serPortPeriod", XrmoptionSepArg, (XPointer) NULL},
{"-debug", ".serPortDebug", XrmoptionNoArg, (XPointer) "1"},
{"-max", ".serPortMax", XrmoptionSepArg, (XPointer) NULL},
};
static char our_name[80] = "Unknown"; /* This holds the program name */
@ -2333,6 +2342,19 @@
"ProgramName.Values",
&type, &value);
Debug = (status) ? True : False;
/* - - - - - - - - - - - - - - - - - - - - - - - - -max */
status = XrmGetResource (my_db,
StrJoin (buff, sizeof (buff),
appName, ".serPortMax"),
"ProgramName.Values",
&type, &value);
if (!status ||
(sscanf (value.addr, "%d", &RS__MAX_ASYNCH) != 1)) {
RS__MAX_ASYNCH = 20;
printf (" Max Serial Lines defaulting to %d\n", RS__MAX_ASYNCH);
}else {
printf (" Max Serial Lines Taken = %d\n", RS__MAX_ASYNCH);
}
/*-----------------------------------------------------------------------*/
N_clients = N_open_chans = 0;
@ -2441,6 +2463,10 @@
if (Ts_info[i].status != TS_SS_IDLE) {
if (subtractTimes (time_now, Ts_info[i].time_stamp) >=
Ts_info[i].tmo) {
subtractTimes(time_now, Ts_info[i].time_stamp);
printf("TMO: Difference: %f, allowed %f\n",
subtractTimes(time_now, Ts_info[i].time_stamp),
Ts_info[i],tmo);
handleTmo (i); /* This channel has timed-out! */
}
}

7
varlog.c
View File

@ -184,21 +184,24 @@
int VarlogGetMean(pVarLog self, float *fMean, float *fStdDev)
{
double dMean, dStdDev;
int success;
if(self->iCount > 0)
{
dMean = self->dSum/(double)self->iCount;
dStdDev = sqrt(self->dDeviation/(double)self->iCount);
success = 1;
}
else
{
dMean = .0;
dStdDev = .0;
success = 0;
}
*fMean = (float)dMean;
*fStdDev = (float)dStdDev;
return 1;
return success;
}
/*--------------------------------------------------------------------------*/
int VarlogWrapper(pVarLog self, SConnection *pCon,