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

- Fixed a few problems with hklscan

Browse Source 
- Added transfer of zipped data to conman.c, histogram memory software
  in order to support the TRICS status display.
- Upgraded TRICS data file writing.
- First installment of triple axis spectrometer support: initialization of
  data structures and an implementation of the MAD dr(ive) command.
This commit is contained in:
cvs
2000-11-21 08:16:46 +00:00
parent f9a31d2065
commit e83d3e6946
39 changed files with 5301 additions and 563 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
Makefile
View File

@ -42,7 +42,9 @@ SOBJ = network.o ifile.o conman.o SCinter.o splitter.o passwd.o \
sanswave.o faverage.o bruker.o rmtrail.o fowrite.o ltc11.o \
simchop.o choco.o chadapter.o docho.o trim.o eurodriv.o scaldate.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
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
MOTOROBJ = motor.o el734driv.o simdriv.o el734dc.o pipiezo.o pimotor.o
COUNTEROBJ = countdriv.o simcter.o counter.o
@ -55,15 +57,15 @@ VELOOBJ = velo.o velosim.o velodorn.o velodornier.o
#----- comment or uncomment the following according to operating system
#------------- for Digital Unix
#BINTARGET=$(HOME)/bin/osf.axp
#HDFROOT=/data/koenneck
#CC=cc
#EXTRA=
#CFLAGS = -I$(HDFROOT)/include -Ihardsup -I. -std1 -g -warnprotos -c
BINTARGET=.
HDFROOT=/data/koenneck
CC=cc
EXTRA=
CFLAGS = -I$(HDFROOT)/include -Ihardsup -I. -std1 -g -warnprotos -c
#CFLAGS = -I$(HDFROOT)/include -DFORTIFY -Ihardsup -g -std1 -warnprotos -c
#LIBS = -L$(HDFROOT)/lib -Lhardsup -lhlib -Lmatrix -lmatrix -Ltecs \
# -ltecsl -ltcl8.0 -lfor -lmfhdf -ldf $(HDFROOT)/lib/libjpeg.a \
# -lz -lm -ll -lc
LIBS = -L$(HDFROOT)/lib -Lhardsup -lhlib -Lmatrix -lmatrix -Ltecs \
-ltecsl -ltcl8.0 -lfor -lmfhdf -ldf $(HDFROOT)/lib/libjpeg.a \
-lz -lm -ll -lc
#------- for cygnus
#HDFROOT=../HDF411
@ -74,14 +76,14 @@ VELOOBJ = velo.o velosim.o velodorn.o velodornier.o
# -lmfhdf -ldf -ljpeg -lz -lm
#---------- for linux
BINTARGET=$(HOME)/bin/linux.i686
HDFROOT=/usr/local
CC=gcc
CFLAGS = -I$(HDFROOT)/include -Ihardsup -fwritable-strings \
-DCYGNUS -DNONINTF -g -c
LIBS= -L$(HDFROOT)/lib -Lhardsup -Ltecs -ltecsl -Lmatrix -lmatrix -lhlib \
-ltcl8.0 -lmfhdf -ldf -ljpeg -lz -lm -lg2c -ldl
EXTRA=nintf.o
#BINTARGET=$(HOME)/bin/linux.i686
#HDFROOT=/usr/local
#CC=gcc
#CFLAGS = -I$(HDFROOT)/include -Ihardsup -fwritable-strings \
# -DCYGNUS -DNONINTF -g -c
#LIBS= -L$(HDFROOT)/lib -Lhardsup -Ltecs -ltecsl -Lmatrix -lmatrix -lhlib \
# -ltcl8.0 -lmfhdf -ldf -ljpeg -lz -lm -lg2c -ldl
#EXTRA=nintf.o
#---------------------------------------------------------------------------
.c.o:

229
conman.c
View File

@ -18,6 +18,10 @@
SCWriteBinary added. Mark Koennecke, April 1998
Revamped login to non telnet connection.
Added compressed writing method.
Mark Koennecke, October 2000
Copyright: see copyright.h
-----------------------------------------------------------------------------*/
#include "fortify.h"
@ -26,7 +30,9 @@
#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include <zlib.h>
#include <tcl.h>
#include <time.h>
#include "lld.h"
#include "conman.h"
#include "passwd.h"
@ -129,6 +135,8 @@ extern pServer pServ;
pRes->eInterrupt = eContinue;
pRes->lMagic = CONMAGIC;
pRes->iDummy = 0;
pRes->iLogin = 0;
pRes->conStart = time(NULL);
pRes->write = SCNormalWrite;
for(i = 0; i < 10; i++)
{
@ -213,6 +221,8 @@ extern pServer pServ;
pRes->lMagic = CONMAGIC;
pRes->eInterrupt = eContinue;
pRes->iDummy = 0;
pRes->iLogin = 0;
pRes->conStart = time(NULL);
pRes->write = SCNormalWrite;
for(i = 0; i < 10; i++)
{
@ -812,6 +822,179 @@ extern pServer pServ;
free(pPtr);
return iRet;
}
/*------------------------------------------------------------------------*/
#define ZIPBUF 8192
int SCWriteZipped(SConnection *self, char *pName, void *pData, int iDataLen)
{
char outBuf[65546], *pBuf = NULL, noutBuf[ZIPBUF];
int compressedLength, iRet, iRet2, iCount;
z_stream compStream;
/* check for a valid connection */
if(!VerifyConnection(self))
{
return 0;
}
/* a telnet connection will corrupt the compressed stream, so
stop it!
*/
if(self->iTelnet)
{
SCWrite(self,
"ERROR: the telnet protocoll will currupt compressed data!",
eError);
return 0;
}
/* initialize the compression stuff */
compStream.zalloc = (alloc_func)NULL;
compStream.zfree = (free_func)NULL;
compStream.opaque = (voidpf)NULL;
iRet = deflateInit(&compStream,Z_DEFAULT_COMPRESSION);
if(iRet != Z_OK)
{
sprintf(outBuf,"ERROR: zlib error: %d",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
/* first pass: find out how the long the compressed buffer will be */
compressedLength = 0;
compStream.next_in = (Bytef *)pData;
compStream.next_out = (Bytef *)outBuf;
compStream.avail_in = iDataLen;
compStream.avail_out = 65536;
while(compStream.total_in < iDataLen)
{
iRet = deflate(&compStream,Z_NO_FLUSH);
if(iRet != Z_OK)
{
sprintf(outBuf,"ERROR: zlib error: %d",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
compStream.next_out = (Bytef *)outBuf;
compStream.avail_out = 65536;
}
for(;;)
{
iRet = deflate(&compStream,Z_FINISH);
if(iRet == Z_STREAM_END) break;
if(iRet != Z_OK)
{
sprintf(outBuf,"ERROR: zlib error: %d",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
}
compressedLength = compStream.total_out;
deflateEnd(&compStream);
/* write header line */
memset(outBuf,0,65536);
sprintf(outBuf,"SICSBIN ZIP %s %d\r\n",pName,compressedLength);
SCWrite(self,outBuf,eValue);
/* now reset the deflater and do the same with writing data */
compStream.zalloc = (alloc_func)NULL;
compStream.zfree = (free_func)NULL;
compStream.opaque = (voidpf)NULL;
/*
This is writing everything in one go as I found that writing in
several chunks did not ensure that all the data arrived at the
Java side.
*/
iRet = deflateInit(&compStream,Z_DEFAULT_COMPRESSION);
if(iRet != Z_OK)
{
sprintf(outBuf,"ERROR: zlib error: %d",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
pBuf = (char *)malloc((iDataLen + iDataLen/10 + 50)*sizeof(char));
compStream.next_in = (Bytef *)pData;
compStream.next_out = (Bytef *)pBuf;
compStream.avail_in = iDataLen;
compStream.avail_out = iDataLen + iDataLen/10 + 50;
iRet = deflate(&compStream,Z_FINISH);
if(iRet != Z_STREAM_END && iRet != Z_OK)
{
sprintf(outBuf,"ERROR: zlib error: %d",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
iRet = NETWrite(self->pSock,pBuf,compStream.total_out);
if(iRet != 1)
{
sprintf(outBuf,"ERROR: network error %d on zipped send",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
deflateEnd(&compStream);
/*
Writing smaller buffers. Seems not to be working properly
with Java.
*/
/*
compStream.next_in = (Bytef *)pData;
compStream.avail_in = iDataLen;
compStream.avail_out = ZIPBUF;
compStream.next_out = (Bytef *)noutBuf;
iCount = 0;
while(compStream.total_in < iDataLen)
{
iRet = deflate(&compStream,Z_NO_FLUSH);
if(iRet != Z_OK)
{
sprintf(outBuf,"ERROR: zlib error: %d",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
iRet = NETWrite(self->pSock,noutBuf,ZIPBUF - compStream.avail_out);
if(iRet != 1)
{
sprintf(outBuf,"ERROR: network error %d on zipped send",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
iCount += ZIPBUF - compStream.avail_out;
compStream.next_out = (Bytef *)noutBuf;
compStream.avail_out = ZIPBUF;
}
for(;;)
{
iRet = deflate(&compStream,Z_FINISH);
iRet2 = NETWrite(self->pSock,noutBuf,ZIPBUF - compStream.avail_out);
if(iRet2 != 1)
{
sprintf(outBuf,"ERROR: network error %d on zipped send",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
iCount += ZIPBUF - compStream.avail_out;
if(iRet == Z_STREAM_END) break;
if(iRet != Z_OK)
{
sprintf(outBuf,"ERROR: zlib error: %d",iRet);
SCWrite(self,outBuf,eError);
return 0;
}
compStream.next_out = (Bytef *)noutBuf;
compStream.avail_out = ZIPBUF;
}
deflateEnd(&compStream);
*/
return 1;
}
/*-------------------------------------------------------------------------*/
int SCSendOK(SConnection *self)
{
@ -1382,6 +1565,7 @@ extern pServer pServ;
SConnection *self = NULL;
char *pPtr = NULL;
int iRet;
char *pUser = NULL, *pPassword = NULL;
self = (SConnection *)pData;
if(!VerifyConnection(self))
@ -1401,6 +1585,14 @@ extern pServer pServ;
}
}
/* a timeout check on logins */
if(!self->iLogin && time(NULL) > self->conStart + 120)
{
NetReadRemove(pServ->pReader,self->pSock);
SCWrite(self, "No valid login in two minutes, closing..",eError);
self->iEnd = 1;
return 1;
}
/* pop and execute */
iRet = CostaPop(self->pStack,&pPtr);
@ -1408,13 +1600,50 @@ extern pServer pServ;
{
if(pPtr)
{
if(self->iLogin)
{
/*
normal processing, logged in
but check for logoff
*/
if(strstr(pPtr,"logoff") != NULL)
{
NetReadRemove(pServ->pReader,self->pSock);
self->iEnd = 1;
free(pPtr);
return 1;
}
/* invoke command */
CostaLock(self->pStack);
SCInvoke(self,self->pSics,pPtr);
CostaUnlock(self->pStack);
/* SCWrite(self,"\b",eError); */
}
else
{
/* check for username and password */
pUser = strtok(pPtr," \t");
pPassword = strtok(NULL," \t\r\n");
iRet = IsValidUser(pUser,pPassword);
if(iRet >= 0)
{
SCWrite(self,"Login OK",eError);
self->iLogin = 1;
SCSetRights(self,iRet);
free(pPtr);
return 1;
}
else
{
SCWrite(self,"ERROR: Bad login",eError);
}
}
free(pPtr);
}
}
if(self->iEnd)
{
if(self->inUse != 0)

7
conman.h
View File

@ -58,6 +58,12 @@
/* Tasking Stuff */
int iEnd;
/* for keeping track of the login
process on a non telnet connection.
Should only be used in SCTaskFunction
*/
int iLogin;
time_t conStart;
}SConnection;
#include "nserver.h"
@ -81,6 +87,7 @@
int SCSendOK(SConnection *self);
int SCnoSock(SConnection *pCon);
int SCWriteUUencoded(SConnection *pCon, char *pName, void *iData, int iLen);
int SCWriteZipped(SConnection *pCon, char *pName, void *pData, int iDataLen);
/************************* CallBack *********************************** */
int SCRegister(SConnection *pCon, SicsInterp *pSics,
void *pInter, long lID);

46
d_mod.c Normal file
View File

@ -0,0 +1,46 @@
#include "f2c.h"
#ifdef KR_headers
#ifdef IEEE_drem
double drem();
#else
double floor();
#endif
double d_mod(x,y) doublereal *x, *y;
#else
#ifdef IEEE_drem
double drem(double, double);
#else
#undef abs
#include "math.h"
#ifdef __cplusplus
extern "C" {
#endif
#endif
double d_mod(doublereal *x, doublereal *y)
#endif
{
#ifdef IEEE_drem
double xa, ya, z;
if ((ya = *y) < 0.)
ya = -ya;
z = drem(xa = *x, ya);
if (xa > 0) {
if (z < 0)
z += ya;
}
else if (z > 0)
z -= ya;
return z;
#else
double quotient;
if( (quotient = *x / *y) >= 0)
quotient = floor(quotient);
else
quotient = -floor(-quotient);
return(*x - (*y) * quotient );
#endif
}
#ifdef __cplusplus
}
#endif

18
d_sign.c Normal file
View File

@ -0,0 +1,18 @@
#include "f2c.h"
#ifdef __cplusplus
extern "C" {
#endif
#ifdef KR_headers
double d_sign(a,b) doublereal *a, *b;
#else
double d_sign(doublereal *a, doublereal *b)
#endif
{
double x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
}
#ifdef __cplusplus
}
#endif

2
danu.dat
View File

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

9
devexec.c
View File

@ -832,10 +832,15 @@
/*--------------------------------------------------------------------------*/
int isInRunMode(pExeList self)
{
assert(self);
if(self == NULL)
{
return 0;
}
else
{
return self->iRun;
}
}
/*--------------------------------------------------------------------------*/
SConnection *GetExeOwner(pExeList self)
{

4
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,7 +154,9 @@ extern char EL734_IllgText[256];
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
fowrite.c
View File

@ -419,7 +419,7 @@
NXDputalias(pFile,pDict,"cntime",&fVal);
lVal = GetHistMonitor(self->pHist,1,pCon);
NXDputalias(pFile,pDict,"cnmon1",&lVal);
lVal = GetHistMonitor(self->pHist,2,pCon);
lVal = GetHistMonitor(self->pHist,0,pCon);
NXDputalias(pFile,pDict,"cnmon2",&lVal);

4
hardsup/Makefile
View File

@ -9,12 +9,16 @@ OBJ= el734_utility.o asynsrv_utility.o stredit.o \
makeprint.o StrMatch.o
#---------- for Redhat linux
#CC= gcc
#CFLAGS= -I. -I../ -DLINUX -g -c
## CC= gcc
## CFLAGS= -I. -I../ -DLINUX -g -c
#------------ for DigitalUnix
CC=cc
CFLAGS= -I. -I../ -std1 -g -c
CC=cc
CFLAGS= -I. -I../ -std1 -g -c
#------------ for DigitalUnix with Fortify
## CC=cc

2
hardsup/el734_utility.c
View File

@ -2581,7 +2581,7 @@
#include <time.h>
struct timespec delay = {0, 250000000};
struct timespec delay_left;
#define hibernate nanosleep (&delay, &delay_left)
#define hibernate nanosleep_d9 (&delay, &delay_left)
#endif
int msr, ss;
struct EL734info *info_ptr;

2
hardsup/el737_utility.c
View File

@ -1711,7 +1711,7 @@
#include <time.h>
struct timespec delay = {0, 250000000};
struct timespec delay_left;
#define hibernate nanosleep (&delay, &delay_left)
#define hibernate nanosleep_d9 (&delay, &delay_left)
#endif
int my_rs;
struct EL737info *info_ptr;

3
hardsup/sinqhm.c
View File

@ -269,6 +269,7 @@ extern int close(int fp);
Req_buff.cmnd = htonl (SQHM_CONFIG);
Req_buff.u.cnfg.mode = htonl (iMode);
Req_buff.u.cnfg.u.hm_dig.n_hists = htonl (iRank);
printf("%d\n", ntohl(Req_buff.u.cnfg.u.hm_dig.n_hists));
Req_buff.u.cnfg.u.hm_dig.lo_bin = htonl (iLowBin);
Req_buff.u.cnfg.u.hm_dig.num_bins = htonl (iLength);
Req_buff.u.cnfg.u.hm_dig.bytes_per_bin = htonl (iBinWidth);
@ -465,7 +466,7 @@ extern int close(int fp);
/* fill in the request data structure */
Req_buff.bigend = htonl (0x12345678);
Req_buff.cmnd = htonl (SQHM_DBG);
Req_buff.u.dbg.level = htonl(iLevel);
Req_buff.u.dbg.mask = htonl(iLevel);
/* try, get a connection to master server */
status = OpenMasterConnection(self);

143
hardsup/sinqhm_def.h
View File

@ -4,7 +4,13 @@
**
**------------------------------------------------------------------------------
*/
#define SINQHM_DEF_ID "V02G"
#define SINQHM_DEF_ID "V03C"
#ifdef __alpha
#ifndef __vms
#pragma nomember_alignment
#endif
#endif
/*------------------------------------------------------------------------------
*/
#ifndef OffsetOf
@ -20,6 +26,7 @@
#define MAX_TOF_NBINS 32768 /* The maximum number of bins in a TOF histog */
#define MAX_TOF_EDGE 16 /* The maximum number of TOF edge arrays */
#define VMIO_BASE_ADDR 0x1900 /* VME address of a (possible) VMIO10 module */
#define IDENT_MSGE_LEN 256 /* Length of Ident info for SQHM_IDENT */
#define uchar unsigned char
#define usint unsigned short int
@ -56,6 +63,8 @@
#define SQHM_DBG 0x05
#define SQHM_DECONFIG 0x06
#define SQHM_EXIT 0x07
#define SQHM_IDENT 0x0e
#define SQHM_PROJECT 0x0d
#define SQHM_READ 0x08
#define SQHM_SELECT 0x09
#define SQHM_STATUS 0x0a
@ -68,7 +77,7 @@
#define SQHM__HM_DIG 0x2000 /* Hist mode (with digitised read-out) */
#define SQHM__TOF 0x3000 /* Time-of-Flight mode */
#define SQHM__HM_PSD 0x4000 /* Hist mode (with Pos-sens-detect read-out) */
#define SQHM__HRPT 0x5000 /* Histogram mode for HRPT cerca detector */
#define SQHM__HRPT 0x5000 /* Hist mode for HRPT */
/*
** Define the various sub-mode bits of the operation modes
*/
@ -83,7 +92,8 @@
#define SQHM__BO_CNT 0x10 /* Keep counts of overflow bins */
#define SQHM__STROBO 0x20 /* Use strobo-bit information */
#define SQHM__REFLECT 0x40 /* reflect histogram */
#define SQHM__REFLECT 0x40 /* Reflect histograms */
#define SQHM__NO_STAT 0x80 /* Suppress status info from "Filler" */
/*
** ----------------------------------------------------------
** SQHM_DAQ sub-function codes
@ -94,11 +104,32 @@
#define DAQ__INH 0x03
#define DAQ__STOP 0x04
#define DAQ__TST 0x05
/*
** ----------------------------------------------------------
** SQHM_PROJECT sub-codes
*/
#define PROJECT__ON_Y 0x0001 /* Project onto y-axis */
#define PROJECT__1_DIM 0x0002 /* Make projection of a 1-dim histogram */
/*
** ----------------------------------------------------------
** Definition of bits in <flag> of TOF edge-array
*/
#define FLAG__VAR_BIN 0x01 /* Bin span of histogram is variable */
/*
** ----------------------------------------------------------
** Definition of bits in <flags> of SQHM_STATUS response
*/
#define STATUS_FLAGS__PF 0x8000 /* PF - Power Fail */
#define STATUS_FLAGS__SWC 0x4000 /* SWC - Status Word Changed */
#define STATUS_FLAGS__NRL 0x2000 /* NRL - Neutron Rate Low */
#define STATUS_FLAGS__DAQ 0x1000 /* DAQ on -- set if Hdr Mask Bits are
** correct so that data acq is active */
#define STATUS_FLAGS__SYNC3 0x0800 /* Ext Synch Bit #3 */
#define STATUS_FLAGS__SYNC2 0x0400 /* Ext Synch Bit #2 */
#define STATUS_FLAGS__SYNC1 0x0200 /* Ext Synch Bit #1 */
#define STATUS_FLAGS__SYNC0 0x0100 /* Ext Synch Bit #0 */
#define STATUS_FLAGS__UD 0x0080 /* UD - Up/Down */
#define STATUS_FLAGS__GU 0x0040 /* GU - Gummi (i.e. Strobo) */
/*
** ----------------------------------------------------------
*/
@ -107,6 +138,12 @@
#define N_TOTAL_BYTES 0x400000 /* Maximum total bytes of histogram */
/*
**------------------------------------------------------------------------------
** Definitions of Filler states in HRPT mode
*/
#define HRPT__SRCH_FRAME 1
#define HRPT__READ_FRAME 2
/*
**------------------------------------------------------------------------------
** Definitions for the LWL Datagrams
*/
#define LWL_HDR_TYPE_MASK (0x1f000000) /* Mask for extracting main dgrm ..
@ -114,12 +151,25 @@
#define LWL_HDR_PF_MASK (0x80000000) /* Mask for extr Power Fail bit */
#define LWL_HDR_SWC_MASK (0x40000000) /* Mask for extr Status Word Chng bit */
#define LWL_HDR_NRL_MASK (0x20000000) /* Mask for extr Neutron Rate Low bit */
#define LWL_HDR_UD_MASK (0x00200000) /* Mask for extr Up/Down bit */
#define LWL_HDR_BA_MASK (0x00f00000) /* Mask for extr Binning Addr */
#define LWL_HDR_TS_MASK (0x000fffff) /* Mask for extr Time Stamp */
#define LWL_HDR_SYNC3_MASK (0x00800000) /* Mask for one of ext synch bits */
#define LWL_HDR_SYNC2_MASK (0x00400000) /* Mask for one of ext synch bits */
#define LWL_HDR_SYNC1_MASK (0x00200000) /* Mask for one of ext synch bits */
#define LWL_HDR_SYNC0_MASK (0x00100000) /* Mask for one of ext synch bits */
#define LWL_HDR_UD_MASK LWL_HDR_SYNC1_MASK /* Mask for Up/Down bit */
#define LWL_HDR_GU_MASK LWL_HDR_SYNC0_MASK /* Mask for GU bit */
#define LWL_HDR_BA_MASK (0x00f00000) /* Mask for TSI Binning Addr */
#define LWL_HDR_TS_MASK (0x000fffff) /* Mask for TSI Time Stamp */
#define LWL_HDR_TYPE_NRL (LWL_HDR_TYPE_MASK | LWL_HDR_NRL_MASK) /* Mask for ..
** .. extracting dgrm type + NRL bit */
#define LWL_FIFO_EMPTY (0x1e000000) /* FIFO Empty */
#define LWL_TSI_TR (0x1f000000) /* Time-Status-Info Transp-Mode */
#define LWL_TSI_HM_NC (0x1f000000) /* Time-Status-Info Hist-Mode+No-Coinc */
#define LWL_TSI_HM_C (0x0e000000) /* Time-Status-Info Hist-Mode+Coinc */
#define LWL_TSI_TOF (0x1f000000) /* Time-Status-Info TOF-Mode */
#define LWL_TSI_SM_NC (0x1f000000) /* Time-Status-Info Strobo-Mode+No-Coin */
#define LWL_TSI_SM_C (0x0e000000) /* Time-Status-Info Strobo-Mode+Coinc */
#define LWL_TSI_DT_MSK (0x000fffff) /* Mask for Dead-Time in TSI */
#define LWL_TSI_DTS_MSK (0x000fffff) /* Mask for Delay-Time-to-Start in TSI */
#define LWL_TR_C1 (0x00000001) /* Transp. Mode Chan 1 */
#define LWL_TR_C2 (0x00000002) /* Transp. Mode Chan 2 */
@ -184,16 +234,15 @@
#define LWL_SM_CO_C8 (0x18000000) /* Strobo-Mode + Coinc 8 chan dgrm hdr */
#define LWL_SM_CO_C9 (0x19000000) /* Strobo-Mode + Coinc 9 chan dgrm hdr */
#define LWL_TS_TR (0x1f000000) /* Transp-Mode Time Status Info */
#define LWL_TS_HM_NC (0x1f000000) /* Hist-Mode/No-Coinc Time Stat Info */
#define LWL_TS_HM_TOF (0x1f000000) /* TOF-Mode Time Status Info */
#define LWL_TS_SM_NC_TOF (0x1f000000) /* Strobo-Mode/No-Coin Time Stat Info */
#define LWL_ETS_TR (0x0e000000) /* Transp-Mode Ext Time Status Info */
#define LWL_ETS_HM_C (0x0e000000) /* Hist-Mode+Coinc Time Status Info */
#define LWL_ETS_SM_C (0x0e000000) /* Strobo-Mode+Coinc Time Status Info */
#define LWL_FIFO_EMPTY (0x1e000000) /* FIFO Empty */
#define LWL_TSI_MODE_MASK (0x000e) /* Mask for mode in Time Status Info */
#define LWL_TSI_MODE_TR (0x0000) /* TSI Transparent-Mode */
#define LWL_TSI_MODE_HM (0x0002) /* TSI Hist-Mode */
#define LWL_TSI_MODE_TOF (0x0004) /* TSI TOF-Mode */
#define LWL_TSI_MODE_SM1 (0x0006) /* TSI Strobo-Mode 1 - time-stamp coded */
#define LWL_TSI_MODE_TR_UD (0x0008) /* TSI Transparent-Mode Up-Down */
#define LWL_TSI_MODE_HM_UD (0x000a) /* TSI Hist-Mode Up-Down */
#define LWL_TSI_MODE_TOF_UD (0x000c) /* TSI TOF-Mode Up-Down */
#define LWL_TSI_MODE_SM2 (0x000e) /* TSI Strobo-Mode 2 - h/w coded */
/*
**------------------------------------------------------------------------------
** Define structure of a TOF histogram data item.
@ -286,12 +335,20 @@
} u;
} cnfg;
struct {uint level;} dbg;
struct {uint mask;} dbg;
struct {uint sub_code;} decnfg;
struct {uint sub_cmnd;} daq;
struct {uint sub_code,
x_lo,
nx,
y_lo,
ny,
xdim,
nhist;} project;
struct {uint hist_no,
first_bin,
n_bins;} read;
@ -314,8 +371,8 @@
*/
struct rply_buff_struct { /* For messages from SinqHM */
uint bigend;
uint status,
sub_status;
uint status;
uint sub_status;
union {
char message[52];
@ -330,13 +387,34 @@
uint total_bytes;
uint lo_cntr;
uint lo_bin;
uint compress;} cnct;
uint compress;
uint up_time;} cnct;
struct {usint daq_now;
usint daq_was;
usint filler_mask;
usint server_mask;} daq;
struct {uint n_extra_bytes;
uint up_time;
usint offset_vxWorks_ident;
usint offset_vxWorks_date;
usint offset_instr;
usint offset_def_ident;
usint offset_sinqhm_main_ident;
usint offset_sinqhm_main_date;
usint offset_sinqhm_server_ident;
usint offset_sinqhm_server_date;
usint offset_sinqhm_filler_ident;
usint offset_sinqhm_filler_date;
usint offset_sinqhm_routines_ident;
usint offset_sinqhm_routines_date;} ident;
struct {uint n_bins;
uint bytes_per_bin;
uint cnts_lo;
uint cnts_hi;} project;
struct {uint first_bin;
uint n_bins;
uint bytes_per_bin;
@ -344,18 +422,21 @@
uint cnts_hi;} read;
struct {uint cfg_state;
usint n_hists;
usint curr_hist;
usint n_hists, curr_hist;
uint num_bins;
uint max_n_hists;
uint max_num_bins;
uchar max_srvrs;
uchar act_srvrs;
uchar bytes_per_bin;
uchar compress;
usint daq_now;
usint filler_mask;
uint max_block;} status;
uchar max_srvrs, act_srvrs, bytes_per_bin, compress;
usint daq_now, filler_mask;
uint max_block;
usint tsi_status, flags;
union {
uint dead_time;
uint dts;
uint both;
} dt_or_dts;
uint num_bad_events;
uint up_time;} status;
} u;
};
/*

82
histmem.c
View File

@ -8,6 +8,8 @@
revised: Mark Koennecke, June 1997
added getzip: Mark Koennecke, October 2000
Copyright:
Labor fuer Neutronenstreuung
@ -1555,6 +1557,86 @@
/* Write it */
SCWriteUUencoded(pCon,"SicsHistogram",lData,(iEnd+1)*sizeof(HistInt));
/* clean up and go */
free(lData);
return 1;
}
else if(strcmp(argv[1],"zipget") == 0) /* get a histogram */
{
/* check parameters, first required: no of Hist */
if(argc < 3)
{
sprintf(pBueffel,"ERROR: insufficient number of arguments to %s %s",
argv[0], argv[1]);
SCWrite(pCon,pBueffel,eError);
return 0;
}
iNum = atoi(argv[2]);
/* check iNum */
if( (iNum < 0) || (iNum > self->pDriv->iRank))
{
sprintf(pBueffel,"ERROR: requested histogram no %d out of range",
iNum);
SCWrite(pCon,pBueffel,eError);
return 0;
}
/* optional iStart, default 0 */
iStart = 0;
if(argc > 3 )
{
iStart = atoi(argv[3]);
}
/* check iStart */
if(iStart < 0)
{
SCWrite(pCon,"WARNING: Invalid start position defaulted to 0",eWarning);
iStart = 0;
}
/* optional iEnd, default to maximum */
iEnd = self->pDriv->iLength;
if(argc > 4)
{
iEnd = atoi(argv[4]);
}
/* check iEnd */
if(iEnd > self->pDriv->iLength)
{
iEnd = self->pDriv->iLength;
SCWrite(pCon,
"WARNING: invalid end parameter reset to max ",eWarning);
}
/* allocate data storage and get it */
lData = (HistInt *)malloc((iEnd+1)*sizeof(HistInt));
if(!lData)
{
SCWrite(pCon,"ERROR: no memory in HistAction/get",eError);
return 0;
}
memset(lData,0,(iEnd+1)*sizeof(HistInt));
iRet = GetHistogram(self,pCon,iNum,iStart,iEnd,
&lData[0],iEnd*sizeof(HistInt));
if(!iRet)
{
sprintf(pBueffel,"ERROR: cannot retrieve histogram %d",iNum);
SCWrite(pCon,pBueffel,eError);
free(lData);
return 0;
}
/* convert to network byte order */
for(i = 0; i < iEnd; i++)
{
lData[i] = htonl(lData[i]);
}
/* Write it */
SCWriteZipped(pCon,argv[0],lData,iEnd*sizeof(HistInt));
/* clean up and go */
free(lData);
return 1;

4
histsim.c
View File

@ -51,9 +51,9 @@
#include "HistDriv.i"
#include "histsim.h"
/*
#define TESTVAL 128
/*
define TESTVAL to set the simulated histogram to a fixed value for
testing
@ -188,6 +188,8 @@
static int SimSetHistogram(pHistDriver self, SConnection *pCon,
int i, int iStart, int iEnd, HistInt *lData)
{
iSet = 1;
iSetVal = lData[0];
return 1;
}

7
hklscan.c
View File

@ -187,7 +187,7 @@
/* print an addon to the status line going to the screen */
sprintf(pLine,"NP H K L ");
SCWrite(self->pCon,pLine,eWarning);
sprintf(pLine,"%-5d%-6.2f%-6.2f%-6.2f ",iPoint,pHaSca->fPos[0],
sprintf(pLine,"%-5d%-8.4f%-8.4f%-8.4f ",iPoint,pHaSca->fPos[0],
pHaSca->fPos[1], pHaSca->fPos[2]);
SCWrite(self->pCon,pLine,eWarning);
@ -198,7 +198,7 @@
/* print HKL */
for(i2 = 0; i2 < 3; i2++)
{
sprintf(pItem,"%-6.2f",pHaSca->fStart[i2] + i * pHaSca->fStep[i2]);
sprintf(pItem,"%-8.4f",pHaSca->fStart[i2] + i * pHaSca->fStep[i2]);
strcat(pLine,pItem);
}
/* print chi, ph, om */
@ -217,7 +217,7 @@
pData = (pCountEntry)pPtr;
if(pData)
{
sprintf(pItem,"%-12ld",pData->lCount);
sprintf(pItem,"%-13ld",pData->lCount);
strcat(pLine,pItem);
sprintf(pItem,"%-12ld",pData->Monitors[0]);
strcat(pLine,pItem);
@ -261,6 +261,7 @@
self->pScan->WriteScanPoints = WriteHklscanPoint;
self->pScan->ScanDrive = HklscanDrive;
self->pScan->pSpecial = self;
self->pScan->PrepareScan = NonCheckPrepare;
/* scan */
iRet = DoScan(self->pScan,iNP, iMode, fPreset, pServ->pSics,pCon);

5
network.c
View File

@ -47,6 +47,7 @@
#include <netdb.h>
#include <arpa/inet.h>
#include <assert.h>
#include <errno.h>
#define PORT 1
#define SOCKET 2
@ -393,7 +394,9 @@ CreateSocketAdress(
iRet = select( (self->sockid + 1),&lMask, NULL, NULL,&tmo);
if( iRet <= 0)
{
/* failure, or no data */
/* failure, or no data
printf(" %d %d\n", iRet, errno);
*/
return 0;
}
}

211
nextrics.c
View File

@ -12,6 +12,8 @@
copyright: see copyright.h
Mark Koennecke, April 1998
Revised: Mark Koennecke, October 2000
----------------------------------------------------------------------------*/
#include <stdlib.h>
#include <assert.h>
@ -30,12 +32,17 @@
#include "udpquieck.h"
#include "nextrics.h"
#define DET1X 128 /* x -length of detector 1 */
#define DET1Y 128 /* y-length of detector 1 */
#define DET1X 256 /* x -length of detector 1 */
#define DET1Y 256 /* y-length of detector 1 */
#define DET1XS 2 /* pixel size in x of detector 1 */
#define DET1YS 2 /* pixel size in y of detector 1 */
#define DET1DESC "Non existent Detector"
#define DETAMAX 128 /* maximum length of pixelsize array */
#define DETAMAX 256 /* maximum length of pixelsize array */
/* histogram memory names */
#define HM1 "hm1"
#define HM2 "hm2"
#define HM3 "hm3"
/*------------------------ the data structure ----------------------------*/
typedef struct __NexTrics {
@ -44,10 +51,14 @@
char *pFileRoot;
pDataNumber pDanu;
NXdict pDict;
pHistMem pHistogram;
pHistMem pHistogram1, pHistogram2, pHistogram3;
int iFirst;
int iFrameNum;
pICallBack pCall;
} NexTrics;
/* event type */
#define NEWFRAME 1166
/*----------------------------------------------------------------------*/
pNexTrics CreateNexTrics(pDataNumber pNum, char *pRoot, char *pDict,
SicsInterp *pSics)
@ -64,9 +75,10 @@
}
memset(pNew,0,sizeof(NexTrics));
/* new object descriptor */
pNew->pDes = CreateDescriptor("NexTrics");
if(!pNew->pDes)
/* new object descriptor and callback interface */
pNew->pDes = CreateDescriptor(HM1);
pNew->pCall = CreateCallBackInterface();
if(!pNew->pDes || !pNew->pCall)
{
free(pNew);
return NULL;
@ -83,14 +95,33 @@
pNew->pDanu = pNum;
/* find things in interpreter */
pCom = FindCommand(pSics,"banana");
pCom = FindCommand(pSics,HM1);
if(!pCom)
{
DeleteNexTrics(pNew);
return NULL;
}
pNew->pHistogram = (pHistMem)pCom->pData;
pNew->pHistogram1 = (pHistMem)pCom->pData;
pCom = FindCommand(pSics,HM2);
if(pCom)
{
pNew->pHistogram2 = (pHistMem)pCom->pData;
}
else
{
pNew->pHistogram2 = NULL;
}
pCom = FindCommand(pSics,HM3);
if(pCom)
{
pNew->pHistogram3 = (pHistMem)pCom->pData;
}
else
{
pNew->pHistogram3 = NULL;
}
pNew->iFirst = 1;
pNew->iFrameNum = 0;
return pNew;
}
@ -115,6 +146,9 @@
if(self->pDict)
NXDclose(self->pDict,NULL);
if(self->pCall)
DeleteCallBackInterface(self->pCall);
free(self);
}
/*---------------------- a neXus error handler ---------------------------*/
@ -215,7 +249,7 @@
}
/* write counting parameters */
eMode = GetHistCountMode(self->pHistogram);
eMode = GetHistCountMode(self->pHistogram1);
if(eMode == eTimer)
{
strcpy(pBueffel,"Timer");
@ -225,14 +259,14 @@
strcpy(pBueffel,"Monitor");
}
NXDputalias(hfil,self->pDict,"framemode",pBueffel);
fVal = GetHistPreset(self->pHistogram);
fVal = GetHistPreset(self->pHistogram1);
NXDputalias(hfil,self->pDict,"framepreset",&fVal);
lVal = GetHistMonitor(self->pHistogram,1,pCon);
lVal = GetHistMonitor(self->pHistogram1,1,pCon);
iVal = (int32)lVal;
NXDputalias(hfil,self->pDict,"framemonitor",&iVal);
/* write detector1 histogram */
GetHistogram(self->pHistogram,pCon,0,0,DET1X*DET1Y,lData,DET1X*DET1Y*sizeof(HistInt));
GetHistogram(self->pHistogram1,pCon,0,0,DET1X*DET1Y,lData,DET1X*DET1Y*sizeof(HistInt));
NXDputalias(hfil,self->pDict,"framecounts",lData);
/* the NXdata links */
@ -274,6 +308,7 @@
/* make sure: first frame */
NXDupdate(self->pDict,"framename","frame0000");
self->iFrameNum = 0;
/* title */
pVar = NULL;
@ -308,7 +343,7 @@
{
SCWrite(pCon,"ERROR: failed to write source name",eError);
}
strcpy(pBueffel,"Continous flux spallation source");
strcpy(pBueffel,"Spallation Neutron Source");
iRet = NXDputalias(hfil,self->pDict,"stype",pBueffel);
if(iRet != NX_OK)
{
@ -510,6 +545,8 @@
{
SCWrite(pCon,"ERROR: failed to write initial frame number",eError);
}
self->iFrameNum = 1;
InvokeCallBack(self->pCall, NEWFRAME,&(self->iFrameNum));
self->iFirst = 0;
@ -552,6 +589,8 @@
sprintf(pBueffel,"frame%4.4d", iFrameNum);
NXDupdate(self->pDict,"framename",pBueffel);
iFrameNum++;
self->iFrameNum++;
InvokeCallBack(self->pCall, NEWFRAME,&(self->iFrameNum));
iRet = NXDputalias(hfil,self->pDict,"fnum",&iFrameNum);
if(iRet != NX_OK)
{
@ -675,6 +714,8 @@
pCon);
self->iFirst = 1;
self->iFrameNum = 0;
InvokeCallBack(self->pCall, NEWFRAME,&(self->iFrameNum));
/* close the file and go */
NXclose(&hfil);
@ -692,7 +733,6 @@
/* concat with data root and check for existence */
sprintf(pBueffel,"%s/%s",self->pFileRoot,filename);
iRet = NXopen(pBueffel,NXACC_RDWR,&hfil);
NXclose(&hfil);
if(iRet != NX_OK)
{
return 0;
@ -714,6 +754,8 @@
{
self->iFirst = 0;
}
self->iFrameNum = iFrameNum;
InvokeCallBack(self->pCall, NEWFRAME,&(self->iFrameNum));
return 1;
}
/*--------------------------------------------------------------------------*/
@ -735,13 +777,122 @@
return iRet;
}
/*-------------------------------------------------------------------------*/
static int FrameInterest(int iEvent, void *pEvent, void *pUser)
{
SConnection *pCon = NULL;
int *iFrame;
char pBueffel[512];
if(iEvent != NEWFRAME)
{
return 0;
}
pCon = (SConnection *)pUser;
iFrame = (int *)pEvent;
assert(pCon);
sprintf(pBueffel,"framenumber = %d",*iFrame);
SCWrite(pCon,pBueffel,eWarning);
return 1;
}
/*-------------------------------------------------------------------------
NexusGetFrame opens a TRICS NeXus file and retrieves a frame for the
specified detector from it. This is a specila feature for the
status display.
---------------------------------------------------------------------------*/
static int NexusGetFrame(SConnection *pCon, pNexTrics self,
int iDetector, int iFrame)
{
char pBueffel[132];
int iRet;
NXhandle hfil;
HistInt *lData = NULL;
/* do a few range checks */
if(iDetector < 1 || iDetector > 3)
{
sprintf(pBueffel,"ERROR: unknown detector %d requested",iDetector);
return 0;
}
if(iFrame < 0 || iFrame >= self->iFrameNum)
{
sprintf(pBueffel,"ERROR: farme %d not yet written",iDetector);
return 0;
}
/* open file */
iRet = NXopen(self->pCurrentFile,NXACC_READ,&hfil);
if(iRet != NX_OK)
{
sprintf(pBueffel,"ERROR: cannot open %s",self->pCurrentFile);
SCWrite(pCon,pBueffel,eError);
return 0;
}
/* open groups */
sprintf(pBueffel,"frame%4.4d",iFrame);
iRet = NXopengroup(hfil,pBueffel,"NXentry");
if(iRet != NX_OK)
{
sprintf(pBueffel,"ERROR: frame %d not found in %s",iFrame,
self->pCurrentFile);
SCWrite(pCon,pBueffel,eError);
NXclose(&hfil);
return 0;
}
sprintf(pBueffel,"detector%1.1d",iDetector);
iRet = NXopengroup(hfil,pBueffel,"NXdata");
if(iRet != NX_OK)
{
sprintf(pBueffel,"ERROR: detector %d not found in %s",iFrame,
self->pCurrentFile);
SCWrite(pCon,pBueffel,eError);
NXclose(&hfil);
return 0;
}
iRet = NXopendata(hfil,"counts");
if(iRet != NX_OK)
{
SCWrite(pCon,"ERROR: no counts found, file corrupted",eError);
NXclose(&hfil);
return 0;
}
/* read data */
lData = (HistInt *)malloc(DET1X*DET1Y*sizeof(HistInt));
if(!lData)
{
SCWrite(pCon,"ERROR: out of memory in NexusGetFrame",eError);
NXclose(&hfil);
return 0;
}
memset(lData,0,DET1X*DET1Y*sizeof(HistInt));
iRet = NXgetdata(hfil,lData);
if(iRet != NX_OK)
{
SCWrite(pCon,"ERROR: failed to read data",eError);
NXclose(&hfil);
return 0;
}
/* send it */
sprintf(pBueffel,"detector%1.1d",iDetector);
SCWriteZipped(pCon,pBueffel,lData,DET1X*DET1Y*sizeof(HistInt));
/* clean up */
NXclose(&hfil);
free(lData);
return 1;
}
/*---------------------------------------------------------------------------*/
int NexTricsAction(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[])
{
pNexTrics self;
char pBueffel[1024];
int iRet;
int iRet, iDet, iFrame;
long lID;
self = (pNexTrics)pData;
assert(self);
@ -778,6 +929,33 @@
SCWrite(pCon,pBueffel,eValue);
return 1;
}
else if(strcmp(argv[1],"oldframe") == 0)
{
if(argc < 4)
{
SCWrite(pCon,"ERROR: insufficient number of arguments to oldframe",
eError);
return 0;
}
iDet = atoi(argv[2]);
iFrame = atoi(argv[3]);
iRet = NexusGetFrame(pCon,self,iDet, iFrame);
return 1;
}
else if(strcmp(argv[1],"interest") == 0)
{
lID = RegisterCallback(self->pCall, NEWFRAME, FrameInterest,
pCon, NULL);
SCRegister(pCon,pSics, self->pCall,lID);
SCSendOK(pCon);
return 1;
}
else if(strcmp(argv[1],"framenum") == 0)
{
sprintf(pBueffel,"framenumber = %d",self->iFrameNum);
SCWrite(pCon,pBueffel,eValue);
return 1;
}
else if(strcmp(argv[1],"dumpframe") == 0)
{
if(!SCMatchRights(pCon,usUser))
@ -813,3 +991,4 @@
SCWrite(pCon,pBueffel,eError);
return 0;
}

32
nread.c
View File

@ -8,6 +8,10 @@
Mark Koennecke, September 1997
Telnet Functionality added: Mark Koennecke, January 1998
Revamped login to non telnet connection.
Mark Koennecke, October 20000
-----------------------------------------------------------------------------*/
#include <stdlib.h>
#include <assert.h>
@ -174,6 +178,7 @@ extern VerifyChannel(mkChannel *self); /* defined in network.c */
int iRet;
SConnection *pRes = NULL;
char *pUser = NULL, *pPasswd = NULL;
time_t target;
if(!VerifyChannel(pSock))
{
@ -183,31 +188,6 @@ extern VerifyChannel(mkChannel *self); /* defined in network.c */
/* check for new connection */
pNew = NETAccept(pSock,0);
if(pNew)
{ /* new connection, read user/passwd, verify and work accordingly */
iRet = NETRead(pNew,pBuffer,1063, self->iPasswdTimeout);
if(iRet <= 0)
{
strcpy(pBuffer,"Timeout waiting for username/password");
SICSLogWrite(pBuffer,eInternal);
NETClosePort(pNew);
free(pNew);
return 0;
}
else
{
pUser = strtok(pBuffer," \t");
pPasswd = strtok(NULL," \t\r\n");
iRet = IsValidUser(pUser,pPasswd);
if(iRet < 0)
{
sprintf(pBuffer,"SYSTEM ATTACK by %s / %s",pUser,
pPasswd);
SICSLogWrite(pBuffer,eInternal);
NETClosePort(pNew);
free(pNew);
return 0;
}
else
{
/* create connection object */
pRes = SCreateConnection(self->pMain->pSics,pNew,iRet);
@ -232,8 +212,6 @@ extern VerifyChannel(mkChannel *self); /* defined in network.c */
return 1;
}
}
}
}
else
{
return 0;

3
ofac.c
View File

@ -102,6 +102,7 @@
#include "difrac.h"
#include "sicscron.h"
#include "lin2ang.h"
#include "tas.h"
/*----------------------- Server options creation -------------------------*/
static int IFServerOption(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[])
@ -273,6 +274,7 @@
AddCommand(pInter,"MakeMaximize",MaximizeFactory,NULL,NULL);
AddCommand(pInter,"MakeDifrac",MakeDifrac,NULL,NULL);
AddCommand(pInter,"MakeLin2Ang",MakeLin2Ang,NULL,NULL);
AddCommand(pInter,"MakeTAS",TASFactory,NULL,NULL);
}
/*---------------------------------------------------------------------------*/
static void KillIniCommands(SicsInterp *pSics)
@ -323,6 +325,7 @@
RemoveCommand(pSics,"MakeMaximize");
RemoveCommand(pSics,"MakeDifrac");
RemoveCommand(pSics,"MakeLin2Ang");
RemoveCommand(pSics,"MakeTAS");
}

72
scan.c
View File

@ -441,6 +441,7 @@ extern void SNXFormatTime(char *pBuffer, int iLen);
static int ScanDrive(pScanData self, int iPoint);
static int ScanCount(pScanData self, int iPoint);
static int CollectScanData(pScanData self, int iPoint);
static int PrepareScan(pScanData self);
/*--------------------------------------------------------------------------*/
pScanData CreateScanObject(char *pRecover, char *pHeader,pCounter pCount)
{
@ -493,6 +494,7 @@ extern void SNXFormatTime(char *pBuffer, int iLen);
pNew->fPreset = 10.;
strcpy(pNew->pCounterName,pCount->name);
pNew->pCounterData = pCount;
pNew->PrepareScan = PrepareScan;
pNew->WriteHeader = WriteHeader;
pNew->WriteScanPoints = WriteScanPoints;
pNew->ScanDrive = ScanDrive;
@ -540,6 +542,7 @@ extern void SNXFormatTime(char *pBuffer, int iLen);
{
assert(self);
self->PrepareScan = PrepareScan;
self->WriteHeader = WriteHeader;
self->WriteScanPoints = WriteScanPoints;
self->ScanDrive = ScanDrive;
@ -825,6 +828,60 @@ extern void SNXFormatTime(char *pBuffer, int iLen);
return 1;
}
/*--------------------------------------------------------------------------*/
int NonCheckPrepare(pScanData self)
{
pVarEntry pVar = NULL;
void *pDings;
int i, iRet;
float fVal;
char pBueffel[512];
char pMessage[1024];
assert(self);
assert(self->iNP > 0);
assert(self->pCon);
/* allocate storage for scan variables */
for(i = 0; i < self->iScanVar; i++)
{
DynarGet(self->pScanVar,i,&pDings);
pVar = (pVarEntry)pDings;
if(pVar)
{
/* start value */
fVal = pVar->fStart;
/* allocate data space */
if(pVar->fData)
{
free(pVar->fData);
pVar->fData = NULL;
}
pVar->fData = (float *)malloc(self->iNP * sizeof(float));
if(!pVar->fData)
{
SCWrite(self->pCon,"ERROR: out of memory in scan, aborting",eError);
return 0;
}
memset(pVar->fData,0,self->iNP * sizeof(float));
}
else
{
SCWrite(self->pCon,
"WARNING: Internal error, no scan variable, I try to continue",
eWarning);
}
pVar = NULL;
} /* end for */
/* configure counter */
SetCounterMode((pCounter)self->pCounterData,self->iMode);
SetCounterPreset((pCounter)self->pCounterData, self->fPreset);
self->iCounts = 0;
return 1;
}
/*--------------------------------------------------------------------------*/
static int StartToDrive(pScanData self, int iPoint)
{
pVarEntry pVar = NULL;
@ -1129,6 +1186,7 @@ extern void SNXFormatTime(char *pBuffer, int iLen);
/*-------- scan post processing */
self->CollectScanData(self,i);
InvokeCallBack(self->pCall,SCANPOINT,self);
self->WriteScanPoints(self,i);
if(self->pRecover)
{
@ -1178,7 +1236,14 @@ extern void SNXFormatTime(char *pBuffer, int iLen);
self->fPreset = fPreset;
/* do some preprocessing */
iRet = PrepareScan(self);
if(self->PrepareScan != NULL)
{
iRet = self->PrepareScan(self);
}
else
{
iRet = 1;
}
if(!iRet)
{
self->pCon = NULL;
@ -2381,3 +2446,8 @@ extern void SNXFormatTime(char *pBuffer, int iLen);
return 0;
}
}

7
scan.h
View File

@ -52,7 +52,12 @@
/*
resets the configurable scan functions to their default values.
*/
int NonCheckPrepare(pScanData self);
/*
a function for the PrepareScan field in the scan data structure
which does not check the boundaries of the scan as the default
PrepareScan does.
*/
/*------------------------ Interpreter Interface --------------------------*/
int ScanFactory(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);

1
scan.i
View File

@ -38,6 +38,7 @@
SConnection *pCon;
char pRecover[1024];
char pHeaderFile[1024];
int (*PrepareScan)(pScanData self);
int (*WriteHeader)(pScanData self);
int (*WriteScanPoints)
(pScanData self,

17
scan.tex
View File

@ -66,6 +66,7 @@ $\langle$scandata {\footnotesize ?}$\rangle\equiv$
\mbox{}\verb@ SConnection *pCon;@\\
\mbox{}\verb@ char pRecover[1024];@\\
\mbox{}\verb@ char pHeaderFile[1024];@\\
\mbox{}\verb@ int (*PrepareScan)(pScanData self);@\\
\mbox{}\verb@ int (*WriteHeader)(pScanData self);@\\
\mbox{}\verb@ int (*WriteScanPoints)@\\
\mbox{}\verb@ (pScanData self, @\\
@ -140,6 +141,9 @@ line is permitted.
finding data.
\item[pCon] The connection object to use for error reporting during scan
execution.
\item[PrepareScan] checks limits of scan variables and memorizes
important scan information. Sometimes this is not wanted, that is why
it is parametrized here.
\item[WriteHeader] is a pointer to a function which writes the header part
of the scan file. Replace this function if another data format is needed.
\item[WriteScanPoints] is a pointer to a function which will be called after
@ -221,7 +225,12 @@ $\langle$scaninter {\footnotesize ?}$\rangle\equiv$
\mbox{}\verb@ /*@\\
\mbox{}\verb@ resets the configurable scan functions to their default values.@\\
\mbox{}\verb@ */@\\
\mbox{}\verb@@\\
\mbox{}\verb@ int NonCheckPrepare(pScanData self);@\\
\mbox{}\verb@ /*@\\
\mbox{}\verb@ a function for the PrepareScan field in the scan data structure@\\
\mbox{}\verb@ which does not check the boundaries of the scan as the default@\\
\mbox{}\verb@ PrepareScan does.@\\
\mbox{}\verb@ */@\\
\mbox{}\verb@/*------------------------ Interpreter Interface --------------------------*/@\\
\mbox{}\verb@ int ScanFactory(SConnection *pCon, SicsInterp *pSics, void *pData,@\\
\mbox{}\verb@ int argc, char *argv[]);@\\
@ -279,6 +288,12 @@ summed counts and the variance. See the section on integrate for more
details.
\item[ResetScanFunctions] reinstalls the default functions for scan
processing into the ScanData structure.
\item[NonCheckPrepare] Before a scan is started, various data
structures in the scan object are initialized. Thereby the scan
boundaries are checked against the motor limits. For some scans this
is not feasible. This version omits this check and must be entered as
the PrepareScan function field in the scan data structure by code
using the scan module.
\item[SimScan] creates a simulated gaussian peak with the given
parameters. Used for debugging several things.
\item[ScanFactory] is the SICS interpreter object creation function

17
scan.w
View File

@ -61,6 +61,7 @@ steps in scan processing which is already partly implemented.
SConnection *pCon;
char pRecover[1024];
char pHeaderFile[1024];
int (*PrepareScan)(pScanData self);
int (*WriteHeader)(pScanData self);
int (*WriteScanPoints)
(pScanData self,
@ -128,6 +129,9 @@ line is permitted.
finding data.
\item[pCon] The connection object to use for error reporting during scan
execution.
\item[PrepareScan] checks limits of scan variables and memorizes
important scan information. Sometimes this is not wanted, that is why
it is parametrized here.
\item[WriteHeader] is a pointer to a function which writes the header part
of the scan file. Replace this function if another data format is needed.
\item[WriteScanPoints] is a pointer to a function which will be called after
@ -204,7 +208,12 @@ functions:
/*
resets the configurable scan functions to their default values.
*/
int NonCheckPrepare(pScanData self);
/*
a function for the PrepareScan field in the scan data structure
which does not check the boundaries of the scan as the default
PrepareScan does.
*/
/*------------------------ Interpreter Interface --------------------------*/
int ScanFactory(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
@ -254,6 +263,12 @@ summed counts and the variance. See the section on integrate for more
details.
\item[ResetScanFunctions] reinstalls the default functions for scan
processing into the ScanData structure.
\item[NonCheckPrepare] Before a scan is started, various data
structures in the scan object are initialized. Thereby the scan
boundaries are checked against the motor limits. For some scans this
is not feasible. This version omits this check and must be entered as
the PrepareScan function field in the scan data structure by code
using the scan module.
\item[SimScan] creates a simulated gaussian peak with the given
parameters. Used for debugging several things.
\item[ScanFactory] is the SICS interpreter object creation function

681
sicsstat.tcl
View File

@ -1,406 +1,311 @@
#Crystallographic Settings
hkl lambda 0.703790
hkl setub -0.124702 0.001618 -0.041357 -0.104448 -0.001326 0.049388 0.000751 0.084094 0.001574
lastscancommand UNKNOWN
lastscancommand setAccess 2
sample_mur 0.000000
sample_mur setAccess 2
email UNKNOWN
email setAccess 2
fax UNKNOWN
fax setAccess 2
phone UNKNOWN
phone setAccess 2
adress UNKNOWN
adress setAccess 2
arx2 4.290000
arx2 setAccess 1
arx1 0.150000
arx1 setAccess 1
mrx2 10.420000
mrx2 setAccess 1
mrx1 0.280000
mrx1 setAccess 1
lpa 0
lpa setAccess 2
dt 0.000000
dt setAccess 2
dqm 0.000000
dqm setAccess 2
qm 0.000000
qm setAccess 2
etaa 0.000000
etaa setAccess 2
etas 0.000000
etas setAccess 2
etam 0.000000
etam setAccess 2
wav 0.000000
wav setAccess 2
den 0.000000
den setAccess 2
dql 0.000000
dql setAccess 2
dqk 0.000000
dqk setAccess 2
dqh 0.000000
dqh setAccess 2
dkf 0.000000
dkf setAccess 2
def 0.000000
def setAccess 2
dki 0.000000
dki setAccess 2
dei 0.000000
dei setAccess 2
dagl 0.000000
dagl setAccess 2
dsgu 0.000000
dsgu setAccess 2
dsgl 0.000000
dsgl setAccess 2
dmgl 0.000000
dmgl setAccess 2
datu 0.000000
datu setAccess 2
datl 0.000000
datl setAccess 2
dstu 0.000000
dstu setAccess 2
dstl 0.000000
dstl setAccess 2
dmtu 0.000000
dmtu setAccess 2
dmtl 0.000000
dmtl setAccess 2
dach 0.000000
dach setAccess 2
dsro 0.000000
dsro setAccess 2
dmcv 0.000000
dmcv setAccess 2
da6 0.000000
da6 setAccess 2
da5 0.000000
da5 setAccess 2
da4 0.000000
da4 setAccess 2
da3 0.000000
da3 setAccess 2
da2 0.000000
da2 setAccess 2
da1 0.000000
da1 setAccess 2
f2 0
f2 setAccess 2
f1 0
f1 setAccess 2
hz 0.000000
hz setAccess 2
hy 0.000000
hy setAccess 2
hx 0.000000
hx setAccess 2
helm 0.000000
helm setAccess 2
if2h 0.000000
if2h setAccess 2
if1h 0.000000
if1h setAccess 2
if2v 0.000000
if2v setAccess 2
if1v 0.000000
if1v setAccess 2
mn 0
mn setAccess 2
ti 0.000000
ti setAccess 2
np 9
np setAccess 2
fx 2
fx setAccess 2
sa -1
sa setAccess 2
ss 1
ss setAccess 2
sm 1
sm setAccess 2
da 3.354000
da setAccess 1
dm 3.354000
dm setAccess 1
en 2.800000
en setAccess 2
ql 0.000000
ql setAccess 2
qk 0.000000
qk setAccess 2
qh 2.000000
qh setAccess 2
kf 1.964944
kf setAccess 2
ef 8.000000
ef setAccess 2
ki 2.283058
ki setAccess 2
ei 10.800000
ei setAccess 2
bz 0.000000
bz setAccess 2
by 1.000000
by setAccess 2
bx 0.000000
bx setAccess 2
az 0.000000
az setAccess 2
ay 0.000000
ay setAccess 2
ax 1.000000
ax setAccess 2
cc 90.000000
cc setAccess 2
bb 90.000000
bb setAccess 2
aa 90.000000
aa setAccess 2
cs 5.000000
cs setAccess 2
bs 5.000000
bs setAccess 2
as 5.000000
as setAccess 2
# Counter counter
counter SetPreset 1000.000000
counter SetMode Timer
# Motor a33
a33 SoftZero 0.000000
a33 SoftLowerLim -10.000000
a33 SoftUpperLim 39.500000
a33 Fixed -1.000000
a33 sign 1.000000
a33 InterruptMode 0.000000
a33 AccessCode 2.000000
# Motor a32
a32 SoftZero 0.000000
a32 SoftLowerLim -10.000000
a32 SoftUpperLim 39.500000
a32 Fixed -1.000000
a32 sign 1.000000
a32 InterruptMode 0.000000
a32 AccessCode 2.000000
# Motor a31
a31 SoftZero 0.000000
a31 SoftLowerLim -10.000000
a31 SoftUpperLim 39.500000
a31 Fixed -1.000000
a31 sign 1.000000
a31 InterruptMode 0.000000
a31 AccessCode 2.000000
# Motor ph
ph SoftZero 0.000000
ph SoftLowerLim 318.000000
ph SoftUpperLim 0.000000
ph Fixed -1.000000
ph sign 1.000000
ph InterruptMode 0.000000
ph AccessCode 2.000000
# Motor chi
chi SoftZero 0.000000
chi SoftLowerLim 270.000000
chi SoftUpperLim 70.000000
chi Fixed -1.000000
chi sign 1.000000
chi InterruptMode 0.000000
chi AccessCode 2.000000
# Motor ch
ch SoftZero 0.000000
ch SoftLowerLim 270.000000
ch SoftUpperLim 70.000000
ch Fixed -1.000000
ch sign 1.000000
ch InterruptMode 0.000000
ch AccessCode 2.000000
# Motor a20
a20 SoftZero 0.000000
a20 SoftLowerLim 318.000000
a20 SoftUpperLim 0.000000
a20 Fixed -1.000000
a20 sign 1.000000
a20 InterruptMode 0.000000
a20 AccessCode 2.000000
# Motor a10
a10 SoftZero 0.000000
a10 SoftLowerLim 270.000000
a10 SoftUpperLim 70.000000
a10 Fixed -1.000000
a10 sign 1.000000
a10 InterruptMode 0.000000
a10 AccessCode 2.000000
# Motor th
th SoftZero 0.000000
th SoftLowerLim -17.000000
th SoftUpperLim 69.000000
th Fixed -1.000000
th sign 1.000000
th InterruptMode 0.000000
th AccessCode 2.000000
# Motor agl
agl SoftZero -0.490000
agl SoftLowerLim -9.510000
agl SoftUpperLim 10.490000
agl Fixed -1.000000
agl sign 1.000000
agl InterruptMode 0.000000
agl AccessCode 2.000000
# Motor sgu
sgu SoftZero 0.000000
sgu SoftLowerLim -16.000000
sgu SoftUpperLim 16.000000
sgu Fixed -1.000000
sgu sign 1.000000
sgu InterruptMode 0.000000
sgu AccessCode 2.000000
# Motor sgl
sgl SoftZero 1.550000
sgl SoftLowerLim -17.549999
sgl SoftUpperLim 14.450000
sgl Fixed -1.000000
sgl sign 1.000000
sgl InterruptMode 0.000000
sgl AccessCode 2.000000
# Motor mgl
mgl SoftZero 1.300000
mgl SoftLowerLim -11.300000
mgl SoftUpperLim 8.700000
mgl Fixed -1.000000
mgl sign 1.000000
mgl InterruptMode 0.000000
mgl AccessCode 2.000000
# Motor atu
atu SoftZero -0.880000
atu SoftLowerLim -16.120001
atu SoftUpperLim 17.879999
atu Fixed -1.000000
atu sign 1.000000
atu InterruptMode 0.000000
atu AccessCode 2.000000
# Motor atl
atl SoftZero 0.000000
atl SoftLowerLim -17.000000
atl SoftUpperLim 17.000000
atl Fixed -1.000000
atl sign 1.000000
atl InterruptMode 0.000000
atl AccessCode 2.000000
# Motor stu
stu SoftZero 0.000000
stu SoftLowerLim -30.000000
stu SoftUpperLim 30.000000
stu Fixed -1.000000
stu sign 1.000000
stu InterruptMode 0.000000
stu AccessCode 2.000000
# Motor stl
stl SoftZero 0.000000
stl SoftLowerLim -30.000000
stl SoftUpperLim 30.000000
stl Fixed -1.000000
stl sign 1.000000
stl InterruptMode 0.000000
stl AccessCode 2.000000
# Motor mtu
mtu SoftZero 2.850000
mtu SoftLowerLim -19.850000
mtu SoftUpperLim 14.150000
mtu Fixed -1.000000
mtu sign 1.000000
mtu InterruptMode 0.000000
mtu AccessCode 2.000000
# Motor mtl
mtl SoftZero 0.000000
mtl SoftLowerLim -17.000000
mtl SoftUpperLim 17.000000
mtl Fixed -1.000000
mtl sign 1.000000
mtl InterruptMode 0.000000
mtl AccessCode 2.000000
# Motor ach
ach SoftZero 0.000000
ach SoftLowerLim -0.500000
ach SoftUpperLim 11.500000
ach Fixed -1.000000
ach sign 1.000000
ach InterruptMode 0.000000
ach AccessCode 2.000000
# Motor sro
sro SoftZero 0.000000
sro SoftLowerLim 0.000000
sro SoftUpperLim 351.000000
sro Fixed -1.000000
sro sign 1.000000
sro InterruptMode 0.000000
sro AccessCode 2.000000
# Motor mcv
mcv SoftZero 0.000000
mcv SoftLowerLim -9.000000
mcv SoftUpperLim 124.000000
mcv Fixed -1.000000
mcv sign 1.000000
mcv InterruptMode 0.000000
mcv AccessCode 2.000000
# Motor a6
a6 SoftZero 0.040000
a6 SoftLowerLim -116.040001
a6 SoftUpperLim 165.960007
a6 Fixed -1.000000
a6 sign 1.000000
a6 InterruptMode 0.000000
a6 AccessCode 2.000000
# Motor a5
a5 SoftZero 176.479996
a5 SoftLowerLim -376.479980
a5 SoftUpperLim 23.520004
a5 Fixed -1.000000
a5 sign 1.000000
a5 InterruptMode 0.000000
a5 AccessCode 2.000000
# Motor a4
a4 SoftZero 0.000000
a4 SoftLowerLim -17.000000
a4 SoftUpperLim 69.000000
a4 SoftZero -0.710000
a4 SoftLowerLim -134.389999
a4 SoftUpperLim 124.110001
a4 Fixed -1.000000
a4 sign 1.000000
a4 InterruptMode 0.000000
a4 AccessCode 2.000000
# Motor om
om SoftZero 0.000000
om SoftLowerLim -9.000000
om SoftUpperLim 33.000000
om Fixed -1.000000
om sign 1.000000
om InterruptMode 0.000000
om AccessCode 2.000000
# Motor a3
a3 SoftZero 0.000000
a3 SoftLowerLim -9.000000
a3 SoftUpperLim 33.000000
a3 SoftZero 11.540000
a3 SoftLowerLim -188.839996
a3 SoftUpperLim 165.760010
a3 Fixed -1.000000
a3 sign 1.000000
a3 InterruptMode 0.000000
a3 AccessCode 2.000000
# Motor a37
a37 SoftZero 0.000000
a37 SoftLowerLim 0.000000
a37 SoftUpperLim 555.000000
a37 Fixed -1.000000
a37 sign 1.000000
a37 InterruptMode 0.000000
a37 AccessCode 2.000000
# Motor a26
a26 SoftZero 0.000000
a26 SoftLowerLim 0.000000
a26 SoftUpperLim 10.000000
a26 Fixed -1.000000
a26 sign 1.000000
a26 InterruptMode 0.000000
a26 AccessCode 2.000000
# Motor a25
a25 SoftZero 0.000000
a25 SoftLowerLim -3.000000
a25 SoftUpperLim 5.500000
a25 Fixed -1.000000
a25 sign 1.000000
a25 InterruptMode 0.000000
a25 AccessCode 2.000000
# Motor a24
a24 SoftZero 0.000000
a24 SoftLowerLim -6.000000
a24 SoftUpperLim 3.000000
a24 Fixed -1.000000
a24 sign 1.000000
a24 InterruptMode 0.000000
a24 AccessCode 2.000000
# Motor a23
a23 SoftZero 0.000000
a23 SoftLowerLim -10.000000
a23 SoftUpperLim 10.000000
a23 Fixed -1.000000
a23 sign 1.000000
a23 InterruptMode 0.000000
a23 AccessCode 2.000000
# Motor a22
a22 SoftZero 0.000000
a22 SoftLowerLim -9.500000
a22 SoftUpperLim 10.000000
a22 Fixed -1.000000
a22 sign 1.000000
a22 InterruptMode 0.000000
a22 AccessCode 2.000000
# Motor b1
b1 SoftZero 0.000000
b1 SoftLowerLim -160.000000
b1 SoftUpperLim 160.000000
b1 Fixed -1.000000
b1 sign 1.000000
b1 InterruptMode 0.000000
b1 AccessCode 2.000000
# Motor a16
a16 SoftZero 0.000000
a16 SoftLowerLim 0.000000
a16 SoftUpperLim 10.000000
a16 Fixed -1.000000
a16 sign 1.000000
a16 InterruptMode 0.000000
a16 AccessCode 2.000000
# Motor a15
a15 SoftZero 0.000000
a15 SoftLowerLim -3.000000
a15 SoftUpperLim 6.000000
a15 Fixed -1.000000
a15 sign 1.000000
a15 InterruptMode 0.000000
a15 AccessCode 2.000000
# Motor a14
a14 SoftZero 0.000000
a14 SoftLowerLim -5.500000
a14 SoftUpperLim 3.000000
a14 Fixed -1.000000
a14 sign 1.000000
a14 InterruptMode 0.000000
a14 AccessCode 2.000000
# Motor a13
a13 SoftZero 0.000000
a13 SoftLowerLim -10.000000
a13 SoftUpperLim 9.500000
a13 Fixed -1.000000
a13 sign 1.000000
a13 InterruptMode 0.000000
a13 AccessCode 2.000000
# Motor a12
a12 SoftZero 0.000000
a12 SoftLowerLim -10.000000
a12 SoftUpperLim 10.000000
a12 Fixed -1.000000
a12 sign 1.000000
a12 InterruptMode 0.000000
a12 AccessCode 2.000000
# Motor a2
a2 SoftZero -0.010000
a2 SoftLowerLim 33.109997
a2 SoftUpperLim 120.010002
a2 Fixed -1.000000
a2 sign 1.000000
a2 InterruptMode 0.000000
a2 AccessCode 2.000000
# Motor a1
a1 SoftZero 0.000000
a1 SoftLowerLim 120.000000
a1 SoftUpperLim 15.000000
a1 SoftZero 0.590000
a1 SoftLowerLim -0.590000
a1 SoftUpperLim 110.410004
a1 Fixed -1.000000
a1 sign 1.000000
a1 InterruptMode 0.000000
a1 AccessCode 2.000000
# Motor cex2
cex2 SoftZero 0.000000
cex2 SoftLowerLim -400.000000
cex2 SoftUpperLim 400.000000
cex2 Fixed -1.000000
cex2 sign 1.000000
cex2 InterruptMode 0.000000
cex2 AccessCode 2.000000
# Motor cex1
cex1 SoftZero 0.000000
cex1 SoftLowerLim -400.000000
cex1 SoftUpperLim 400.000000
cex1 Fixed -1.000000
cex1 sign 1.000000
cex1 InterruptMode 0.000000
cex1 AccessCode 2.000000
# Motor dg3
dg3 SoftZero 0.000000
dg3 SoftLowerLim -10.000000
dg3 SoftUpperLim 39.500000
dg3 Fixed -1.000000
dg3 sign 1.000000
dg3 InterruptMode 0.000000
dg3 AccessCode 2.000000
# Motor dg2
dg2 SoftZero 0.000000
dg2 SoftLowerLim -10.000000
dg2 SoftUpperLim 39.500000
dg2 Fixed -1.000000
dg2 sign 1.000000
dg2 InterruptMode 0.000000
dg2 AccessCode 2.000000
# Motor dg1
dg1 SoftZero 0.000000
dg1 SoftLowerLim -10.000000
dg1 SoftUpperLim 39.500000
dg1 Fixed -1.000000
dg1 sign 1.000000
dg1 InterruptMode 0.000000
dg1 AccessCode 2.000000
# Motor sph
sph SoftZero 0.000000
sph SoftLowerLim 318.000000
sph SoftUpperLim 0.000000
sph Fixed -1.000000
sph sign 1.000000
sph InterruptMode 0.000000
sph AccessCode 2.000000
# Motor sch
sch SoftZero 0.000000
sch SoftLowerLim 270.000000
sch SoftUpperLim 70.000000
sch Fixed -1.000000
sch sign 1.000000
sch InterruptMode 0.000000
sch AccessCode 2.000000
# Motor stt
stt SoftZero 0.000000
stt SoftLowerLim -17.000000
stt SoftUpperLim 69.000000
stt Fixed -1.000000
stt sign 1.000000
stt InterruptMode 0.000000
stt AccessCode 2.000000
# Motor som
som SoftZero 0.000000
som SoftLowerLim -9.000000
som SoftUpperLim 33.000000
som Fixed -1.000000
som sign 1.000000
som InterruptMode 0.000000
som AccessCode 2.000000
# Motor mexz
mexz SoftZero 0.000000
mexz SoftLowerLim 0.000000
mexz SoftUpperLim 555.000000
mexz Fixed -1.000000
mexz sign 1.000000
mexz InterruptMode 0.000000
mexz AccessCode 2.000000
# Motor mcvl
mcvl SoftZero 0.000000
mcvl SoftLowerLim 0.000000
mcvl SoftUpperLim 10.000000
mcvl Fixed -1.000000
mcvl sign 1.000000
mcvl InterruptMode 0.000000
mcvl AccessCode 2.000000
# Motor mgpl
mgpl SoftZero 0.000000
mgpl SoftLowerLim -3.000000
mgpl SoftUpperLim 5.500000
mgpl Fixed -1.000000
mgpl sign 1.000000
mgpl InterruptMode 0.000000
mgpl AccessCode 2.000000
# Motor mgvl
mgvl SoftZero 0.000000
mgvl SoftLowerLim -6.000000
mgvl SoftUpperLim 3.000000
mgvl Fixed -1.000000
mgvl sign 1.000000
mgvl InterruptMode 0.000000
mgvl AccessCode 2.000000
# Motor mtpl
mtpl SoftZero 0.000000
mtpl SoftLowerLim -10.000000
mtpl SoftUpperLim 10.000000
mtpl Fixed -1.000000
mtpl sign 1.000000
mtpl InterruptMode 0.000000
mtpl AccessCode 2.000000
# Motor mtvl
mtvl SoftZero 0.000000
mtvl SoftLowerLim -9.500000
mtvl SoftUpperLim 10.000000
mtvl Fixed -1.000000
mtvl sign 1.000000
mtvl InterruptMode 0.000000
mtvl AccessCode 2.000000
# Motor moml
moml SoftZero 0.000000
moml SoftLowerLim -160.000000
moml SoftUpperLim 160.000000
moml Fixed -1.000000
moml sign 1.000000
moml InterruptMode 0.000000
moml AccessCode 2.000000
# Motor mcvu
mcvu SoftZero 0.000000
mcvu SoftLowerLim 0.000000
mcvu SoftUpperLim 10.000000
mcvu Fixed -1.000000
mcvu sign 1.000000
mcvu InterruptMode 0.000000
mcvu AccessCode 2.000000
# Motor mgpu
mgpu SoftZero 0.000000
mgpu SoftLowerLim -3.000000
mgpu SoftUpperLim 6.000000
mgpu Fixed -1.000000
mgpu sign 1.000000
mgpu InterruptMode 0.000000
mgpu AccessCode 2.000000
# Motor mgvu
mgvu SoftZero 0.000000
mgvu SoftLowerLim -5.500000
mgvu SoftUpperLim 3.000000
mgvu Fixed -1.000000
mgvu sign 1.000000
mgvu InterruptMode 0.000000
mgvu AccessCode 2.000000
# Motor mtpu
mtpu SoftZero 0.000000
mtpu SoftLowerLim -10.000000
mtpu SoftUpperLim 9.500000
mtpu Fixed -1.000000
mtpu sign 1.000000
mtpu InterruptMode 0.000000
mtpu AccessCode 2.000000
# Motor mtvu
mtvu SoftZero 0.000000
mtvu SoftLowerLim -10.000000
mtvu SoftUpperLim 10.000000
mtvu Fixed -1.000000
mtvu sign 1.000000
mtvu InterruptMode 0.000000
mtvu AccessCode 2.000000
# Motor momu
momu SoftZero 0.000000
momu SoftLowerLim 120.000000
momu SoftUpperLim 15.000000
momu Fixed -1.000000
momu sign 1.000000
momu InterruptMode 0.000000
momu AccessCode 2.000000
lambda 0.000000
lambda setAccess 1
monochromator UNKNOWN
monochromator setAccess 2
distance 0.000000
distance setAccess 2
user Daniel_the_Clementine
user setAccess 2
sample DanielOxid
sample setAccess 2
title TopsiTupsiTapsi
title setAccess 2

36
sicsstatus.tcl
View File

@ -11,6 +11,12 @@ hm genbin 120.000000 35.000000 512
hm init
datafile focus-1001848.hdf
datafile setAccess 3
hm3 CountMode timer
hm3 preset 100.000000
hm2 CountMode timer
hm2 preset 100.000000
hm1 CountMode timer
hm1 preset 100.000000
dbfile UNKNOWN
dbfile setAccess 2
# Motor th
@ -23,7 +29,7 @@ th InterruptMode 0.000000
th AccessCode 2.000000
#Crystallographic Settings
hkl lambda 1.179000
hkl setub -0.019370 0.077484 -0.004944 0.077493 0.019386 0.002155 0.001034 -0.001344 -0.254040
hkl setub 0.087418 -0.158308 0.006979 0.158247 0.087630 0.005560 -0.008243 0.003417 0.180755
det1dist 300.
det1dist setAccess 1
det1zeroy 128.
@ -60,7 +66,7 @@ ch InterruptMode 0.000000
ch AccessCode 2.000000
# Motor ph
ph SoftZero 0.000000
ph SoftLowerLim 0.000000
ph SoftLowerLim -360.000000
ph SoftUpperLim 360.000000
ph Fixed -1.000000
ph sign 1.000000
@ -84,7 +90,7 @@ muca InterruptMode 0.000000
muca AccessCode 2.000000
# Motor phi
phi SoftZero 0.000000
phi SoftLowerLim 0.000000
phi SoftLowerLim -360.000000
phi SoftUpperLim 360.000000
phi Fixed -1.000000
phi sign 1.000000
@ -117,7 +123,7 @@ twotheta AccessCode 2.000000
lastscancommand UNKNOWN
lastscancommand setAccess 2
banana CountMode timer
banana preset 10.000000
banana preset 100.000000
sample_mur 0.000000
sample_mur setAccess 2
email UNKNOWN
@ -129,11 +135,11 @@ phone setAccess 2
adress UNKNOWN
adress setAccess 2
# Counter counter
counter SetPreset 10.000000
counter SetPreset 1.000000
counter SetMode Timer
# Motor som
som SoftZero 0.000000
som SoftLowerLim 0.000000
som SoftLowerLim -360.000000
som SoftUpperLim 360.000000
som Fixed -1.000000
som sign 1.000000
@ -236,9 +242,9 @@ d1l sign 1.000000
d1l InterruptMode 0.000000
d1l AccessCode 2.000000
# Motor d1r
d1r SoftZero 2.000000
d1r SoftLowerLim -22.000000
d1r SoftUpperLim 18.000000
d1r SoftZero 0.000000
d1r SoftLowerLim -20.000000
d1r SoftUpperLim 20.000000
d1r Fixed -1.000000
d1r sign 1.000000
d1r InterruptMode 0.000000
@ -316,9 +322,9 @@ mgu sign 1.000000
mgu InterruptMode 0.000000
mgu AccessCode 2.000000
# Motor stu
stu SoftZero -10.000000
stu SoftLowerLim -20.000000
stu SoftUpperLim 40.000000
stu SoftZero 0.000000
stu SoftLowerLim -30.000000
stu SoftUpperLim 30.000000
stu Fixed -1.000000
stu sign 1.000000
stu InterruptMode 0.000000
@ -373,7 +379,7 @@ a4 InterruptMode 0.000000
a4 AccessCode 2.000000
# Motor a3
a3 SoftZero 0.000000
a3 SoftLowerLim 0.000000
a3 SoftLowerLim -360.000000
a3 SoftUpperLim 360.000000
a3 Fixed -1.000000
a3 sign 1.000000
@ -397,9 +403,9 @@ a1 InterruptMode 0.000000
a1 AccessCode 2.000000
user Daniel_the_Clementine
user setAccess 2
sample shit at 10.000000
sample DanielOxid
sample setAccess 2
title TopsiTupsiTapsi
title setAccess 2
starttime 2000-08-22 15:23:15
starttime UNKNOWN
starttime setAccess 2

830
t_conv.c Normal file
View File

@ -0,0 +1,830 @@
/* t_conv.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 icrm, icra, iclm;
real cm1rx, cm2rx, ca1rx, ca2rx, rmmin, rmmax, ramin, ramax;
integer inx;
logical at_sinq__;
} curve_;
#define curve_1 curve_
/* Table of constant values */
static integer c__0 = 0;
static integer c__1 = 1;
static doublereal c_b10 = 1.;
static doublereal c_b12 = 360.;
/* ------------------------------------------------------------------------ */
/* slightly edited version for inclusion into SICS */
/* Mark Koennecke, November 2000 */
/* ------------------------------------------------------------------------- */
/* Subroutine */ int inicurve_(integer *midx, real *mrx1, real *mrx2, integer
*aidx, real *arx1, real *arx2, real *mmin, real *mmax, real *amin,
real *amax)
{
/* Initializes a common with the curvature parameters. */
/* In: monochrmoator curvatuure motor index and parameters */
/* In: analyzer curvature motor index + parameters */
curve_1.icrm = *midx;
curve_1.icra = *aidx;
curve_1.cm1rx = *mrx1;
curve_1.cm2rx = *mrx2;
curve_1.ca1rx = *arx1;
curve_1.ca2rx = *arx2;
curve_1.rmmin = *mmin;
curve_1.rmmax = *mmax;
curve_1.ramin = *amin;
curve_1.ramax = *amax;
curve_1.inx = 0;
curve_1.at_sinq__ = TRUE_;
curve_1.iclm = 0;
return 0;
} /* inicurve_ */
/* -------------------------------------------------------------------------- */
/* 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 *t_ra__, real *qm, logical *
ldra, logical *ldr_rm__, logical *ldr_alm__, logical *ldr_ra__, 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, dqs, dqt[3];
extern /* Subroutine */ int ex_case__(doublereal *, integer *, doublereal
*, doublereal *, doublereal *, doublereal *, doublereal *,
integer *, integer *);
/* ================= */
/* dec$ ident 'V01D' */
/* ----------------------------------------------------------------------- */
/* Other routines in this file: */
/* 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) */
/* ----------------------------------------------------------------------- */
/* INPUTS */
/* 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) */
/* OUTPUTs */
/* T_A TARGETS OF ANGLES A1-A6 */
/* T_RM,T_ALM TARGETS OF RM ,LM */
/* T_RA TARGET OF RA */
/* QM TARGETS OF QM */
/* LDRA LOGICAL INDICATING WHICH ANGLES ARE TO BE DRIVEN */
/* LDR_RM LOGICAL INDICATING IF RM (mono curve) IS TO BE DRIVEN */
/* LDR_ALM LOGICAL INDICATING IF ALM (mono transl) IS TO BE DRIVEN */
/* LDR_RA LOGICAL INDICATING IF RA (anal curve) IS 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 */
/* ----------------------------------------------------------------------- */
/* File [MAD.SRC]T_CONV.FOR */
/* include 'curve.inc' */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* ----------------------------------------------------------------------- */
/* 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] < .1f) {
goto L999;
}
*ier = 0;
akdef[0] = sqrt(edef[0] / *f);
} else {
*ier = 1;
if (akdef[0] < .1f) {
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-4f) {
goto L999;
}
*ier = 0;
akdef[1] = sqrt(edef[1] / *f);
} else {
*ier = 1;
if (akdef[1] < 1e-4f) {
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-4f) {
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, &c__0, ier);
if (*ier == 0) {
*aki = daki;
*ei = dei;
t_a__[1] = a1;
t_a__[2] = a2;
ldra[1] = TRUE_;
ldra[2] = TRUE_;
if (curve_1.icrm != 0) {
*t_rm__ = rm;
*ldr_rm__ = TRUE_;
}
if (curve_1.iclm != 0 && curve_1.inx != 0) {
*t_alm__ = alm;
*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, &c__1, ier);
if (*ier == 0) {
*akf = dakf;
*ef = def;
t_a__[5] = a5;
t_a__[6] = a6;
ldra[5] = TRUE_;
ldra[6] = TRUE_;
if (curve_1.icra != 0) {
*t_ra__ = ra;
*ldr_ra__ = 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 *mon_or_anal__, integer *ier)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double asin(doublereal), sin(doublereal), cos(doublereal), sqrt(
doublereal);
/* Local variables */
static integer indx;
static doublereal dcl1r, dc1rx, dc2rx, drmin, drmax, my_rx__, arg;
/* ================== */
/* CALCULATE ANGLES ON MONO/ANALYSER */
/* CALCULATE AX1 AX2 */
/* CALCULATE RX = MONO OR ANAL CURVATURE AND LM = MONO POSIT FOR IN8 */
/* INPUTS */
/* DX D-SPACINGS */
/* ISX SENS OF SCATTERING ON CRYSTAL. If =0, this is probably */
/* a 3-axis instr. in simulated 2-axis mode and the */
/* calculation is for the scattering at the analyser. */
/* In this case, we set AX1 = AX2 = 0 which gives a */
/* "straight-through" setting of A5 & A6 (because of */
/* a simultaneous 90 degree zero offset for A5 -- this */
/* is a bit of a hack, if you ask me!). */
/* AKX TARGET OF MOMENTUM */
/* MON_OR_ANAL =0 if calculation is for mono. */
/* =1 if calculation is for anal. */
/* OUTPUTS */
/* 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', */
/* ----------------------------------------------------------------------- */
/* Part of T_CONV.FOR */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* ----------------------------------------------------------------------- */
/* include 'curve.inc' */
/* include 'motdef.inc' */
/* include 'iolsddef.inc' */
/* real*4 tbut(5,NBMOT) */
/* equivalence (rbut, tbut) */
/* ----------------------------------------------------------------------- */
/* LOCAL VAR */
/* ----------------------------------------------------------------------- */
/* INIT AND TEST */
*ier = 0;
*ax1 = 0.f;
*ax2 = 0.f;
*rx = 0.f;
*alx = 0.f;
/* ---------------------------------------------------------------------- */
/* Check validity of inputs. */
if (*dx < .1) {
*ier = 1;
}
if (*akx < .1) {
*ier = 2;
}
arg = 3.1415926535897932384626433832795 / (*dx * *akx);
if (abs(arg) > 1.f) {
*ier = 3;
}
if (*ier != 0) {
goto L999;
}
/* ---------------------------------------------------------------------- */
if (*mon_or_anal__ == 0) {
/* Use monochr or anal params? */
indx = curve_1.icrm;
/* Monochr, so set up params. */
dc1rx = curve_1.cm1rx;
dc2rx = curve_1.cm2rx;
dcl1r = (doublereal) curve_1.iclm;
drmin = curve_1.rmmin;
drmax = curve_1.rmmax;
} else {
indx = curve_1.icra;
/* Analyser, so set up params. */
dc1rx = curve_1.ca1rx;
/* There is no ALX in this case. */
dc2rx = curve_1.ca2rx;
drmin = curve_1.ramin;
drmax = curve_1.ramax;
}
/* if (indx .ne. 0) then ! Include zero-offset in min/max */
/* drmin = drmin + tbut(3,indx) */
/* drmax = drmax + tbut(3,indx) */
/* if (drmin .lt. tbut(1,indx)) drmin = tbut(1,indx) */
/* if (drmax .gt. tbut(2,indx)) drmax = tbut(2,indx) */
/* endif */
/* ----------------------------------------------------------------------- */
/* Calculation of the two angles */
if (*isx == 0) {
/* "Straight-through" mode? */
*ax1 = 0.f;
/* Yes. */
*ax2 = 0.f;
*rx = drmin;
*alx = 0.f;
return 0;
}
*ax1 = asin(arg) * *isx * 57.29577951308232087679815481410517;
*ax2 = *ax1 * 2.;
/* ----------------------------------------------------------------------- */
/* Calculation of mono curvature RM or analyser curvature RA */
/* Standard law is: */
/* For monochr: */
/* CM1RX + CM2RX/SIN(abs(A1)/RD) */
/* For analyser: */
/* CA1RX + CA2RX*SIN(abs(A5)/RD) */
/* CM1RX/CM2RX/CA1RX/CA2RX are parameters depending on monochr/analyser and */
/* instrument. They are read from CURVE.INI in routine SETUP_MOT_CURVE. */
/* e.g. cm1rx = .47 */
/* cm2rx = .244 */
/* rmmin = 0. */
/* rmmax = 20. */
/* ----------------------------------------------------------------------- */
if (*mon_or_anal__ == 0) {
/* Monochr or analyser? */
if (curve_1.inx != 0) {
/* Monochr. Is there a translation? */
if (curve_1.iclm != 0) {
/* Yes, IN8 case. If there's a .. */
*alx = dcl1r / sin(*ax2 / 57.29577951308232087679815481410517)
* cos(*ax2 / 57.29577951308232087679815481410517);
/* .. motor, do the .. */
*rx = dc2rx * sqrt(sin(abs(*ax2) /
57.29577951308232087679815481410517)) - dc1rx;
/* .. calculation. */
/* Computing MIN */
d__1 = max(*rx,drmin);
*rx = min(d__1,drmax);
return 0;
}
} else {
/* Not IN8 case so, .. */
my_rx__ = dc1rx + dc2rx / sin(abs(*ax1) /
57.29577951308232087679815481410517);
/* .. simply calculate. */
}
} else {
/* Analyser. */
my_rx__ = dc1rx + dc2rx * sin(abs(*ax1) /
57.29577951308232087679815481410517);
/* Simply calculate. */
}
if (indx != 0) {
/* If there's a motor, return the curvature. */
/* Computing MIN */
d__1 = max(my_rx__,drmin);
*rx = min(d__1,drmax);
/* if (rx .ne. my_rx) then */
/* write (iolun, 101, iostat=ios) motnam(indx), my_rx */
/* 101 format (' Warning -- ', a8, 'curvature restricted by low ', */
/* + 'or high limits!'/ */
/* + ' Calculated curvature was', f9.2) */
/* endif */
}
/* ----------------------------------------------------------------------- */
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 VECTOR IN C-N PLANE */
/* CALCULATE A3 AND A4 */
/* INPUTS */
/* 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 */
/* OUTPUTS */
/* 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', */
/* ----------------------------------------------------------------------- */
/* Part of T_CONV.FOR */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* ----------------------------------------------------------------------- */
/* Local variables */
/* ----------------------------------------------------------------------- */
/* 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_b10, ax4)) *
57.29577951308232087679815481410517;
sax3 = d_sign(&c_b10, ax3);
d__1 = *ax3 + sax3 * 180.;
*ax3 = d_mod(&d__1, &c_b12) - 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 */
integer i__1;
real r__1, r__2;
/* Builtin functions */
double cos(doublereal), sin(doublereal), atan2(doublereal, doublereal),
sqrt(doublereal);
/* Local variables */
static doublereal hrad, hdir, qpar, hdir2;
static integer ncoef;
static doublereal qperp;
static integer ic;
static doublereal phi;
static logical at_sinq__;
/* ==================== */
/* DEAL WITH HELMOTZ COIL FIELD CALCULATIONS */
/* CALCULATE HX HY HZ */
/* ----------------------------------------------------------------------- */
/* 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. */
/* ----------------------------------------------------------------------- */
/* Part of T_CONV.FOR */
/* include 'common_sinq.inc' */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* ----------------------------------------------------------------------- */
/* Local variables */
/* ----------------------------------------------------------------------- */
/* INIT AND TEST */
/* Parameter adjustments */
--c_ih__;
--t_ih__;
/* Function Body */
at_sinq__ = TRUE_;
ncoef = 4;
if (at_sinq__) {
ncoef = 3;
}
*ier = 1;
if (dabs(*qm) < 1e-4) {
goto L999;
}
*ier = 0;
i__1 = ncoef;
for (ic = 1; ic <= i__1; ++ic) {
if (c_ih__[ic] < 1e-4) {
*ier = 2;
}
}
if (*ier != 0) {
goto L999;
}
/* ----------------------------------------------------------------------- */
/* CALCULATE MODULE AND ANGLES OF IN PLANE FIELD H */
/* PHI ! Angle between Q and KI (in radians) */
/* HRAD ! Radial comp. of H */
/* HDIR ! Direction of H relative to PHI (in radians) */
/* HDIR2 ! Angle between field and axis of Coil 1 (in radians) */
qpar = *aki - *akf * cos(*a4 / 57.29577951308232087679815481410517);
qperp = -(*akf) * sin(*a4 / 57.29577951308232087679815481410517);
if (abs(qpar) > .001 && abs(qperp) > .001) {
phi = atan2((abs(qperp)), (abs(qpar)));
if (qpar > 0. && qperp < 0.) {
phi = -phi;
} else if (qpar < 0. && qperp > 0.) {
phi = 3.1415926535897932384626433832795 - phi;
} else if (qpar < 0. && qperp < 0.) {
phi += -3.1415926535897932384626433832795;
}
} else if (abs(qpar) > .001) {
if (qpar >= 0.f) {
phi = 0.f;
}
if (qpar < 0.f) {
phi = 3.1415926535897932384626433832795;
}
} else if (abs(qperp) > .001) {
if (qperp >= 0.f) {
phi = 1.5707963267948966;
}
if (qperp < 0.f) {
phi = -1.5707963267948966;
}
} else {
phi = 0.f;
}
/* Computing 2nd power */
r__1 = *hx;
/* Computing 2nd power */
r__2 = *hy;
hrad = sqrt(r__1 * r__1 + r__2 * r__2);
if (dabs(*hx) > .001 && dabs(*hy) > .001) {
hdir = atan2((dabs(*hy)), (dabs(*hx)));
if (*hx > 0.f && *hy < 0.f) {
hdir = -hdir;
} else if (*hx < 0.f && *hy > 0.f) {
hdir = 3.1415926535897932384626433832795 - hdir;
} else if (*hx < 0.f && *hy < 0.f) {
hdir += -3.1415926535897932384626433832795;
}
} else if (dabs(*hx) > .001) {
if (*hx >= 0.f) {
hdir = 0.f;
}
if (*hx < 0.f) {
hdir = 3.1415926535897932384626433832795;
}
} else if (dabs(*hy) > .001) {
if (*hy >= 0.f) {
hdir = 1.5707963267948966;
}
if (*hy < 0.f) {
hdir = -1.5707963267948966;
}
} else {
hdir = 0.f;
}
hdir2 = hdir + phi - *helm / 57.29577951308232087679815481410517;
/* ----------------------------------------------------------------------- */
/* !CALC CURRENTS */
/* !POSITION OF PSP FOR COIL I */
if (! at_sinq__) {
hdir2 += 1.5707963267948966;
/* ??? */
for (ic = 1; ic <= 3; ++ic) {
t_ih__[ic + 4] = cos(hdir2 + (ic - 1) * 2.f *
3.1415926535897932384626433832795 / 3.f) * hrad / c_ih__[
ic] / 1.5f;
}
t_ih__[8] = *hz / c_ih__[4];
} else {
t_ih__[5] = cos(hdir2) * hrad / c_ih__[1];
t_ih__[6] = sin(hdir2) * hrad / c_ih__[2];
t_ih__[7] = *hz / c_ih__[3];
}
/* ----------------------------------------------------------------------- */
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 */
/* ----------------------------------------------------------------------- */
/* Define the dummy arguments */
/* Part of T_CONV.FOR */
/* ----------------------------------------------------------------------- */
/* 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__ */

682
t_conv.f Executable file
View File

@ -0,0 +1,682 @@
C------------------------------------------------------------------------
C slightly edited version for inclusion into SICS
C
C Mark Koennecke, November 2000
C-------------------------------------------------------------------------
SUBROUTINE INICURVE(MIDX, MRX1, MRX2, AIDX, ARX1, ARX2,
+ MMIN, MMAX, AMIN, AMAX)
C
C Initializes a common with the curvature parameters.
C In: monochrmoator curvatuure motor index and parameters
C In: analyzer curvature motor index + parameters
INTEGER MIDX, AIDX
REAL*4 MRX1, MRX2, ARX1, ARX2, MMIN, MMAX, AMIN, AMAX
REAL*4 CM1RX, CM2RX, CA1RX, CA2RX, RMMIN, RMMAX
REAL*4 RAMIN, RAMAX
INTEGER ICRM, ICRA, ICLM, INX
LOGICAL AT_SINQ
COMMON/CURVE/ICRM,ICRA, ICLM, CM1RX, CM2RX, CA1RX, CA2RX,
+ RMMIN, RMMAX, RAMIN, RAMAX, INX, AT_SINQ
ICRM = MIDX
ICRA = AIDX
CM1RX = MRX1
CM2RX = MRX2
CA1RX = ARX1
CA2RX = ARX2
RMMIN = MMIN
RMMAX = MMAX
RAMIN = AMIN
RAMAX = AMAX
INX = 0
AT_SINQ = .TRUE.
ICLM = 0
RETURN
END
C--------------------------------------------------------------------------
SUBROUTINE T_CONV ( ! File [MAD.SRC]T_CONV.FOR
c =================
+ EI, AKI, EF, AKF, QHKL, EN,
+ HX, HY, HZ,
+ IF1, IF2,
+ LDK, LDH, LDF, LPA,
+ DM, DA,
+ HELM, F1H, F1V, F2H, F2V, F,
+ IFX, ISS, ISM, ISA,
+ T_A, T_RM, T_ALM, T_RA, QM,
+ LDRA, LDR_RM, LDR_ALM, LDR_RA,
+ P_IH, C_IH,
+ IER)
c
cdec$ ident 'V01D'
C-----------------------------------------------------------------------
C Other routines in this file:
c
C SUBROUTINE EX_CASE (DX,ISX,AKX,AX1,AX2,RX,ALX,IER)
C SUBROUTINE SAM_CASE (QT,QM,QS,AKI,AKF,AX3,AX4,ISS,IER)
C SUBROUTINE HELM_CASE (HX,HY,HZ,P_IH,AKI,AKF,A4,QM,HELM,IER)
C SUBROUTINE FLIP_CASE (IF1,IF2,P_IH,F1V,F1H,F2V,F2H,AKI,AKF,IER)
C-----------------------------------------------------------------------
C INPUTS
C EI,AKI,EF,AKF,QHKL,EN,HX,HY,HZ : POTENTIAL TARGETS
C IF1,IF2 Status of flippers On (1) Off (0)
C LDK(8) LOGICAL INDICATING IF (ENERGY,K OR Q) ARE DRIVEN
C LDH,LDF LOGICAL INDICATING IF (HX,HY,HZ) OR (F1,F2) ARE DRIVEN
C
C configuration of the machine
c
C LPA LOGICAL TRUE IF MACHINE IN POLARIZATION MODE
C DM,DA,HELM,F1H,F1V,F2H,F2V,F,IFX,ISS,ISM,ISA,QM (F ENERGY UNIT)
C
C OUTPUTs
C T_A TARGETS OF ANGLES A1-A6
C T_RM,T_ALM TARGETS OF RM ,LM
C T_RA TARGET OF RA
C QM TARGETS OF QM
C LDRA LOGICAL INDICATING WHICH ANGLES ARE TO BE DRIVEN
C LDR_RM LOGICAL INDICATING IF RM (mono curve) IS TO BE DRIVEN
C LDR_ALM LOGICAL INDICATING IF ALM (mono transl) IS TO BE DRIVEN
C LDR_RA LOGICAL INDICATING IF RA (anal curve) IS TO BE DRIVEN
C P_IH TARGETS OF CURRENTS FOR FLIPPERS AND HELMOTZ (8 CURRENTS)
C C_IH CONVERSION FACTORS FOR HELMOTZ (4 CURRENTS)
C
C SPECIAL OUTPUTS
C TARGET OF EI(EF) IS UPDATED IS KI(KF) IS DRIVEN
C TARGET OF VARIABLE ENERGY IS UPDATED IF EN IS DRIVEN
C-----------------------------------------------------------------------
implicit none
c
REAL*4 EPS1, EPS4
parameter (EPS1 = 1.D-1)
parameter (EPS4 = 1.D-4)
INTEGER ICRM, ICRA, ICLM, INX
LOGICAL AT_SINQ
REAL*4 CM1RX, CM2RX, CA1RX, CA2RX, RMMIN, RMMAX
REAL*4 RAMIN, RAMAX
COMMON/CURVE/ICRM,ICRA, ICLM, CM1RX, CM2RX, CA1RX, CA2RX,
+ RMMIN, RMMAX, RAMIN, RAMAX, INX, AT_SINQ
c
C include 'curve.inc'
C-----------------------------------------------------------------------
C Define the dummy arguments
c
real*4 ei, aki, ef, akf, qhkl(3), en
real*4 hx, hy, hz
integer*4 if1, if2
logical*4 ldk(8), ldh, ldf, lpa
real*4 dm, da
real*4 helm, f1h, f1v, f2h, f2v, f
integer*4 ifx, iss, ism, isa
real*4 t_a(6), t_rm, t_alm, t_ra, qm
logical*4 ldra(6), ldr_rm, ldr_alm, ldr_ra
real*4 p_ih(8), c_ih(4)
integer*4 ier
C-----------------------------------------------------------------------
C LOCAL VARIABLES
C
integer*4 i, id, imod, iq
logical*4 lmoan(2), lqhkle
c
double precision a1, a2, a3, a4, a5, a6
double precision ala, alm, dakf, daki, dqm, dqs
double precision def, dei
double precision ra, rm
double precision edef(2), akdef(2), dqhkl(3), dqt(3)
double precision ddm, dda
C-----------------------------------------------------------------------
C SET UP
C IMOD INDEX FOR ERROR TREATMENAT BY ERRESO
C LDQHKLE : LOGICAL INDICATING THAT WE ARE DEALING WITH A MOVE
C IN RECIPROCICAL SPACE
C WE REMAP THE ENERGY PB AS FIXED ENERGY IN EDEF(1)
C AND VARIABLE ENERGY IN EDEF(2)
C IF ISA IS NUL SET IFX TO 1 AND PUT EF,KF, EQUAL TO EI,KI
C
IMOD = 3
DDM = DM
DDA = DA
DO I = 1,2
LMOAN(I) = .FALSE.
ENDDO
LQHKLE = .FALSE.
DO IQ = 5,8
LQHKLE = (LQHKLE .OR. LDK(IQ))
ENDDO
DAKI = AKI
DAKF = AKF
IF (ISA .EQ. 0) IFX = 1
EDEF(IFX) = EI
AKDEF(IFX) = AKI
EDEF(3-IFX) = EF
AKDEF(3-IFX) = AKF
IF( ISA .EQ. 0) THEN
EDEF(2) = EDEF(1)
AKDEF(2) = AKDEF(1)
LDK(3) = .TRUE.
LDK(4) = .TRUE.
T_A(5) = 0.
T_A(6) = 0.
LDRA(5) = .TRUE.
LDRA(6) = .TRUE.
ENDIF
C-----------------------------------------------------------------------
C FIRST TAKE IN ACCOUNT THE FIXED ENERGY PB
C
IF (LDK(2*IFX-1) .OR. LDK(2*IFX)) THEN
LMOAN(IFX) = .TRUE.
IF (LDK(2*IFX-1)) THEN
IER = 1
IF(EDEF(1) .LT. EPS1) GOTO 999
IER = 0
AKDEF(1) = SQRT(EDEF(1)/F)
ELSE
IER = 1
IF(AKDEF(1) .LT. EPS1) GOTO 999
IER = 0
EDEF(1) = F*AKDEF(1)**2
ENDIF
ENDIF
C-----------------------------------------------------------------------
C NOW TAKE IN ACCOUNT THE VARIABLE ENERGY PB
C VARIABLE ENERGUY IS DRIVEN EITHER EXPLICITLY
C E.G. BY DRIVING EI OR KI WITH IFX=2
C ( AND WE MUST CALCULATE EN FROM EVAR)
C THE RULE IS : EI=EF+EN : EN IS THE ENERGY LOSS OF NEUTRONS
C OR ENERGY GAIN OF SAMPLE
C OR IMPLICITLY BY DRIVING THE TRANSFERED ENERGY EN
C ( AND WE MUST CALCULATE EVAR FROM EN)
C IF KI IS CONSTANT USE THE CURRENT VALUE CONTAINED IN POSN ARRAY
C TO CALCULATE THE NON-"CONSTANT" K.
C IF KF IS CONSTANT USE ALWAYS THE VALUE IN TARGET AND
C DO A DRIVE OF KF TO KEEP A5/A6 IN RIGHT POSITION
C
IF (LDK(5-2*IFX) .OR. LDK(6-2*IFX)) THEN
LMOAN(3-IFX) = .TRUE.
IF (LDK(5-2*IFX)) THEN
IER = 1
IF(EDEF(2) .LT. EPS4) GOTO 999
IER = 0
AKDEF(2) = SQRT(EDEF(2)/F)
ELSE
IER = 1
IF(AKDEF(2) .LT. EPS4) GOTO 999
IER = 0
EDEF(2) = F*AKDEF(2)**2
ENDIF
EN = (3-2*IFX)*(EDEF(1)-EDEF(2))
ELSEIF (LQHKLE) THEN
LMOAN(3-IFX) = .TRUE.
EDEF(2) = EDEF(1)+(2*IFX-3)*EN
IER = 1
IF(EDEF(2) .LT. EPS4) GOTO 999
IER = 0
AKDEF(2) = SQRT(EDEF(2)/F)
ENDIF
C-----------------------------------------------------------------------
C CALCULATE MONOCHROMATOR AND ANALYSER ANGLES
C
IF(LMOAN(1)) THEN
DEI = EDEF(IFX)
DAKI = AKDEF(IFX)
CALL EX_CASE(DDM,ISM,DAKI,A1,A2,RM,ALM,0,IER)
IF (IER .EQ. 0) THEN
AKI = DAKI
EI = DEI
T_A(1) = A1
T_A(2) = A2
LDRA(1) = .TRUE.
LDRA(2) = .TRUE.
if (icrm .ne. 0) then
T_RM = RM
LDR_RM = .TRUE.
endif
if ((iclm .ne. 0) .and. (inx .ne. 0)) then
T_ALM = ALM
LDR_ALM = .TRUE.
endif
ELSE
GOTO 999
ENDIF
ENDIF
IF(LMOAN(2)) THEN
DEF = EDEF(3-IFX)
DAKF = AKDEF(3-IFX)
CALL EX_CASE(DDA,ISA,DAKF,A5,A6,RA,ALA,1,IER)
IF (IER .EQ. 0) THEN
AKF = DAKF
EF = DEF
T_A(5) = A5
T_A(6) = A6
LDRA(5) = .TRUE.
LDRA(6) = .TRUE.
if (icra .ne. 0) then
T_RA = RA
LDR_RA = .TRUE.
endif
ELSE
GOTO 999
ENDIF
ENDIF
C-----------------------------------------------------------------------
C USE (QH,QK,QL) TO CALCULATE A3 AND A4
C CALCULATE Q1 AND Q2 IN SCATTERING PLANE
C
IMOD = 2
IF (LQHKLE) THEN
DO ID = 1,3
DQHKL(ID) = QHKL(ID)
ENDDO
CALL RL2SPV(DQHKL,DQT,DQM,DQS,IER)
IF (IER .NE. 0) GOTO 999
CALL SAM_CASE(DQT,DQM,DQS,DAKI,DAKF,A3,A4,ISS,IER)
IF (IER .EQ. 0) THEN
T_A(3) = A3
T_A(4) = A4
LDRA(3) = .TRUE.
LDRA(4) = .TRUE.
QM = DQM
ELSE
GOTO 999
ENDIF
ENDIF
C-----------------------------------------------------------------------
C DEAL WITH FLIPPERS AND HELMOTZ COILS IF LPA
C
IF (LPA .AND. (LMOAN(1) .OR. LMOAN(2))) THEN
IF (LDF) CALL FLIP_CASE(IF1,IF2,P_IH,F1V,F1H,F2V,F2H,
+ AKI,AKF,IER)
IF (LDH) CALL HELM_CASE(HX,HY,HZ,P_IH,C_IH,AKI,AKF,
+ A4,QM,HELM,IER)
endif
C-----------------------------------------------------------------------
999 CONTINUE
IF (IER .NE. 0) CALL ERRESO(IMOD,IER)
RETURN
END
c
SUBROUTINE EX_CASE ( ! Part of T_CONV.FOR
c ==================
+ DX,ISX,AKX,AX1,AX2,RX,ALX,MON_OR_ANAL,IER)
C
C CALCULATE ANGLES ON MONO/ANALYSER
C CALCULATE AX1 AX2
C CALCULATE RX = MONO OR ANAL CURVATURE AND LM = MONO POSIT FOR IN8
C
C INPUTS
C DX D-SPACINGS
C ISX SENS OF SCATTERING ON CRYSTAL. If =0, this is probably
c a 3-axis instr. in simulated 2-axis mode and the
c calculation is for the scattering at the analyser.
c In this case, we set AX1 = AX2 = 0 which gives a
c "straight-through" setting of A5 & A6 (because of
c a simultaneous 90 degree zero offset for A5 -- this
c is a bit of a hack, if you ask me!).
C AKX TARGET OF MOMENTUM
c MON_OR_ANAL =0 if calculation is for mono.
c =1 if calculation is for anal.
C OUTPUTS
C AX1 AX2 THETA 2*THETA ANGLES
C RX MONO OR ANALYSER CURVATURE
C ALX SPECIAL TRANSLATION FOR IN8
C IER
C 1 'KI OR KF CANNOT BE OBTAINED CHECK D-SPACINGS',
C 2 'KI OR KF TOO SMALL',
C 3 'KI OR KF TOO BIG',
C-----------------------------------------------------------------------
implicit none
c
double precision PI, RD, EPS1
PARAMETER (PI = 3.14159265358979323846264338327950D0)
PARAMETER (RD = 57.29577951308232087679815481410517D0)
PARAMETER (EPS1 = 1.D-1)
C-----------------------------------------------------------------------
C Define the dummy arguments
double precision dx
integer*4 isx
double precision akx, ax1, ax2, rx, alx
integer*4 mon_or_anal, ier
C-----------------------------------------------------------------------
C include 'curve.inc'
C include 'motdef.inc'
C include 'iolsddef.inc'
c
INTEGER ICRM, ICRA, ICLM, INX
LOGICAL AT_SINQ
REAL*4 CM1RX, CM2RX, CA1RX, CA2RX, RMMIN, RMMAX
REAL*4 RAMIN, RAMAX
COMMON/CURVE/ICRM,ICRA, ICLM, CM1RX, CM2RX, CA1RX, CA2RX,
+ RMMIN, RMMAX, RAMIN, RAMAX, INX, AT_SINQ
C real*4 tbut(5,NBMOT)
C equivalence (rbut, tbut)
C-----------------------------------------------------------------------
C LOCAL VAR
c
double precision arg, dc1rx, dc2rx, drmin, drmax, dcl1r, my_rx
integer*4 ios, indx
C-----------------------------------------------------------------------
C INIT AND TEST
C
ier = 0
ax1 = 0.0
ax2 = 0.0
rx = 0.0
alx = 0.0
c----------------------------------------------------------------------
c Check validity of inputs.
if (dx .lt. EPS1) ier = 1
if (akx .lt. EPS1) ier = 2
arg = PI/(dx * akx)
if (abs(arg) .gt. 1.0) ier = 3
if (ier .ne. 0) goto 999
c----------------------------------------------------------------------
if (mon_or_anal .eq. 0) then ! Use monochr or anal params?
indx = icrm ! Monochr, so set up params.
dc1rx = cm1rx
dc2rx = cm2rx
dcl1r = ICLM
drmin = rmmin
drmax = rmmax
else
indx = icra ! Analyser, so set up params.
dc1rx = ca1rx ! There is no ALX in this case.
dc2rx = ca2rx
drmin = ramin
drmax = ramax
endif
c
C if (indx .ne. 0) then ! Include zero-offset in min/max
C drmin = drmin + tbut(3,indx)
C drmax = drmax + tbut(3,indx)
C if (drmin .lt. tbut(1,indx)) drmin = tbut(1,indx)
C if (drmax .gt. tbut(2,indx)) drmax = tbut(2,indx)
C endif
c-----------------------------------------------------------------------
c Calculation of the two angles
c
if (isx .eq. 0) then ! "Straight-through" mode?
ax1 = 0.0 ! Yes.
ax2 = 0.0
rx = drmin
alx = 0.0
return
endif
c
ax1 = asin (arg) * isx * rd
ax2 = 2.0d0 * ax1
c-----------------------------------------------------------------------
c Calculation of mono curvature RM or analyser curvature RA
c Standard law is:
c
c For monochr:
c CM1RX + CM2RX/SIN(abs(A1)/RD)
c
c For analyser:
c CA1RX + CA2RX*SIN(abs(A5)/RD)
c
c CM1RX/CM2RX/CA1RX/CA2RX are parameters depending on monochr/analyser and
c instrument. They are read from CURVE.INI in routine SETUP_MOT_CURVE.
c e.g. cm1rx = .47
c cm2rx = .244
c rmmin = 0.
c rmmax = 20.
c-----------------------------------------------------------------------
if (mon_or_anal .eq. 0) then ! Monochr or analyser?
if (inx .ne. 0) then ! Monochr. Is there a translation?
if (iclm .ne. 0) then ! Yes, IN8 case. If there's a ..
alx = (dcl1r/sin(ax2/rd)) * cos(ax2/rd) ! .. motor, do the ..
rx = dc2rx * sqrt(sin(abs(ax2)/rd)) - dc1rx ! .. calculation.
rx = dmin1 (dmax1 (rx, drmin), drmax)
return
endif
else ! Not IN8 case so, ..
my_rx = dc1rx + dc2rx/sin(abs(ax1)/rd) ! .. simply calculate.
endif
else ! Analyser.
my_rx = dc1rx + dc2rx * sin(abs(ax1)/rd) ! Simply calculate.
endif
c
if (indx .ne. 0) then ! If there's a motor, return the curvature.
rx = dmin1 (dmax1 (my_rx, drmin), drmax)
C if (rx .ne. my_rx) then
C write (iolun, 101, iostat=ios) motnam(indx), my_rx
C 101 format (' Warning -- ', a8, 'curvature restricted by low ',
C + 'or high limits!'/
C + ' Calculated curvature was', f9.2)
C endif
endif
c-----------------------------------------------------------------------
999 continue
return
end
c
SUBROUTINE SAM_CASE ( ! Part of T_CONV.FOR
c ===================
+ QT,QM,QS,AKI,AKF,AX3,AX4,ISS,IER)
C
C DEAL WITH SAMPLE ANGLES CALCULATION FROM Q VECTOR IN C-N PLANE
C CALCULATE A3 AND A4
C INPUTS
C QT Q-VECTOR IN SCATTERING PLANE
C QM,QS Q MODULUS AND QMODULUS SQUARED
C AKI,AKF MOMEMTA ON MONO AND ANYLSER
C ISS SENS OF SCATTERING ON SAMPLE
C
C OUTPUTS
C AX3 AX4 ANGLES ON SAMPLES
C IER SAME ERROR AS RL2SPV
C IER
C 1 'MATRIX S NOT OK',
C 2 'Q NOT IN SCATTERING PLANE',
C 3 'Q MODULUS TOO SMALL',
C 4 'Q MODULUS TOO BIG',
C-----------------------------------------------------------------------
implicit none
c
double precision RD, EPS3, EPS6
PARAMETER (RD = 57.29577951308232087679815481410517D0)
PARAMETER (EPS3 = 1.D-3)
PARAMETER (EPS6 = 1.D-6)
C-----------------------------------------------------------------------
C Define the dummy arguments
double precision qt(3)
double precision qm, qs, aki, akf, ax3, ax4
integer*4 iss, ier
C-----------------------------------------------------------------------
c Local variables
double precision arg, sax3
C-----------------------------------------------------------------------
C INIT AND TEST
C
IER = 0
IF ((ABS(QS) .LT. EPS6) .OR. (ABS(QM) .LT. EPS3)) THEN
IER = 3
GOTO 999
ENDIF
C-----------------------------------------------------------------------
C CALCULATE A3 AND MOVE IT INTHE -180 ,+180 INTERVAL
C
ARG = (AKI**2 + AKF**2 - QS)/(2.D0*AKI*AKF)
IF(ABS(ARG) .GT. 1.D0)THEN
IER = 4
GOTO 999
ELSE
AX4 = ACOS(ARG)*ISS*RD
ENDIF
AX3 = (-ATAN2(QT(2),QT(1))-ACOS((AKF**2-QS-AKI**2)/
+ (-2.D0*QM*AKI))*DSIGN(1.D0,AX4))*RD
sax3 = Dsign(1.D0,ax3)
AX3 = DMOD(AX3+sax3*180.D0,360.D0)-sax3*180.D0
C
C IF(LPLATE) AX3 = -ATAN(SIN(AX4/RD)/(LSA*TAN(AX5/RD)/(ALMS*C
C 1 TAN(AX1/RD))*(AKI/KF)**2-COS(AX4/RD)))*RD !PLATE FOCALIZATION OPTION
C IF(AXX3 .GT. 180.D0) AX3 = AX3-360.D0
C IF( A3 .LT. -180.D0) AX3 = AX3+360.D0
C IF(LPLATE .AND. (A3 .GT. 0.0)) AX3 = AX3-180
CC-----------------------------------------------------------------------
999 CONTINUE
RETURN
END
c
SUBROUTINE HELM_CASE ( ! Part of T_CONV.FOR
c ====================
+ HX,HY,HZ,T_IH,C_IH,AKI,AKF,A4,QM,HELM,IER)
C
C DEAL WITH HELMOTZ COIL FIELD CALCULATIONS
C CALCULATE HX HY HZ
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-----------------------------------------------------------------------
implicit none
c
C include 'common_sinq.inc'
c
double precision PI, RD, EPS3, EPS4
PARAMETER (PI = 3.14159265358979323846264338327950D0)
PARAMETER (RD = 57.29577951308232087679815481410517D0)
PARAMETER (EPS3 = 1.0D-3)
PARAMETER (EPS4 = 1.0D-4)
C-----------------------------------------------------------------------
C Define the dummy arguments
real*4 hx, hy, hz
real*4 t_ih(8)
real*4 c_ih(4)
real*4 aki, akf
double precision a4
real*4 qm, helm
integer*4 ier
LOGICAL AT_SINQ
C-----------------------------------------------------------------------
c Local variables
integer*4 ic, ncoef
double precision hdir, hdir2, hrad, phi, qpar, qperp
C-----------------------------------------------------------------------
C INIT AND TEST
C
AT_SINQ = .TRUE.
ncoef = 4
if (at_sinq) ncoef = 3
c
IER = 1
IF (ABS(QM) .LT. EPS4) goto 999
IER = 0
DO IC = 1,ncoef
IF (C_IH(IC) .LT. EPS4) IER = 2
ENDDO
IF (IER .NE. 0) GOTO 999
C-----------------------------------------------------------------------
C CALCULATE MODULE AND ANGLES OF IN PLANE FIELD H
C PHI ! Angle between Q and KI (in radians)
C HRAD ! Radial comp. of H
C HDIR ! Direction of H relative to PHI (in radians)
C HDIR2 ! Angle between field and axis of Coil 1 (in radians)
C
qpar = aki - akf * cos(a4/RD)
qperp = -akf * sin(a4/RD)
if (abs(qpar) .gt. EPS3 .and. abs(qperp) .gt. EPS3) then
phi = atan2 (abs(qperp), abs(qpar))
if (qpar .gt. 0 .and. qperp .lt. 0) then
phi = -phi
elseif (qpar .lt. 0 .and. qperp .gt. 0) then
phi = PI - phi
elseif (qpar .lt. 0 .and. qperp .lt. 0) then
phi = phi - PI
endif
elseif (abs(qpar) .gt. EPS3) then
if (qpar .ge. 0.0) phi = 0.0
if (qpar .lt. 0.0) phi = PI
elseif (abs(qperp) .gt. EPS3) then
if (qperp .ge. 0.0) phi = 0.5 * PI
if (qperp .lt. 0.0) phi = -0.5 * PI
else
phi = 0.0
endif
c
hrad = sqrt (hx**2 + hy**2)
if (abs(hx) .gt. EPS3 .and. abs(hy) .gt. EPS3) then
hdir = atan2 (abs(hy), abs(hx))
if (hx .gt. 0 .and. hy .lt. 0) then
hdir = -hdir
elseif (hx .lt. 0 .and. hy .gt. 0) then
hdir = PI - hdir
elseif (hx .lt. 0 .and. hy .lt. 0) then
hdir = hdir - PI
endif
elseif (abs(hx) .gt. EPS3) then
if (hx .ge. 0.0) hdir = 0.0
if (hx .lt. 0.0) hdir = PI
elseif (abs(hy) .gt. EPS3) then
if (hy .ge. 0.0) hdir = 0.5 * PI
if (hy .lt. 0.0) hdir = -0.5 * PI
else
hdir = 0.0
endif
c
hdir2 = hdir + phi - (helm/RD)
C-----------------------------------------------------------------------
C !CALC CURRENTS
C !POSITION OF PSP FOR COIL I
C
if (.not. at_sinq) then
hdir2 = hdir2 + 0.5 * PI ! ???
do ic = 1,3
t_ih(ic+4) = cos(hdir2+(ic-1)*2.*PI/3.)*hrad/c_ih(ic)/1.5
enddo
t_ih(8) = hz/c_ih(4)
else
t_ih(5) = cos(hdir2) * hrad/c_ih(1)
t_ih(6) = sin(hdir2) * hrad/c_ih(2)
t_ih(7) = hz/c_ih(3)
endif
C-----------------------------------------------------------------------
999 CONTINUE
RETURN
END
c
SUBROUTINE FLIP_CASE ( ! Part of T_CONV.FOR
C ====================
+ IF1,IF2,T_IH,F1V,F1H,F2V,F2H,AKI,AKF,IER)
C
C DEAL WITH FLIPPER COIL CALCULATIONS
C CALCULATE P_IF CURRENTS FOR THE TWO FLIPPERS
C-----------------------------------------------------------------------
C Define the dummy arguments
integer*4 if1, if2
real*4 t_ih(8)
real*4 f1v, f1h, f2v, f2h
real*4 aki, akf
integer*4 ier
C-----------------------------------------------------------------------
C INIT AND TEST
C
IER = 0
C-----------------------------------------------------------------------
C
IF (IF1 .EQ. 1) THEN
T_IH(1) = F1V
T_IH(2) = AKI*F1H
ELSE
T_IH(1) = 0.
T_IH(2) = 0.
ENDIF
IF (IF2 .EQ. 1) THEN
T_IH(3) = F2V
T_IH(4) = AKF*F2H
ELSE
T_IH(3) = 0.
T_IH(4) = 0.
ENDIF
C-----------------------------------------------------------------------
999 CONTINUE
RETURN
END

516
t_rlp.c Normal file
View File

@ -0,0 +1,516 @@
/* t_rlp.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 {
doublereal s[16] /* was [4][4] */, sinv[16] /* was [4][4] */;
integer iok;
} osolem_;
#define osolem_1 osolem_
/* Subroutine */ int t_rlp__(void)
{
/* ================ */
/* dec$ Ident 'V01A' */
/* ------------------------------------------------------------------ */
/* Updates: */
/* V01A 7-May-1996 DM. Put error output to IOLUN, use IMPLICIT NONE and */
/* get the code indented so that it is readable! */
/* ------------------------------------------------------------------ */
/* Routines to deal with the reciprocical lattice PB */
/* ------------------------------------------------------------------ */
/* Entry points in this file: */
/* SETRLP : CALCULATION OF S AND INVS , ORIENTATION MATRIX */
/* RL2SPV : TRANSFO FROM RECIP LAT TO SCAT PLANE */
/* SP2RLV : TRANSFO FROM SCAT PLANE TO RECIP LAT */
/* INVS : INVERT MATRIX S, GENERATED BY SETRLP. */
/* ERRESO : DEAL ITH ERROR MESSAGES FOR ALL MODULES */
/* SUBROUTINE SETRLP(SAM,IER) */
/* SUBROUTINE RL2SPV(QHKL,QT,QM,QS,IER) */
/* SUBROUTINE SP2RLV(QHKL,QT,QM,QS,IER) */
/* SUBROUTINE INVS(S,SINV,IER) */
/* SUBROUTINE ERRESO(MODULE,IER) */
/* ------------------------------------------------------------------ */
/* File [MAD.SRC]T_RLP.FOR */
return 0;
} /* t_rlp__ */
/* Subroutine */ int setrlp_(real *sam, integer *ier)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double cos(doublereal), sin(doublereal), sqrt(doublereal), atan(
doublereal);
/* Local variables */
static doublereal alfa[3], cosa[3], cosb[3];
static integer imod;
static doublereal sina[3], sinb[3], aspv[6] /* was [3][2] */;
extern /* Subroutine */ int invs_(doublereal *, doublereal *, integer *);
static doublereal a[3], b[3], c__[3], bb[9] /* was [3][3] */, cc;
static integer id, ie, jd, je, jf, kg, lf, lh, md, me, ne;
static doublereal zp, vv[9] /* was [3][3] */;
extern /* Subroutine */ int erreso_(integer *, integer *);
static doublereal rlb[6] /* was [3][2] */;
/* ============================ */
/* SETRLP: Computation of matrix S which transforms (QH,QK,QL) to */
/* vector (Q1,Q2) in scattering plane (defined by vectors A1,A2) */
/* and SINV matrix for the inverse transformation */
/* INPUT SAM SAMPLE CHARACTERISTICS */
/* SAM(1)=AS LATTICE PARAMETERS */
/* SAM(2)=BS ------------------ */
/* SAM(3)=CS ------------------ */
/* SAM(4)=AA LATTICE ANGLES */
/* SAM(5)=BB -------------- */
/* SAM(6)=CC -------------- */
/* SAM(7)=AX VECTOR A IN SCATTERING PLANE */
/* SAM(8)=AY ---------------------------- */
/* SAM(9)=AZ ---------------------------- */
/* SAM(10)=BX VECTOR B IN SCATTERING PLANE */
/* SAM(11)=BY ---------------------------- */
/* SAM(12)=BZ ---------------------------- */
/* OUTPUT IER ERROR RETURN TO BE TREATED BY ERRESO */
/* IER=1 ERROR ON LATTICE PARAMETERS */
/* IER=2 ERROR ON LATTICE ANGLES */
/* IER=3 ERROR ON VECTORS A1, A2 */
/* ------------------------------------------------------------------ */
/* Part of [MAD.SRC]T_RLP.FOR */
/* ------------------------------------------------------------------ */
/* Define the dummy arguments */
/* ------------------------------------------------------------------ */
/* DO NOT EXPORT THE FOLLOWING COMMON ! */
/* IT IS JUST FOR PERMANENT STORAGE USE */
/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */
/* SOME TESTS AND INIT OF CALCUALTION */
/* Parameter adjustments */
--sam;
/* Function Body */
*ier = 0;
imod = 1;
zp = 6.2831853071795862;
osolem_1.iok = 0;
for (id = 1; id <= 3; ++id) {
a[id - 1] = sam[id];
alfa[id - 1] = sam[id + 3];
aspv[id - 1] = sam[id + 6];
aspv[id + 2] = sam[id + 9];
}
for (id = 1; id <= 3; ++id) {
*ier = 1;
if ((d__1 = a[id - 1], abs(d__1)) <= 1e-8) {
goto L999;
}
*ier = 0;
}
for (id = 1; id <= 3; ++id) {
a[id - 1] /= zp;
alfa[id - 1] /= 57.29577951308232087679815481410517;
cosa[id - 1] = cos(alfa[id - 1]);
sina[id - 1] = sin(alfa[id - 1]);
}
cc = cosa[0] * cosa[0] + cosa[1] * cosa[1] + cosa[2] * cosa[2];
cc = cosa[0] * 2. * cosa[1] * cosa[2] + 1. - cc;
*ier = 2;
if (cc <= .1) {
goto L999;
}
*ier = 0;
cc = sqrt(cc);
je = 2;
kg = 3;
for (id = 1; id <= 3; ++id) {
b[id - 1] = sina[id - 1] / (a[id - 1] * cc);
cosb[id - 1] = (cosa[je - 1] * cosa[kg - 1] - cosa[id - 1]) / (sina[
je - 1] * sina[kg - 1]);
sinb[id - 1] = sqrt(1. - cosb[id - 1] * cosb[id - 1]);
rlb[id + 2] = (d__1 = atan(sinb[id - 1] / cosb[id - 1]), abs(d__1)) *
57.29577951308232087679815481410517;
je = kg;
kg = id;
}
bb[0] = b[0];
bb[1] = 0.;
bb[2] = 0.;
bb[3] = b[1] * cosb[2];
bb[4] = b[1] * sinb[2];
bb[5] = 0.;
bb[6] = b[2] * cosb[1];
bb[7] = -b[2] * sinb[1] * cosa[0];
bb[8] = 1. / a[2];
for (id = 1; id <= 3; ++id) {
rlb[id - 1] = 0.;
for (je = 1; je <= 3; ++je) {
/* Computing 2nd power */
d__1 = bb[je + id * 3 - 4];
rlb[id - 1] += d__1 * d__1;
}
*ier = 1;
if ((d__1 = rlb[id - 1], abs(d__1)) <= 1e-8) {
goto L999;
}
*ier = 0;
rlb[id - 1] = sqrt(rlb[id - 1]);
}
/* ----------------------------------------------------------------------- */
/* GENERATION OF S ORIENTATION MATRIX REC. LATTICE TO SCATTERING PLANE */
for (kg = 1; kg <= 2; ++kg) {
for (ie = 1; ie <= 3; ++ie) {
vv[kg + ie * 3 - 4] = 0.;
for (jf = 1; jf <= 3; ++jf) {
vv[kg + ie * 3 - 4] += bb[ie + jf * 3 - 4] * aspv[jf + kg * 3
- 4];
}
}
}
for (md = 3; md >= 2; --md) {
for (ne = 1; ne <= 3; ++ne) {
id = md % 3 + 1;
je = (md + 1) % 3 + 1;
kg = ne % 3 + 1;
lh = (ne + 1) % 3 + 1;
vv[md + ne * 3 - 4] = vv[id + kg * 3 - 4] * vv[je + lh * 3 - 4] -
vv[id + lh * 3 - 4] * vv[je + kg * 3 - 4];
}
}
for (id = 1; id <= 3; ++id) {
c__[id - 1] = 0.;
for (je = 1; je <= 3; ++je) {
/* Computing 2nd power */
d__1 = vv[id + je * 3 - 4];
c__[id - 1] += d__1 * d__1;
}
*ier = 3;
if ((d__1 = c__[id - 1], abs(d__1)) <= 1e-6) {
goto L999;
}
*ier = 0;
c__[id - 1] = sqrt(c__[id - 1]);
}
for (id = 1; id <= 3; ++id) {
for (je = 1; je <= 3; ++je) {
vv[je + id * 3 - 4] /= c__[je - 1];
}
}
for (kg = 1; kg <= 3; ++kg) {
for (me = 1; me <= 3; ++me) {
osolem_1.s[kg + (me << 2) - 5] = 0.;
for (lf = 1; lf <= 3; ++lf) {
osolem_1.s[kg + (me << 2) - 5] += vv[kg + lf * 3 - 4] * bb[lf
+ me * 3 - 4];
}
}
}
osolem_1.s[15] = 1.;
for (jd = 1; jd <= 3; ++jd) {
osolem_1.s[(jd << 2) - 1] = 0.;
osolem_1.s[jd + 11] = 0.;
}
/* ----------------------------------------------------------------------- */
/* INVERT TRANSFORMATION MATRIX S AND PU RESULT IN SINV */
*ier = 3;
invs_(osolem_1.s, osolem_1.sinv, ier);
*ier = 0;
if (*ier != 0) {
goto L999;
}
osolem_1.iok = 123;
/* --------------------------------------------------------------------------- */
/* SORTIE */
L999:
if (*ier != 0) {
erreso_(&imod, ier);
}
return 0;
} /* setrlp_ */
/* Subroutine */ int rl2spv_(doublereal *qhkl, doublereal *qt, doublereal *qm,
doublereal *qs, integer *ier)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static integer id, je;
/* ========================================= */
/* ------------------------------------------------------------------ */
/* INPUT QHKL QHKL -> QT */
/* A Q-VECTOR TO BE TRANSFORM FROM RECIP LATTICE TO SCATTERING PLANE */
/* CHECK THAT Q-VECTOR IS IN THE PLANE */
/* INPUT Q-VECTOR QHKL(3) Q-VECTOR IN RECIPROCICAL LATTICVE */
/* OUTPUT Q-VECTOR QT(3) Q-VECTOR IN SCATTERING PLANE */
/* OUTPUT QM AND QS QMODULUS AND ITS SQUARE ( TO BE VERIFIED ) */
/* OUTPUT ERROR IER */
/* IER=1 MATRIX S NOT OK */
/* IER=2 Q NOT IN SCATTERING PLANE */
/* IER=3 Q MODULUS TOO SMALL */
/* ------------------------------------------------------------------ */
/* Part of [MAD.SRC]T_RLP.FOR */
/* ------------------------------------------------------------------ */
/* Define the dummy arguments */
/* ------------------------------------------------------------------ */
/* DO NOT EXPORT THE FOLLWING COOMON ! */
/* IT IS JUST FOR PERMANENT STORAGE USE */
/* --------------------------------------------------------------------------- */
/* --------------------------------------------------------------------------- */
/* INIT AND TEST IF TRANSFO MATRICES ARE OK */
/* Parameter adjustments */
--qt;
--qhkl;
/* Function Body */
*ier = 1;
if (osolem_1.iok != 123) {
goto L999;
}
*ier = 0;
/* ----------------------------------------------------------------------- */
for (id = 1; id <= 3; ++id) {
qt[id] = 0.;
for (je = 1; je <= 3; ++je) {
qt[id] += qhkl[je] * osolem_1.s[id + (je << 2) - 5];
}
}
*ier = 2;
if (abs(qt[3]) > 1e-4) {
goto L999;
}
*ier = 0;
*qs = 0.;
for (id = 1; id <= 3; ++id) {
/* Computing 2nd power */
d__1 = qt[id];
*qs += d__1 * d__1;
}
if (*qs < 1e-8) {
*ier = 3;
} else {
*qm = sqrt(*qs);
}
/* --------------------------------------------------------------------------- */
L999:
return 0;
} /* rl2spv_ */
/* Subroutine */ int sp2rlv_(doublereal *qhkl, doublereal *qt, doublereal *qm,
doublereal *qs, integer *ier)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static integer id, je;
/* ========================================= */
/* ------------------------------------------------------------------ */
/* INPUT QT QHKL <- QT */
/* A Q-VECTOR TO BE TRANSFORM FROM SCATTERING PLANE TO RECIP LATTICE */
/* CHECK THAT Q, D & G VECTORS ARE IN THE SCATTERING PLANE */
/* INPUT Q-VECTOR QT(3) Q-VECTOR IN SCATTERING PLANE */
/* OUTPUT Q-VECTOR QHKL(3) Q-VECTOR IN RECIPROCICAL LATTICVE */
/* OUTPUT QM AND QS QMODULUS AND ITS SQUARE ( TO BE VERIFIED ) */
/* OUTPUT ERROR IER */
/* IER=1 MATRIX S NOT OK */
/* IER=2 Q NOT IN SCATTERING PLANE */
/* IER=3 Q MODULUS TOO SMALL */
/* ------------------------------------------------------------------ */
/* Part of [MAD.SRC]T_RLP.FOR */
/* ------------------------------------------------------------------ */
/* Define the dummy arguments */
/* ------------------------------------------------------------------ */
/* DO NOT EXPORT THE FOLLWING COOMON ! */
/* IT IS JUST FOR PERMANENT STORAGE USE */
/* --------------------------------------------------------------------------- */
/* --------------------------------------------------------------------------- */
/* INIT AND TEST IF TRANSFO MATRICES ARE OK */
/* Parameter adjustments */
--qt;
--qhkl;
/* Function Body */
*ier = 1;
if (osolem_1.iok != 123) {
goto L999;
}
*ier = 2;
if (abs(qt[3]) > 1e-4) {
goto L999;
}
*ier = 0;
/* ----------------------------------------------------------------------- */
*qs = 0.;
for (id = 1; id <= 3; ++id) {
/* Computing 2nd power */
d__1 = qt[id];
*qs += d__1 * d__1;
}
if (*qs < 1e-8) {
*ier = 3;
} else {
*qm = sqrt(*qs);
}
/* ----------------------------------------------------------------------- */
for (id = 1; id <= 3; ++id) {
qhkl[id] = 0.;
for (je = 1; je <= 3; ++je) {
qhkl[id] += osolem_1.sinv[id + (je << 2) - 5] * qt[je];
}
}
/* --------------------------------------------------------------------------- */
L999:
return 0;
} /* sp2rlv_ */
/* Subroutine */ int invs_(doublereal *s, doublereal *sinv, integer *ier)
{
/* Initialized data */
static integer m[3] = { 2,3,1 };
static integer n[3] = { 3,1,2 };
static integer id, je, mi, mj, ni, nj;
static doublereal det;
/* ============================== */
/* ------------------------------------------------------------------ */
/* ROUTINE TO INVERT MATRIX S, GENERATED BY SETRLP, WHICH TRANSFORMS */
/* (QH,QK,QL) TO (Q1,Q2) IN THE SCATTERING PLANE */
/* INPUT MATRIX DOUBLE PRECISION S(4,4) */
/* OUTPUT MATRIX DOUBLE PRECISION SINV(4,4) */
/* OUTPUT ERROR IER */
/* IER=1 DETERMINANT OF MATRIX S TOO SMALL */
/* ------------------------------------------------------------------ */
/* Part of [MAD.SRC]T_RLP.FOR */
/* ------------------------------------------------------------------ */
/* Define the dummy arguments */
/* ------------------------------------------------------------------ */
/* ------------------------------------------------------------------ */
/* Parameter adjustments */
sinv -= 5;
s -= 5;
/* Function Body */
*ier = 0;
for (id = 1; id <= 4; ++id) {
for (je = 1; je <= 4; ++je) {
sinv[id + (je << 2)] = 0.;
}
}
det = 0.;
for (id = 1; id <= 3; ++id) {
for (je = 1; je <= 3; ++je) {
mi = m[id - 1];
mj = m[je - 1];
ni = n[id - 1];
nj = n[je - 1];
sinv[je + (id << 2)] = s[mi + (mj << 2)] * s[ni + (nj << 2)] - s[
ni + (mj << 2)] * s[mi + (nj << 2)];
}
det += s[id + 4] * sinv[(id << 2) + 1];
}
if (abs(det) < 1e-6) {
*ier = 1;
} else {
for (id = 1; id <= 3; ++id) {
for (je = 1; je <= 3; ++je) {
sinv[id + (je << 2)] /= det;
}
}
}
sinv[20] = 1.;
return 0;
} /* invs_ */
/* Subroutine */ int erreso_(integer *module, integer *ier)
{
/* System generated locals */
integer i__1;
/* Local variables */
static integer lier, lmodule;
/* ============================= */
/* ------------------------------------------------------------------ */
/* SUBROUTINE TO TREAT ERRORS FROM RESOLUTION CALCULATIONS */
/* MODULE = 1 -> SETRLP */
/* MODULE = 2 -> RL2SPV */
/* MODULE = 3 -> EX_CASE */
/* ------------------------------------------------------------------ */
/* Part of [MAD.SRC]T_RLP.FOR */
/* include 'iolsddef.inc' */
/* ------------------------------------------------------------------ */
/* Define the dummy arguments */
/* ------------------------------------------------------------------ */
/* --------------------------------------------------------------------------- */
/* Computing MIN */
i__1 = max(*ier,1);
lier = min(i__1,4);
/* Computing MIN */
i__1 = max(*module,1);
lmodule = min(i__1,3);
/* WRITE(iolun,501) MESER(LIER,LMODULE) */
/* L501: */
return 0;
} /* erreso_ */

463
t_rlp.f Executable file
View File

@ -0,0 +1,463 @@
SUBROUTINE T_RLP ! File [MAD.SRC]T_RLP.FOR
c ================
c
cdec$ Ident 'V01A'
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------------------------------------------------------------------
c Routines to deal with the reciprocical lattice PB
c------------------------------------------------------------------
c Entry points in this file:
c
c SETRLP : CALCULATION OF S AND INVS , ORIENTATION MATRIX
C RL2SPV : TRANSFO FROM RECIP LAT TO SCAT PLANE
C SP2RLV : TRANSFO FROM SCAT PLANE TO RECIP LAT
C INVS : INVERT MATRIX S, GENERATED BY SETRLP.
C ERRESO : DEAL ITH ERROR MESSAGES FOR ALL MODULES
C
C SUBROUTINE SETRLP(SAM,IER)
C SUBROUTINE RL2SPV(QHKL,QT,QM,QS,IER)
C SUBROUTINE SP2RLV(QHKL,QT,QM,QS,IER)
C SUBROUTINE INVS(S,SINV,IER)
C SUBROUTINE ERRESO(MODULE,IER)
c------------------------------------------------------------------
implicit none
end
c
SUBROUTINE SETRLP (SAM, IER) ! Part of [MAD.SRC]T_RLP.FOR
c ============================
c
C SETRLP: Computation of matrix S which transforms (QH,QK,QL) to
C vector (Q1,Q2) in scattering plane (defined by vectors A1,A2)
C and SINV matrix for the inverse transformation
C
C INPUT SAM SAMPLE CHARACTERISTICS
C SAM(1)=AS LATTICE PARAMETERS
C SAM(2)=BS ------------------
C SAM(3)=CS ------------------
C SAM(4)=AA LATTICE ANGLES
C SAM(5)=BB --------------
C SAM(6)=CC --------------
C SAM(7)=AX VECTOR A IN SCATTERING PLANE
C SAM(8)=AY ----------------------------
C SAM(9)=AZ ----------------------------
C SAM(10)=BX VECTOR B IN SCATTERING PLANE
C SAM(11)=BY ----------------------------
C SAM(12)=BZ ----------------------------
C OUTPUT IER ERROR RETURN TO BE TREATED BY ERRESO
C IER=1 ERROR ON LATTICE PARAMETERS
C IER=2 ERROR ON LATTICE ANGLES
C IER=3 ERROR ON VECTORS A1, A2
c------------------------------------------------------------------
IMPLICIT NONE
c
DOUBLE PRECISION PI
PARAMETER (PI=3.14159265358979323846264338327950D0)
DOUBLE PRECISION RD
PARAMETER (RD=57.29577951308232087679815481410517D0)
DOUBLE PRECISION EPS
PARAMETER (EPS=1.D-1)
DOUBLE PRECISION EPS6
PARAMETER (EPS6=1.D-6)
DOUBLE PRECISION EPS8
PARAMETER (EPS8=1.D-8)
c------------------------------------------------------------------
C Define the dummy arguments
real*4 sam(64)
integer*4 ier
c------------------------------------------------------------------
C DO NOT EXPORT THE FOLLOWING COMMON !
C IT IS JUST FOR PERMANENT STORAGE USE
C
DOUBLE PRECISION S, SINV
integer*4 iok
COMMON /OSOLEM/ S(4,4), SINV(4,4), iok
C-----------------------------------------------------------------------
double precision a(3), aspv(3,2), rlb(3,2)
double precision alfa(3), sina(3), sinb(3), cosa(3), cosb(3)
double precision b(3), c(3)
double precision vv(3,3), bb(3,3)
C
double precision zp, cc
integer*4 imod
integer*4 id, ie
integer*4 jd, je, jf
integer*4 kg
integer*4 lh, lf
integer*4 md, me
integer*4 ne
C-----------------------------------------------------------------------
C SOME TESTS AND INIT OF CALCUALTION
C
ier = 0
IMOD = 1
ZP = 2.D0*PI
IOK = 0
DO ID = 1,3
A(ID) = SAM(ID)
ALFA(ID) = SAM(ID+3)
ASPV(ID,1) = SAM(6+ID)
ASPV(ID,2) = SAM(9+ID)
ENDDO
C
DO ID = 1,3
IER = 1
IF(ABS(A(ID)).LE.EPS8) GOTO 999
IER = 0
ENDDO
DO ID = 1,3
A(ID) = A(ID)/ZP
ALFA(ID) = ALFA(ID)/RD
COSA(ID) = COS(ALFA(ID))
SINA(ID) = SIN(ALFA(ID))
ENDDO
CC = COSA(1)*COSA(1)+COSA(2)*COSA(2)+COSA(3)*COSA(3)
CC = (1.D0+2.D0*COSA(1)*COSA(2)*COSA(3)-CC)
IER = 2
IF(CC.LE.EPS) GOTO 999
IER = 0
CC = SQRT(CC)
JE = 2
KG = 3
DO ID = 1,3
B(ID) = SINA(ID)/(A(ID)*CC)
COSB(ID) = (COSA(JE)*COSA(KG)-COSA(ID))/(SINA(JE)*SINA(KG))
SINB(ID) = SQRT(1.D0-COSB(ID)*COSB(ID))
RLB(ID,2) = ABS(ATAN(SINB(ID)/COSB(ID)))*RD
JE = KG
KG = ID
ENDDO
BB(1,1) = B(1)
BB(2,1) = 0.D0
BB(3,1) = 0.D0
BB(1,2) = B(2)*COSB(3)
BB(2,2) = B(2)*SINB(3)
BB(3,2) = 0.D0
BB(1,3) = B(3)*COSB(2)
BB(2,3) = -B(3)*SINB(2)*COSA(1)
BB(3,3) = 1.D0/A(3)
C
DO ID = 1,3
RLB(ID,1) = 0.D0
DO JE = 1,3
RLB(ID,1) = RLB(ID,1)+BB(JE,ID)**2
ENDDO
IER = 1
IF (ABS(RLB(ID,1)).LE.EPS8) GOTO 999
IER = 0
RLB(ID,1) = SQRT(RLB(ID,1))
ENDDO
C-----------------------------------------------------------------------
C GENERATION OF S ORIENTATION MATRIX REC. LATTICE TO SCATTERING PLANE
C
DO KG = 1,2
DO IE = 1,3
VV(KG,IE) = 0.D0
DO JF = 1,3
VV(KG,IE) = VV(KG,IE)+BB(IE,JF)*ASPV(JF,KG)
ENDDO
ENDDO
ENDDO
DO MD = 3,2,-1
DO NE = 1,3
ID = MOD(MD,3)+1
JE = MOD(MD+1,3)+1
KG = MOD(NE,3)+1
LH = MOD(NE+1,3)+1
VV(MD,NE) = VV(ID,KG)*VV(JE,LH)-VV(ID,LH)*VV(JE,KG)
ENDDO
ENDDO
C
DO ID = 1,3
C(ID) = 0.D0
DO JE = 1,3
C(ID) = C(ID)+VV(ID,JE)**2
ENDDO
IER = 3
IF (ABS(C(ID)).LE.EPS6) GOTO 999
IER = 0
C(ID) = SQRT(C(ID))
ENDDO
C
DO ID = 1,3
DO JE = 1,3
VV(JE,ID) = VV(JE,ID)/C(JE)
ENDDO
ENDDO
DO KG = 1,3
DO ME = 1,3
S(KG,ME) = 0.D0
DO LF = 1,3
S(KG,ME) = S(KG,ME)+VV(KG,LF)*BB(LF,ME)
ENDDO
ENDDO
ENDDO
S(4,4) = 1.D0
DO JD = 1,3
S(4,JD) = 0.D0
S(JD,4) = 0.D0
ENDDO
C-----------------------------------------------------------------------
C INVERT TRANSFORMATION MATRIX S AND PU RESULT IN SINV
C
IER = 3
CALL INVS(S,SINV,IER)
IER = 0
IF (IER.NE.0)GOTO 999
IOK = 123
C---------------------------------------------------------------------------
C SORTIE
C
999 CONTINUE
IF (IER.NE.0) CALL ERRESO(IMOD,IER)
RETURN
END
c
SUBROUTINE RL2SPV (QHKL, QT, QM, QS, IER) ! Part of [MAD.SRC]T_RLP.FOR
c =========================================
c
c------------------------------------------------------------------
C INPUT QHKL QHKL -> QT
C A Q-VECTOR TO BE TRANSFORM FROM RECIP LATTICE TO SCATTERING PLANE
C CHECK THAT Q-VECTOR IS IN THE PLANE
C
C INPUT Q-VECTOR QHKL(3) Q-VECTOR IN RECIPROCICAL LATTICVE
C
C OUTPUT Q-VECTOR QT(3) Q-VECTOR IN SCATTERING PLANE
C OUTPUT QM AND QS QMODULUS AND ITS SQUARE ( TO BE VERIFIED )
C OUTPUT ERROR IER
C IER=1 MATRIX S NOT OK
C IER=2 Q NOT IN SCATTERING PLANE
C IER=3 Q MODULUS TOO SMALL
c------------------------------------------------------------------
IMPLICIT NONE
c
DOUBLE PRECISION DEPS4
PARAMETER (DEPS4=1.D-4)
DOUBLE PRECISION DEPS8
PARAMETER (DEPS8=1.D-8)
c------------------------------------------------------------------
c Define the dummy arguments
DOUBLE PRECISION QHKL(3)
DOUBLE PRECISION QT(3)
DOUBLE PRECISION QM
DOUBLE PRECISION QS
integer*4 IER
c------------------------------------------------------------------
C DO NOT EXPORT THE FOLLWING COOMON !
C IT IS JUST FOR PERMANENT STORAGE USE
C
DOUBLE PRECISION S, SINV
integer*4 iok
COMMON /OSOLEM/ S(4,4), SINV(4,4), iok
C---------------------------------------------------------------------------
integer*4 id, je
C---------------------------------------------------------------------------
C INIT AND TEST IF TRANSFO MATRICES ARE OK
IER = 1
IF (IOK.NE.123) GOTO 999
IER = 0
C-----------------------------------------------------------------------
C
DO ID = 1,3
QT(ID) = 0.D0
DO JE = 1,3
QT(ID) = QT(ID) + QHKL(JE)*S(ID,JE)
ENDDO
ENDDO
IER = 2
IF(ABS(QT(3)).GT.DEPS4) GOTO 999
IER = 0
QS = 0.D0
DO ID = 1,3
QS = QS+QT(ID)**2
ENDDO
IF(QS.LT.DEPS8) THEN
IER = 3
ELSE
QM = SQRT(QS)
ENDIF
C---------------------------------------------------------------------------
C
999 CONTINUE
RETURN
END
c
SUBROUTINE SP2RLV (QHKL, QT, QM, QS, IER) ! Part of [MAD.SRC]T_RLP.FOR
c =========================================
c
c------------------------------------------------------------------
C INPUT QT QHKL <- QT
C A Q-VECTOR TO BE TRANSFORM FROM SCATTERING PLANE TO RECIP LATTICE
C CHECK THAT Q, D & G VECTORS ARE IN THE SCATTERING PLANE
C
C INPUT Q-VECTOR QT(3) Q-VECTOR IN SCATTERING PLANE
C
C OUTPUT Q-VECTOR QHKL(3) Q-VECTOR IN RECIPROCICAL LATTICVE
C OUTPUT QM AND QS QMODULUS AND ITS SQUARE ( TO BE VERIFIED )
C OUTPUT ERROR IER
C IER=1 MATRIX S NOT OK
C IER=2 Q NOT IN SCATTERING PLANE
C IER=3 Q MODULUS TOO SMALL
c------------------------------------------------------------------
IMPLICIT NONE
C
DOUBLE PRECISION EPS4
PARAMETER (EPS4=1.D-4)
DOUBLE PRECISION EPS8
PARAMETER (EPS8=1.D-8)
c------------------------------------------------------------------
c Define the dummy arguments
DOUBLE PRECISION QHKL(3)
DOUBLE PRECISION QT(3)
DOUBLE PRECISION QM
DOUBLE PRECISION QS
integer*4 IER
c------------------------------------------------------------------
C DO NOT EXPORT THE FOLLWING COOMON !
C IT IS JUST FOR PERMANENT STORAGE USE
C
DOUBLE PRECISION S, SINV
integer*4 iok
COMMON /OSOLEM/ S(4,4), SINV(4,4), iok
C---------------------------------------------------------------------------
integer*4 id, je
C---------------------------------------------------------------------------
C INIT AND TEST IF TRANSFO MATRICES ARE OK
IER = 1
IF (IOK.NE.123) GOTO 999
IER = 2
IF(ABS(QT(3)).GT.EPS4) GOTO 999
IER = 0
C-----------------------------------------------------------------------
QS = 0.D0
DO ID = 1,3
QS = QS+QT(ID)**2
ENDDO
IF(QS.LT.EPS8) THEN
IER = 3
ELSE
QM = SQRT(QS)
ENDIF
C-----------------------------------------------------------------------
C
DO ID = 1,3
QHKL(ID) = 0.D0
DO JE = 1,3
QHKL(ID) = QHKL(ID)+SINV(ID,JE)*QT(JE)
ENDDO
ENDDO
C---------------------------------------------------------------------------
C
999 CONTINUE
RETURN
END
c
SUBROUTINE INVS (S, SINV, IER) ! Part of [MAD.SRC]T_RLP.FOR
c ==============================
c
c------------------------------------------------------------------
C ROUTINE TO INVERT MATRIX S, GENERATED BY SETRLP, WHICH TRANSFORMS
C (QH,QK,QL) TO (Q1,Q2) IN THE SCATTERING PLANE
C INPUT MATRIX DOUBLE PRECISION S(4,4)
C OUTPUT MATRIX DOUBLE PRECISION SINV(4,4)
C OUTPUT ERROR IER
C IER=1 DETERMINANT OF MATRIX S TOO SMALL
c------------------------------------------------------------------
IMPLICIT NONE
c
DOUBLE PRECISION EPS6
PARAMETER (EPS6=1.D-6)
c------------------------------------------------------------------
c Define the dummy arguments
DOUBLE PRECISION S(4,4)
DOUBLE PRECISION SINV(4,4)
integer*4 IER
c------------------------------------------------------------------
integer*4 m(3)
integer*4 n(3)
c
integer*4 id, je
integer*4 mi, mj, ni, nj
double precision det
c------------------------------------------------------------------
DATA M/2,3,1/
DATA N/3,1,2/
IER = 0
DO ID = 1,4
DO JE = 1,4
SINV(ID,JE) = 0.D0
ENDDO
ENDDO
DET = 0.D0
DO ID = 1,3
DO JE = 1,3
MI = M(ID)
MJ = M(JE)
NI = N(ID)
NJ = N(JE)
SINV(JE,ID) = S(MI,MJ)*S(NI,NJ)-S(NI,MJ)*S(MI,NJ)
ENDDO
DET = DET+S(ID,1)*SINV(1,ID)
ENDDO
IF(ABS(DET).LT.EPS6) THEN
IER = 1
ELSE
DO ID = 1,3
DO JE = 1,3
SINV(ID,JE) = SINV(ID,JE)/DET
ENDDO
ENDDO
ENDIF
SINV(4,4) = 1.D0
RETURN
END
c
SUBROUTINE ERRESO(MODULE,IER) ! Part of [MAD.SRC]T_RLP.FOR
c =============================
c
c------------------------------------------------------------------
C SUBROUTINE TO TREAT ERRORS FROM RESOLUTION CALCULATIONS
C MODULE = 1 -> SETRLP
C MODULE = 2 -> RL2SPV
C MODULE = 3 -> EX_CASE
c------------------------------------------------------------------
IMPLICIT NONE
c
integer*4 MXER
PARAMETER (MXER = 4)
integer*4 MXMOD
PARAMETER (MXMOD = 3)
c
C include 'iolsddef.inc'
c------------------------------------------------------------------
c Define the dummy arguments
integer*4 module
integer*4 ier
c------------------------------------------------------------------
integer*4 lmodule, lier
CHARACTER*64 MESER(MXER,MXMOD)
DATA MESER/
+ ' Check lattice spacings (AS,BS,CS)',
+ ' Check cell angles (AA,BB,CC)',
+ ' Check scattering plane (AX....BZ)',
+ ' Check lattice and scattering plane',
C
+ ' Check Lattice and Scattering Plane',
+ ' Q not in scattering plane',
+ ' Q modulus too small',
+ ' KI,KF,Q triangle cannot close',
C
+ ' Error in KI or KF. Check D-spacings & units',
+ ' KI or KF cannot be obtained',
+ ' KI or KF too small',
+ ' KI,KF,Q triangle will not close'/
C---------------------------------------------------------------------------
LIER = MIN(MAX(IER,1),MXER)
LMODULE = MIN(MAX(MODULE,1),MXMOD)
C WRITE(iolun,501) MESER(LIER,LMODULE)
501 FORMAT(A)
RETURN
END

117
tas.h Normal file
View File

@ -0,0 +1,117 @@
/*----------------------------------------------------------------------
Header file for the SICS triple axis module. Implements new drive
and scan commands for triple axis which use the old tasmad F77
routine for calculating the spectrometer setting angles.
Mark Koennecke, November 2000
------------------------------------------------------------------------*/
#ifndef SICSTAS
#define SICSTAS
/*------------------------- parameter defines -------------------------*/
#define WAV 0
#define DM 1
#define DA 2
#define ETAM 3
#define ETAA 4
#define TI 5
#define MN 6
#define IF1V 7
#define IF2V 8
#define IF1H 9
#define IF2H 10
#define HELM 11
#define AS 12
#define BS 13
#define CS 14
#define AA 15
#define BB 16
#define CC 17
#define ETAS 18
#define AX 19
#define AY 20
#define AZ 21
#define BX 22
#define BY 23
#define BZ 24
#define EI 25
#define KI 26
#define EF 27
#define KF 28
#define QH 29
#define QK 30
#define QL 31
#define EN 32
#define QM 33
#define HX 34
#define HY 35
#define HZ 36
#define DA1 37
#define DA2 38
#define DA3 39
#define DA4 40
#define DA5 41
#define DA6 42
#define DMCV 43
#define DSRO 44
#define DACH 45
#define DMTL 46
#define DMTU 47
#define DSTL 48
#define DSTU 49
#define DATL 50
#define DATU 51
#define DMGL 52
#define DSGL 53
#define DSGU 54
#define DAGL 55
#define DEI 56
#define DKI 57
#define DEF 58
#define DKF 59
#define DQH 60
#define DQK 62
#define DQL 62
#define DEN 63
#define DQM 64
#define DT 65
#define SM 66
#define SS 67
#define SA 68
#define FX 69
#define NP 70
#define F1 71
#define F2 72
#define LPA 73
#define MRX1 74
#define MRX2 75
#define ARX1 76
#define ARX2 77
#define MAXPAR 78
/* --------------------- data structure -------------------------------*/
typedef struct {
pObjectDescriptor pDes;
pSicsVariable tasPar[MAXPAR];
pCounter counter;
}TASdata, *pTASdata;
/*---------------------- interface ----------------------------------*/
int TASFactory(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
int TASDrive(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
int TASScan(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
int TASSet(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
#endif

168
tas.w Normal file
View File

@ -0,0 +1,168 @@
\subsection{Triple Axis Spectrometer Software}
A triple axis spectrometer performs complicated scans in Q--energy space.
The triple axis spectrometers pose a couple of challenges to the SICS
software: \begin{itemize}
\item The command syntax should be as close as possible to the syntax
of the ancient tasmad program.
\item A relatively complicated algorithm is used for computing the
motor positions and magnet settings. It is a selling point when the
F77 routine used for this purpose in tasmad can be reused.
\item A ILL format scan file must be written after each scan in order
to provide compatability with existing data analysis software.
\item Provisions must be made to execute a batch file at each scan
point in order to allow for polarisation analysis.
\item The user interface of tasmad is largely based on parameters
which are used to store and manipulate state information.
\item There exists a special syntax for assigning variables which
requires the parameters to be in a special storage order.
\end{itemize}
These requirements are implemented in the following way: tasmad
variables are matched to SICS variables. The scan and drive commands
are reimplemented in order to allow for both syntax parsing and the
reuse of the triple axis calculation routines. In order to support the
strange storage order assignment system the set command is also
implemented in this modules as it can share code with scan and drive.
All the remaining syntax adaptions will be implemented in the
scripting language.
\subsubsection{Data Structures}
It would be inconvenient to search all necessary parameters in the
interpreter anytime a scan or drive command is used. In order to avoid
this, the parameters are cached in a local data structure which is
initialized when installing the tas module.
@d tasdata @{
typedef struct {
pObjectDescriptor pDes;
pSicsVariable tasPar[MAXPAR];
pCounter counter;
}TASdata, *pTASdata;
@}
\begin{description}
\item[pDes] The standard object descriptor required for any SICs
object.
\item[floatPar] An array of pointers to float parameters.
The parameters are indexed through defined constants.
\item[counter] A pointer to the neutron counter.
\end{description}
The constants for the parameters are defined in the header file.
\subsubsection{Exported Functions}
These are mainly the interpreter inetrface functions:
@d tasfunc @{
int TASFactory(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
int TASDrive(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
int TASScan(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
int TASSet(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[]);
@}
@o tas.h @{
/*----------------------------------------------------------------------
Header file for the SICS triple axis module. Implements new drive
and scan commands for triple axis which use the old tasmad F77
routine for calculating the spectrometer setting angles.
Mark Koennecke, November 2000
------------------------------------------------------------------------*/
#ifndef SICSTAS
#define SICSTAS
/*------------------------- parameter defines -------------------------*/
#define WAV 0
#define DM 1
#define DA 2
#define ETAM 3
#define ETAA 4
#define TI 5
#define MN 6
#define IF1V 7
#define IF2V 8
#define IF1H 9
#define IF2H 10
#define HELM 11
#define AS 12
#define BS 13
#define CS 14
#define AA 15
#define BB 16
#define CC 17
#define ETAS 18
#define AX 19
#define AY 20
#define AZ 21
#define BX 22
#define BY 23
#define BZ 24
#define EI 25
#define KI 26
#define EF 27
#define KF 28
#define QH 29
#define QK 30
#define QL 31
#define EN 32
#define QM 33
#define HX 34
#define HY 35
#define HZ 36
#define DA1 37
#define DA2 38
#define DA3 39
#define DA4 40
#define DA5 41
#define DA6 42
#define DMCV 43
#define DSRO 44
#define DACH 45
#define DMTL 46
#define DMTU 47
#define DSTL 48
#define DSTU 49
#define DATL 50
#define DATU 51
#define DMGL 52
#define DSGL 53
#define DSGU 54
#define DAGL 55
#define DEI 56
#define DKI 57
#define DEF 58
#define DKF 59
#define DQH 60
#define DQK 62
#define DQL 62
#define DEN 63
#define DQM 64
#define DT 65
#define SM 66
#define SS 67
#define SA 68
#define FX 69
#define NP 70
#define F1 71
#define F2 72
#define LPA 73
#define MRX1 74
#define MRX2 75
#define ARX1 76
#define ARX2 77
#define MAXPAR 78
/* --------------------- data structure -------------------------------*/
@<tasdata@>
/*---------------------- interface ----------------------------------*/
@<tasfunc@>
#endif
@}

270
tasdrive.c Normal file
View File

@ -0,0 +1,270 @@
/*--------------------------------------------------------------------------
This is one implementation file for the TASMAD simulation module for
SICS. The requirement is to make SICS look as much as TASMAD as
possible. This includes:
- TASMAD is variable driven
- Sometimes variables are accessed in storage order.
- A complicated calculation has to be done for getting the instruments
settings right. The appropriate F77 routine from TASMAD will be
reused.
- The scan logic is different.
- Output of ILL-formatted data files is required.
This file implements the MAD dr command for driving.
Mark Koennecke, November 2000
---------------------------------------------------------------------------*/
#include <stdlib.h>
#include <assert.h>
#include "fortify.h"
#include "sics.h"
#include "sicsvar.h"
#include "counter.h"
#include "motor.h"
#include "tas.h"
#include "tasu.h"
#include "splitter.h"
/* a token break function, implemented in stptok.c */
extern char *stptok(const char *s, char *tok, size_t toklen, char *brk);
#define VAR 1
#define VALUE 2
/*----------------------------------------------------------------------
TASDrive has to do an interesting parsing job: The normal syntax is
par=val. However, it is possible that the we get par = val, val, val
which means that the motors following par in storage order are
driven. Additionally we have to check for special energy or Q variables
which require a triple axis calculation.
It helps if one understands some fundamental things used in the code
below:
- motorMask holds a value for each motor in the motor list. The
value can be either 0 for not to drive or 1 for drive. After
successfull parsing these motors will be started. The mask will be built
during parsing.
- newPositions holds the new positions for the normal motors.
- tasMask is a mask which indicates which triple axis special variable
(Energy or Q) is driven.
- tasTargetMask will be set by the TAS calculation and will indicate
which motors of the range A1-A6, curvature and currents need to be
driven.
- tasTargets holds after the TAS calculation the target values for the
A1-A6, curvature and currents motors.
-------------------------------------------------------------------------*/
#define NUM 1
#define TXT 2
int TASDrive(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[])
{
pTASdata self = NULL;
int iTAS = 0;
float tasTargets[20];
unsigned char tasTargetMask[20], tasMask[10];
char *pPtr, pToken[20], pLine[256];
int varPointer, i, motorPointer, status, rStatus, lastToken;
char pBueffel[256];
unsigned char motorMask[MAXMOT];
float newPositions[MAXMOT];
assert(pCon);
assert(pSics);
self = (pTASdata)pData;
assert(self);
/* Initialize */
Arg2Text(argc, argv,pLine,255);
strtolower(pLine);
lastToken = NUM;
pPtr = pLine + strlen(argv[0]); /* step over command */
for(i = 0; i < 10; i++)
{
tasMask[i] = 0;
motorMask[i] = 0;
motorMask[10+i] = 0;
tasTargets[i] = .0;
tasTargets[i+10] = .0;
}
for(i = 0; i < MAXMOT; i++)
{
motorMask[i] = 0;
}
varPointer = -1;
rStatus = 1;
/* parse loop */
while(pPtr != NULL)
{
pPtr = stptok(pPtr,pToken,20," ,=");
if(strlen(pToken) < 1 || pPtr == NULL )
continue;
if(tasNumeric(pToken)) /* numbers */
{
if(lastToken == NUM)
{
/* handle storage order logic */
if(motorPointer > -1)
{
motorPointer++;
}
else if(varPointer > -1)
{
varPointer++;
}
else
{
sprintf(pBueffel,"ERROR: parse error at %s, %s",
pToken,"need parameter to drive");
SCWrite(pCon,pBueffel,eError);
return 0;
}
}
/* enter the parameter to drive into the appropriate mask */
if(motorPointer >= 0)
{
motorMask[motorPointer] = 1;
newPositions[motorPointer] = atof(pToken);
}
else if(varPointer >= 0 )
{
tasMask[varPointer] = 1;
self->tasPar[EMIN + varPointer]->fVal = atof(pToken);
}
else
{
sprintf(pBueffel,"ERROR: parse error at %s, %s",
pToken,"need parameter to drive");
SCWrite(pCon,pBueffel,eError);
return 0;
}
lastToken = NUM;
}
else /* text tokens */
{
lastToken = TXT;
if( (status = isTASEnergy(pToken)) > -1) /* Ei, KI, EF, KF, Q.... */
{
iTAS = 1;
motorPointer = -1;
varPointer = status;
}
else if( (status = isTASMotor(pToken)) > -1)
{
motorPointer = status;
varPointer = -1;
}
else
{
sprintf(pBueffel,"ERROR: cannot drive %s", pToken);
SCWrite(pCon,pBueffel,eError);
rStatus = 0;
break;
}
}
}/* end of parse loop */
if(rStatus != 1)
return rStatus;
/* having done this, we can start the motors */
for(i = 0; i < MAXMOT; i++)
{
if(motorMask[i] > 0)
{
sprintf(pBueffel,"Driving %s to %f",
tasMotorOrder[i],newPositions[i]);
SCWrite(pCon,pBueffel,eValue);
status = StartMotor(pServ->pExecutor,pSics,pCon,
tasMotorOrder[i],newPositions[i]);
if(status == 0)
{
/* error should already have been reported by StartMotor*/
rStatus = 0;
}
}
}
/*
if in TAS mode do the TAS calculation and start the appropriate
motors.
*/
if(iTAS > 0)
{
status = TASCalc(self,pCon,tasMask,tasTargets, tasTargetMask);
if(status)
{
/*
do output, first Q-E variables
*/
for(i = 0; i < 10; i++)
{
if(tasMask[i])
{
sprintf(pBueffel,"Driving %s to %f", tasVariableOrder[EI+i],
self->tasPar[EI+i]->fVal);
SCWrite(pCon,pBueffel,eValue);
}
}
/*
more output: the motor positions
*/
for(i = 0; i < 9; i++)
{
if(tasTargetMask[i])
{
sprintf(pBueffel,"Driving %s to %f",tasMotorOrder[i],
tasTargets[i]);
SCWrite(pCon,pBueffel,eValue);
}
}
/*
missing: output for helmholtz currents
*/
status = TASStart(self,pCon,pSics,tasTargets,tasTargetMask);
if(status == 0)
{
rStatus = 0;
}
}
else
{
rStatus = 0;
}
}
/*
wait till we are finished
*/
status = Wait4Success(GetExecutor());
if(status == DEVINT)
{
if(SCGetInterrupt(pCon) == eAbortOperation)
{
SCSetInterrupt(pCon,eContinue);
SCSetError(pCon,OKOK);
sprintf(pBueffel,"Driving %aborted");
SCWrite(pCon,pBueffel,eStatus);
}
return 0;
}
else if(status == DEVDONE)
{
sprintf(pBueffel,"Driving done");
SCWrite(pCon,pBueffel,eStatus);
}
else
{
sprintf(pBueffel,
"Driving finished");
SCWrite(pCon,pBueffel,eStatus);
}
return rStatus;
}

282
tasinit.c Normal file
View File

@ -0,0 +1,282 @@
/*--------------------------------------------------------------------------
This is one implementation file for the TASMAD simulation module for
SICS. The requirement is to make SICS look as much as TASMAD as
possible. This includes:
- TASMAD is variable driven
- Sometimes variables are accessed in storage order.
- A complicated calculation has to be done for getting the instruments
settings right. The appropriate F77 routine from TASMAD will be
reused.
- The scan logic is different.
- Output of ILL-formatted data files is required.
This file implements the initialization part of the whole thing.
Mark Koennecke, November 2000
---------------------------------------------------------------------------*/
#include <stdlib.h>
#include <assert.h>
#include "fortify.h"
#include "sics.h"
#include "sicsvar.h"
#include "counter.h"
#include "motor.h"
#include "tas.h"
/*
As variables may be accessed in storage order, it is necessary to
know the order of the motors
*/
extern char *tasMotorOrder[] = { "a1",
"a2",
"a3",
"a4",
"a5",
"a6",
"mcv",
"sro",
"ach",
"mtl",
"mtu",
"stl",
"stu",
"stl",
"atu",
"mgl",
"sgl",
"sgu",
"agl",
NULL };
/*
In order to initialise the variable array in the TAS data structure we
need to know the names of the variables in the right order. This order
has to match the order defined in tas.h through the defines. Otherwise
quite weird things may happen at runtime.
*/
extern char *tasVariableOrder[] = {
"wav",
"dm",
"da",
"etam",
"etaa",
"ti",
"mn",
"if1v",
"if1h",
"if2v",
"if2h",
"helm",
"as",
"bs",
"cs",
"aa",
"bb",
"cc",
"etas",
"ax",
"ay",
"az",
"bx",
"by",
"bz",
"ei",
"ki",
"ef",
"kf",
"qh",
"qk",
"ql",
"en",
"qm",
"hx",
"hy",
"hz",
"da1",
"da2",
"da3",
"da4",
"da5",
"da6",
"dmcv",
"dsro",
"dach",
"dmtl",
"dmtu",
"dstl",
"dstu",
"datl",
"datu",
"dmgl",
"dsgl",
"dsgu",
"dagl",
"dei",
"dki",
"def",
"dkf",
"dqh",
"dqk",
"dql",
"den",
"dqm",
"dt",
"sm",
"ss",
"sa",
"fx",
"np",
"f1",
"f2",
"lpa",
"mrx1",
"mrx2",
"arx1",
"arx2",
NULL};
/*---------------------------------------------------------------------
There is a special feauture in MAD where the count mode is determined
which variable, MN for monitor od TI for time has been set as the last
one. In order to implement this in SICS callback functions will be
used on the variables which switch the counter box into the appropriate
mode.
-----------------------------------------------------------------------*/
static int MonitorCallback(int iEvent, void *pEvent, void *pUser)
{
pTASdata self = (pTASdata)pUser;
assert(self);
if(iEvent != VALUECHANGE)
return 0;
SetCounterMode(self->counter,ePreset);
return 1;
}
static int TimerCallback(int iEvent, void *pEvent, void *pUser)
{
pTASdata self = (pTASdata)pUser;
assert(self);
if(iEvent != VALUECHANGE)
return 0;
SetCounterMode(self->counter,eTimer);
return 1;
}
/*-----------------------------------------------------------------------
A function for killing the TAS data structure is needed
-------------------------------------------------------------------------*/
static void TASKill(void *pData)
{
pTASdata self = (pTASdata)pData;
if(!self)
return;
if(self->pDes)
DeleteDescriptor(self->pDes);
free(self);
}
/*-----------------------------------------------------------------------*/
int TASFactory(SConnection *pCon, SicsInterp *pSics, void *pData,
int argc, char *argv[])
{
pTASdata pNew = NULL;
int iPtr, iError;
char pBueffel[132];
pSicsVariable pVar = NULL;
CommandList *pCom = NULL;
/* create a new data structure */
pNew = (pTASdata)malloc(sizeof(TASdata));
if(!pNew)
{
SCWrite(pCon,"ERROR: insufficient memory to allocate TAS data structure",
eError);
return 0;
}
memset(pNew,0,sizeof(TASdata));
pNew->pDes = CreateDescriptor("TAS");
if(!pNew->pDes)
{
SCWrite(pCon,"ERROR: insufficient memory to allocate TAS data structure",
eError);
free(pNew);
return 0;
}
/* connect to all the variables */
iPtr = 0; iError = 0;
while(tasVariableOrder[iPtr] != NULL)
{
pNew->tasPar[iPtr] = FindVariable(pSics,tasVariableOrder[iPtr]);
if(!pNew->tasPar[iPtr])
{
sprintf(pBueffel,"ERROR: TAS variable %s not found",
tasVariableOrder[iPtr]);
SCWrite(pCon,pBueffel,eError);
iError++;
}
sprintf(pBueffel,"Initialised var %d", iPtr);
SCWrite(pCon,pBueffel,eError);
iPtr++;
}
if(iError != 0)
{
SCWrite(pCon,"ERROR: TAS bad initialisation, TAS not created",eError);
TASKill(pNew);
return 0;
}
/* connect to the counter */
pCom = FindCommand(pSics,"counter");
if(!pCom)
{
SCWrite(pCon,"ERROR: no neutron counter for TAS found",eError);
TASKill(pNew);
return 0;
}
pNew->counter = pCom->pData;
/*
Install the callbacks for TI and MN. Sloppy error checking because
the variables should have been accessed earlier on.
*/
pVar = FindVariable(pSics,"MN");
if(pVar)
{
RegisterCallback(pVar->pCall,VALUECHANGE,MonitorCallback,pNew,NULL);
}
pVar = FindVariable(pSics,"TI");
if(pVar)
{
RegisterCallback(pVar->pCall,VALUECHANGE,TimerCallback,pNew,NULL);
}
/* install TAS commands */
iError = AddCommand(pSics,"dr",TASDrive,TASKill,pNew);
if(!iError)
{
SCWrite(pCon,"ERROR: duplicate dr command not created",eError);
TASKill(pNew);
return 0;
}
/*
iError = AddCommand(pSics,"sc",TASScan,NULL,pNew);
if(!iError)
{
SCWrite(pCon,"ERROR: duplicate sc command not created",eError);
TASKill(pNew);
return 0;
}
iError = AddCommand(pSics,"set",TASSet,NULL,pNew);
if(!iError)
{
SCWrite(pCon,"ERROR: duplicate set command not created",eError);
TASKill(pNew);
return 0;
}
*/
return 1;
}

470
tasutil.c Normal file
View File

@ -0,0 +1,470 @@
/*--------------------------------------------------------------------------
This is one implementation file for the TASMAD simulation module for
SICS. The requirement is to make SICS look as much as TASMAD as
possible. This includes:
- TASMAD is variable driven
- Sometimes variables are accessed in storage order.
- A complicated calculation has to be done for getting the instruments
settings right. The appropriate F77 routine from TASMAD will be
reused.
- The scan logic is different.
- Output of ILL-formatted data files is required.
This file implements a couple of utility functions mainly for parsing
and second for interfacing to the F77 routines for calculating the
TAS settings..
Mark Koennecke, November 2000
---------------------------------------------------------------------------*/
#include <stdlib.h>
#include <assert.h>
#include "fortify.h"
#include "sics.h"
#include "sicsvar.h"
#include "counter.h"
#include "motor.h"
#include "tas.h"
#include "tasu.h"
/*-----------------------------------------------------------------------
isTASMotor finds out if the given string is a TAS motor and returns its
index in the motor list if this the case. Else -1 is returned.
-------------------------------------------------------------------------*/
int isTASMotor(char *val)
{
int iPtr;
iPtr = 0;
while(tasMotorOrder[iPtr] != NULL)
{
if(strcmp(val,tasMotorOrder[iPtr]) == 0)
{
return iPtr;
}
else
{
iPtr++;
}
}
return -1;
}
/*--------------------------------------------------------------------------
isTASVar finds out if the given string is a TAS variable and returns its
index if this is the case. Else -1 will be returned.
--------------------------------------------------------------------------*/
int isTASVar(char *val)
{
int iPtr;
iPtr = 0;
while(tasVariableOrder[iPtr] != NULL)
{
if(strcmp(val,tasVariableOrder[iPtr]) == 0)
{
return iPtr;
}
else
{
iPtr++;
}
}
return -1;
}
/*------------------------------------------------------------------------
isTASEnergy finds out if a variable is a TAS energy variable. This would
require a TAS calculation to take place. If the test is positive then the
index of the Variable is returned, else -1 is returned.
-------------------------------------------------------------------------*/
isTASEnergy(char *val)
{
int iPtr;
for(iPtr = EMIN; iPtr <= EMAX;iPtr++)
{
if(strcmp(val,tasVariableOrder[iPtr]) == 0)
{
return iPtr-EMIN;
}
else
{
iPtr++;
}
}
return -1;
}
/*-----------------------------------------------------------------------
prepare2Parse removes all unnecessary delimiters from the parse string.
These are: ' =
----------------------------------------------------------------------*/
void prepare2Parse(char *line)
{
int i, iLang;
iLang = strlen(line);
for(i = 0; i < iLang; i++)
{
if(line[i] == ',' || line[i] == '=')
{
line[i] = ' ';
}
}
}
/*---------------------------------------------------------------------*/
int tasNumeric(char *pText)
{
int i, ii, iGood;
static char pNum[13] = {"1234567890.+-"};
for(i = 0; i < strlen(pText); i++)
{
for(ii = 0; ii < 13; ii++)
{
iGood = 0;
if(pText[i] == pNum[ii])
{
iGood = 1;
break;
}
}
if(!iGood)
{
return 0;
}
}
return 1;
}
/*----------------------------------------------------------------------
TASCalc does the triple axis spectrometer calculations. This function is
invoked whenever energy or Q needs to be driven. The parameters:
- self a pointer to a TASdata structure holding information about all
necessary parameters.
- pCon a SConnection object needed for reporting errors.
- tasMask a mask with 0,1 indicating which variable is driven. IT IS
ASSUMED THAT THE APPROPRIATE VARIABLE HAS ALREADY BEEN SET IN THE
INTERPRETER BEFORE TASCalc IS CALLED. This is because for convenience
this functions collects the values from the interpreter.
- motorTargets will hold the new targets for the relevant motors
(A1-A6 plus some magnet related) when the call finished happily.
- motorMask will hold 1's for each motor to drive, 0 for each motor
not affected.
This version uses the TASMAD calculation routines. These have been
translated from F77 to C with f2c (f2c -A crysconv.f , tacov.f). The C is
not maintainable, always edit the F77 sources in case of need and
retranslate. This scheme requires the definitions going before TASCalc. The
advantage of using f2c is that we get less portability problems with
different calling conventions for C anf F77 on different platforms.
-----------------------------------------------------------------------*/
#include "f2c.h"
extern int setrlp_(real *sam, integer *ier);
extern 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 *t_ra__, real *qm, logical *
ldra, logical *ldr_rm__, logical *ldr_alm__, logical *ldr_ra__, real *
p_ih__, real *c_ih__, integer *ier);
extern int inicurve_(integer *midx, real *mrx1, real *mrx2, integer
*aidx, real *arx1, real *arx2, real *mmin, real *mmax, real *amin,
real *amax);
/*-------------------------------------------------------------------*/
int TASCalc(pTASdata self, SConnection *pCon,
unsigned char tasMask[10],
float motorTargets[20],
unsigned char motorMask[20])
{
/* for setrlp */
real sam[13];
integer ier;
/* for t_conv */
real ei, aki, ef, akf, qhkl[3], en, hx, hy, hz, dm, da, helm, f1h, f1v,
f2h, f2v, f, angles[6], tRM, tRA, tALM, qm, currents[8], helmconv[4];
integer if1, if2, ifx, iss, ism, isa;
logical ldk[8], ldh, ldf, lpa, ldra[6], l_RM, l_RA, l_ALM;
/* for inicurve */
real mrx1, mrx2, arx1, arx2, mmin, mmax, amin, amax;
integer im, ia;
pMotor pMot;
float fVal;
/* else */
int i;
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;
}
/*
now we need to set the parameters for mono/analyzer
curvature calculations.
*/
mrx1 = (real)self->tasPar[MRX1]->fVal;
mrx2 = (real)self->tasPar[MRX2]->fVal;
arx1 = (real)self->tasPar[ARX1]->fVal;
arx2 = (real)self->tasPar[ARX2]->fVal;
im = 7;
ia = 9;
pMot = FindMotor(pServ->pSics,"MCV");
if(!pMot)
{
SCWrite(pCon,"ERROR: cannot find monochromator curvature motor",eError);
return 0;
}
MotorGetPar(pMot,"softupperlim",&fVal);
mmax = (real)fVal;
MotorGetPar(pMot,"softlowerlim",&fVal);
mmin = (real)fVal;
pMot = FindMotor(pServ->pSics,"ACH");
if(!pMot)
{
SCWrite(pCon,"ERROR: cannot find analyzer curvature motor",eError);
return 0;
}
MotorGetPar(pMot,"softupperlim",&fVal);
amax = (real)fVal;
MotorGetPar(pMot,"softlowerlim",&fVal);
amin = (real)fVal;
inicurve_(&im,&mrx1, &mrx2, &ia, &arx1, &arx2,&mmin, &mmax,
&amin, &amax);
/*
This done, we painstackingly initialize the tons of parameters required
by the t_conv
*/
ei = (real)self->tasPar[EI]->fVal;
aki = (real)self->tasPar[KI]->fVal;
ef = (real)self->tasPar[EF]->fVal;
akf = (real)self->tasPar[KF]->fVal;
qhkl[0] = (real)self->tasPar[QH]->fVal;
qhkl[1] = (real)self->tasPar[QK]->fVal;
qhkl[2] = (real)self->tasPar[QL]->fVal;
en = (real)self->tasPar[EN]->fVal;
hx = (real)self->tasPar[HX]->fVal;
hy = (real)self->tasPar[HY]->fVal;
hz = (real)self->tasPar[HZ]->fVal;
f = (real)2.072; /* energy unit meV */
if1 = (integer)self->tasPar[F1]->iVal;
if2 = (integer)self->tasPar[F2]->iVal;
for(i = 0; i < 8; i++)
{
ldk[i] = (logical)tasMask[i];
}
ldh = (logical)tasMask[8];
ldf = (logical)tasMask[9];
if(self->tasPar[LPA]->iVal > 0)
lpa = (logical)1;
dm = (real)self->tasPar[DM]->fVal;
da = (real)self->tasPar[DM]->fVal;
qm = (real)self->tasPar[QM]->fVal;
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;
ifx = (integer)self->tasPar[FX]->iVal;
iss = (integer)self->tasPar[SS]->iVal;
ism = (integer)self->tasPar[SM]->iVal;
isa = (integer)self->tasPar[SA]->iVal;
/*
initalise the motorMasks to 0.
*/
for(i = 0; i < 20; i++)
{
motorMask[i] = 0;
}
for(i = 0; i < 6; i++)
{
ldra[i] = 0;
}
l_RA = l_RM = l_ALM = 0;
/* now we can call */
t_conv__(&ei, &aki, &ef, &akf,
qhkl, &en, &hx, &hy, &hz, &if1,
&if2, ldk, &ldh, &ldf, &lpa, &dm,
&da, &helm, &f1h, &f1v, &f2h, &f2v,
&f, &ifx, &iss, &ism, &isa,
angles, &tRM, &tALM, &tRA, &qm, ldra,
&l_RM, &l_ALM,&l_RA, currents,helmconv,
&ier);
/*
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;
}
/*
now we have to put those things back which interest us, including
updating the variables which may have accidentally been set.
*/
for(i = 0; i < 6; i++)
{
motorTargets[i] = angles[i];
motorMask[i] = ldra[i];
}
motorMask[6] = l_RM;
motorTargets[6] = tRM;
motorMask[8] = l_RA;
motorTargets[8] = tRA;
for(i = 0; i < 8; i++)
{
motorTargets[9+i] = currents[i];
}
for(i = 0; i < 4; i++)
{
motorTargets[17+i] = helmconv[i];
}
self->tasPar[EI]->fVal = (float)ei;
self->tasPar[KI]->fVal = (float)aki;
self->tasPar[EF]->fVal = (float)ef;
self->tasPar[KF]->fVal = (float)akf;
self->tasPar[EN]->fVal = (float)en;
return 1;
}
/*-------------------------------------------------------------------------
TASStart starts the motors calculated by TASCalc
---------------------------------------------------------------------------*/
int TASStart(pTASdata self, SConnection *pCon, SicsInterp *pSics,
float motorTargets[20],
unsigned char motorMask[20])
{
int status, i;
char pBueffel[80];
/*
do the A1-A6 motors first
*/
for(i = 0; i < 6; i++)
{
if(motorMask[i] != 0)
{
status = StartMotor(pServ->pExecutor,pSics,pCon,
tasMotorOrder[i], motorTargets[i]);
if(status == 0)
{
/* the error will have been reported */
return 0;
}
}
}
/*
start the monochromator and analyzer curvature motors
*/
if(motorMask[6])
{
status = StartMotor(pServ->pExecutor,pSics,pCon,
"MCV", motorTargets[6]);
if(status == 0)
{
/* the error will have been reported */
return 0;
}
}
if(motorMask[9])
{
status = StartMotor(pServ->pExecutor,pSics,pCon,
"ACH", motorTargets[8]);
if(status == 0)
{
/* the error will have been reported */
return 0;
}
}
/*
missing: set the magnet currents. In order to do this, I need more
info about the magnets involved and how to address them.
*/
return 1;
}

303
test.tcl
View File

@ -27,7 +27,7 @@ ServerOption AcceptTimeOut 100
# timeout when checking for connection req.
# Similar to above, but for connections
ServerOption ReadUserPasswdTimeout 7000
ServerOption ReadUserPasswdTimeout 10
# time to wiat for a user/passwd to be sent from a client. Increase this
# if there is a problem connecting to a server due to network overload\
@ -114,7 +114,7 @@ sampledist lock
#Motor D1V EL734 lnsp22.psi.ch 4000 3 3
Motor A1 SIM 15.0 120. .1 2. # Monochromator Theta
Motor A2 SIM -73. 137. .1 1. # Monochromator 2Theta
Motor A3 SIM 0. 360. .1 3. # Sample Omega
Motor A3 SIM -360. 360. .1 3. # Sample Omega
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
@ -223,8 +223,11 @@ MakePeakCenter xxxscan
MakeHM banana SIM
banana configure HistMode HRPT
banana configure OverFlowMode reflect
#MakeHM banana SINQHM
#banana configure HistMode HRPT
banana configure HistMode Normal
#banana configure OverFlowMode reflect
banana configure OverFlowMode Ceil
banana configure Rank 1
#banana configure Length 400
banana configure Length 16384
@ -233,10 +236,11 @@ banana configure dim1 128
banana configure BinWidth 4
banana preset 100.
banana CountMode Timer
#banana configure HMComputer lnse02.psi.ch
#banana configure HMPort 2400
#banana configure Counter counter
banana configure HMComputer lnse02.psi.ch
banana configure HMPort 2400
banana configure Counter counter
banana init
ClientPut "HM initialized"
source $shome/sics/tcl/scancom.tcl
#source $shome/sics/countf.tcl
@ -259,7 +263,7 @@ ClientPut "Installed ev test stuff"
Motor twotheta SIM -120.0 120. .1 2. # 2 theta arm
Motor omega SIM -73. 134. .1 2. # omega
Motor chi SIM 0. 360. .1 2. # chi circle
Motor phi SIM 0. 360. .1 2. # phi circle
Motor phi SIM -360. 360. .1 2. # phi circle
Motor muca SIM 30. 36. .1 2. # phi circle
Motor dg1 SIM -10. 40. .1 2. # phi circle
SicsAlias phi ph
@ -305,12 +309,286 @@ fcircleinit
MakeDifrac twotheta omega chi phi counter
#----------- histogram memory
# --------------------------------------------------------------------------
# Initialization script for a simulated TOPSI instrument
#
#
# Dr. Mark Koennecke February, 1996
#---------------------------------------------------------------------------
# O P T I O N S
# --------------- Initialize Tcl internals --------------------------------
rename scan stscan
#-------- a home for this, everything else is in relation to this
set shome /data/koenneck/src
# first all the server options are set
#ServerOption RedirectFile $shome/sics/stdout
ServerOption ReadTimeOut 100
# timeout when checking for commands. In the main loop SICS checks for
# pending commands on each connection with the above timeout, has
# PERFORMANCE impact!
ServerOption AcceptTimeOut 100
# timeout when checking for connection req.
# Similar to above, but for connections
ServerOption ReadUserPasswdTimeout 10
# time to wiat for a user/passwd to be sent from a client. Increase this
# if there is a problem connecting to a server due to network overload\
ServerOption LogFileDir $shome/log
#LogFileDir is the directory where the command log is going
#ServerOption logstartfile $shome/sics/start.tcl
ServerOption LogFileBaseName $shome/sics/tmp/server
# the path and base name of the internal server logfile to which all
# activity will be logged.
ServerOption TecsStartCmd "tecs/bin/TecsServer -h lnsp26:4000/0"
# -h host:port/channel is for serial server
ServerOption TecsBinDir tecs/bin/
ServerOption TecsLogDir /data/koenneck/tmp/
ServerOption TecsPort 9753
ServerOption statusfile sicsstatus.tcl
ServerOption ServerPort 2911
# the port number the server is going to listen at. The client MUST know
# this number in order to connect. It is in client.ini
ServerOption InterruptPort 2914
# The UDP port where the server will wait for Interrupts from clients.
# Obviously, clients wishing to interrupt need to know this number.
# Telnet options
ServerOption TelnetPort 1301
ServerOption TelWord sicslogin
ServerOption DefaultTclDirectory $shome/sics/tcl
ServerOption DefaultCommandFile ""
#------ a port for broadcasting UDP messages
#ServerOption QuieckPort 2108
TokenInit connan
#---------------------------------------------------------------------------
# U S E R S
# than the SICS users are specified
# Syntax: SicsUser name password userRightsCode
SicsUser Mugger Diethelm 1
SicsUser User Rosy 2
SicsUser Spy 007 1
SicsUser me me 1
#--------------------------------------------------------------------------
# S I M P L E V A R I A B L E S
# now a few general variables are created
# Syntax: VarMake name type access
# type can be one of: Text, Int, Float
#access can be one of: Internal, Mugger, user, Spy
VarMake Instrument Text Internal
Instrument "TOPSI"
Instrument lock
VarMake starttime Text User
VarMake Title Text User
VarMake sample Text User
sample "DanielOxid"
Title "TopsiTupsiTapsi"
VarMake User Text User
User "Daniel_the_Clementine"
VarMake detectordist Float Mugger
detectordist 2500
detectordist lock
VarMake sampledist Float Mugger
sampledist 496.
sampledist lock
#--------------------------------------------------------------------------
# D E V I C E S : M O T O R S
# Motor a4 EL734 LNSP22 4000 5 6
# EL734 motor with parameters: hostname PortNumber Channel MotorID
#Motor D1V EL734 lnsp22.psi.ch 4000 3 3
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 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
Motor MTL SIM -30. 30. .1 3. # mono lower translation
Motor MTU SIM -30. 30. .1 3. # mono upper translation
Motor STL SIM -30. 30. .1 3. # sample lower translation
Motor STU SIM -30. 30. .1 3. # sample upper translation
Motor MGU SIM -50. 50. .1 3. # mono upper goniometer
Motor SGL SIM -20. 20. .1 3. # sample lower goniometer
Motor SGU SIM -20. 20. .1 3. # sample upper goniometer
Motor SDM SIM -5 50. .1 3. # weird Motor
SicsAlias A4 Tasse
SicsAlias A5 MonoX
SicsAlias A5 MonoY
SicsAlias A5 MonoPhi
SicsAlias A5 MonoChi
Motor D1R SIM -20. 20. .1 3. # Diaphragm 1 right
Motor D1L SIM -20. 20. .1 3. # Diaphragm 1 left
Motor D1T SIM -20. 20. .1 3. # Diaphragm 1 top & Bottom
Motor D2R SIM -20. 20. .1 3. # Diaphragm 2 right
Motor D2L SIM -20. 20. .1 3. # Diaphragm 2 left
Motor D2T SIM -20. 20. .1 3. # Diaphragm 2 top & Bottom
Motor BeamStopX SIM -20. 20. .1 3. # Diaphragm 2 right
Motor BeamStopY SIM -20. 20. .1 3. # Diaphragm 2 left
Motor DetectorX SIM -20. 20. .1 3. # Diaphragm 2 right
Motor DetectorY SIM -20. 20. .1 3. # Diaphragm 2 left
Motor DetectorRotation SIM -20. 20. .1 3. # Diaphragm 2 top & Bottom
ClientPut "Motors done"
MakeMulti sampletable
sampletable alias D1r x
sampletable alias D1L y
sampletable alias D1T z
sampletable pos henry D1r 5. D1L -5. D1T 0.
sampletable endconfig
SicsAlias sampletable st
#------------------------------------------------------------------------
# Velocity selector
#Motor tilt EL734 lnsp25.psi.ch 4000 2 2
Motor tilt SIM -15 15 .1 3.
set dornen(Host) lnsp25.psi.ch
set dornen(Port) 4000
set dornen(Channel) 6
set dornen(Timeout) 5000
#VelocitySelector nvs tilt DORNIER dornen
VelocitySelector nvs tilt SIM
nvs add -20 28800
nvs add 3800 4500
nvs add 5900 6700
nvs add 8100 9600
unset dornen
MakeSANSWave lumbda nvs
ClientPut "Velocity Selector done"
SicsAlias MTL sax
SicsAlias A3 som
#--------------------------------------------------------------------------
# C O U N T E R S
MakeCounter counter SIM
#MakeCounter counter EL737 lnsp19.psi.ch 4000 4
#--------------------------------------------------------------------------
# M U L T I D E V I C E V A R I A B L E S
MakeMono Mono "Ge-111" A1 A2 SDM
Mono dd 3.3537
Mono vk1 -0.025942
Mono vk2 5.35166
MakeWaveLength lambda Mono
MakeO2T O2T A3 A4
#--------------------------------------------------------------------------
# P R O C E D U R E S
source tcl/log.tcl
MakeDrive
SicsAlias drive dr
Publish LogBook Spy
MakeRuenBuffer
#---------------- TestVariables for Storage
VarMake SicsDataPath Text Mugger
SicsDataPath "$shome/sics/"
SicsDataPath lock
VarMake SicsDataPrefix Text Mugger
SicsDataPrefix test
SicsDataPrefix lock
VarMake SicsDataPostFix Text Mugger
SicsDataPostFix ".hdf"
SicsDataPostFix lock
VarMake Adress Text User
VarMake phone Text User
VarMake fax Text User
VarMake email Text User
VarMake sample_mur Float User
MakeDataNumber SicsDataNumber "$shome/sics/danu.dat"
#InitSANS $shome/sics/sansdict.dic
InitDMC
MakeScanCommand xxxscan counter topsi.hdd recover.bin
MakePeakCenter xxxscan
MakeHM hm1 SIM
hm1 configure HistMode HRPT
hm1 configure OverFlowMode reflect
hm1 configure Rank 1
#hm1 configure Length 400
hm1 configure Length 65536
hm1 configure dim0 256
hm1 configure dim1 256
hm1 configure BinWidth 4
hm1 preset 100.
hm1 CountMode Timer
#hm1 configure HMComputer lnse02.psi.ch
#hm1 configure HMPort 2400
#hm1 configure Counter counter
hm1 init
MakeHM hm2 SIM
hm2 configure HistMode HRPT
hm2 configure OverFlowMode reflect
hm2 configure Rank 1
#hm2 configure Length 400
hm2 configure Length 65536
hm2 configure dim0 256
hm2 configure dim1 256
hm2 configure BinWidth 4
hm2 preset 100.
hm2 CountMode Timer
#hm2 configure HMComputer lnse02.psi.ch
#hm2 configure HMPort 2400
#hm2 configure Counter counter
hm2 init
MakeHM hm3 SIM
hm3 configure HistMode HRPT
hm3 configure OverFlowMode reflect
hm3 configure Rank 1
#hm3 configure Length 400
hm3 configure Length 65536
hm3 configure dim0 256
hm3 configure dim1 256
hm3 configure BinWidth 4
hm3 preset 100.
hm3 CountMode Timer
#hm3 configure HMComputer lnse02.psi.ch
#hm3 configure HMPort 2400
#hm3 configure Counter counter
hm3 init
ClientPut "Installed 4-circle stuff"
#source transact.tcl
#Publish transact Spy
#MakeSPS suff lnsp26.psi.ch 4000 7
MakeSPS sps lnsa12.psi.ch 4000 4
#source beamdt.tcl
#------------- C804-DC motors
@ -365,9 +643,9 @@ ChopperAdapter phase choco phase 0 90.
ChopperAdapter ratio choco ratio 0 6.
#-------- SANS Cooker
MakeChopper cooker sanscook lnsa10 4000 11
ChopperAdapter cookp cooker mp 0 400
ChopperAdapter cookz cooker mz 0 400
#MakeChopper cooker sanscook lnsa10 4000 11
#ChopperAdapter cookp cooker mp 0 400
#ChopperAdapter cookz cooker mz 0 400
source chosta.tcl
@ -400,3 +678,4 @@ MakeLin2Ang a5l a5
#source tmp/beam.tcl
source tcl/wwwpar.tcl
source bef.tcl

13
trics.dic
View File

@ -35,7 +35,7 @@ source0 = /frame0000,NXentry/TRICS,NXinstrument/SINQ,NXsource/NXVGROUP
monodes = /frame0000,NXentry/TRICS,NXinstrument/monochromator,NXcrystal/SDS \
description -type DFNT_UINT8 -rank 1 -dim {132}
monolambda = /frame0000,NXentry/TRICS,NXinstrument/monochromator,NXcrystal/SDS \
lambda -attr {units,Angstroem}
wavelength -attr {units,Angstroem}
monotheta = \
/frame0000,NXentry/TRICS,NXinstrument/monochromator,NXcrystal/SDS theta \
-attr {units,degrees}
@ -46,15 +46,15 @@ mono0 = \
/frame0000,NXentry/TRICS,NXinstrument/monochromator,NXcrystal/NXVGROUP
#------------------------- CountControl
framepreset = \
/$(framename),NXentry/TRICS,NXinstrument/count_control,NXcounter/SDS preset
/$(framename),NXentry/TRICS,NXinstrument/count_control,NXmonitor/SDS preset
framemode = /$(framename),NXentry/TRICS,NXinstrument/count_control,NXcounter/SDS countmode \
-type DFNT_UINT8 -rank 1 -dim {132}
framemonitor = /$(framename),NXentry/TRICS,NXinstrument/count_control,NXcounter/SDS monitor \
-type DFNT_INT32
#------------------------ Detector
dnumber = detector1
framedim1 = 128
framedim2 = 128
framedim1 = 256
framedim2 = 256
ddescription = /frame0000,NXentry/TRICS,NXinstrument/$(dnumber),NXdetector/SDS \
name -type DFNT_UINT8 -rank 1 -dim {132}
detectorx = /frame0000,NXentry/TRICS,NXinstrument/$(dnumber),NXdetector/SDS x \
@ -72,7 +72,7 @@ frametilt = /$(framename),NXentry/TRICS,NXinstrument/$(dnumber),NXdetector/SDS
-attr {units,degrees}
framecounts = /$(framename),NXentry/TRICS,NXinstrument/$(dnumber),NXdetector/SDS counts \
-attr {signal,1} -attr {units,counts} -type DFNT_INT32 \
-rank 2 -dim {$(framedim1),$(framedim2)}
-LZW -rank 2 -dim {$(framedim1),$(framedim2)}
detzerox = \
/frame0000,NXentry/TRICS,NXinstrument/$(dnumber),NXdetector/SDS x_zero_point \
-attr {units,pixel}
@ -100,6 +100,7 @@ frametemp = /$(framename),NXentry/sample,NXsample/SDS sample_temperature \
framestdev = /$(framename),NXentry/sample,NXsample/SDS \
sample_temperature_stdev
#-------------- data
frame = /$(framename),NXentry/framedata,NXdata/NXVGROUP
frame = /$(framename),NXentry/$(dnumber),NXdata/NXVGROUP