From 2d16479717fbc6208c8f162eef9ec78ddcae331a Mon Sep 17 00:00:00 2001 From: cvs Date: Fri, 18 May 2001 14:12:32 +0000 Subject: [PATCH] - Added back calculation from motor positions to Q/E variables into TAS code. - Fixed communication problems in SerPortServer, mainly with terminator detection. - Added SPS switched motors for TOPSI - Debugged Power-PC histogram memory software for TRICS --- Makefile | 2 +- conman.c | 1 + danu.dat | 2 +- el734driv.c | 6 +- hardsup/el734_utility.c | 2 +- hardsup/el737_utility.c | 16 +- matrix/Makefile | 8 +- motor.c | 9 +- nxutil.c | 2 +- ofac.c | 3 + sinqhm/SinqHM_bootParamsConfig.c | 6 +- sinqhm/SinqHM_def.h | 4 +- sinqhm/SinqHM_gbl.h | 3 +- sinqhm/SinqHM_srv_filler.c | 34 +- sinqhm/SinqHM_srv_routines.c | 19 +- sinqhm/lwl_client.c | 1 + sinqhmdriv.c | 5 +- switchedmotor.w | 97 ++++++ swmotor.c | 547 +++++++++++++++++++++++++++++++ swmotor.h | 20 ++ swmotor.i | 21 ++ t_update.c | 489 +++++++++++++++++++++++++++ t_update.f | 406 +++++++++++++++++++++++ tasdrive.c | 1 + tasscan.c | 1 + tasu.h | 7 +- tasutil.c | 240 +++++++++++++- test.tcl | 1 + utils/Makefile | 2 +- utils/SerPortServer.c | 44 ++- varlog.c | 7 +- 31 files changed, 1951 insertions(+), 55 deletions(-) create mode 100644 switchedmotor.w create mode 100644 swmotor.c create mode 100644 swmotor.h create mode 100644 swmotor.i create mode 100644 t_update.c create mode 100755 t_update.f diff --git a/Makefile b/Makefile index 8f1ad7a9..07cea372 100644 --- a/Makefile +++ b/Makefile @@ -47,7 +47,7 @@ SOBJ = network.o ifile.o conman.o SCinter.o splitter.o passwd.o \ hklscan.o xytable.o amor2t.o nxamor.o amorscan.o amorstat.o \ circular.o el755driv.o maximize.o sicscron.o tecsdriv.o sanscook.o \ tasinit.o tasutil.o t_rlp.o t_conv.o d_sign.o d_mod.o \ - tasdrive.o tasscan.o synchronize.o definealias.o + tasdrive.o tasscan.o synchronize.o definealias.o swmotor.o t_update.o MOTOROBJ = motor.o el734driv.o simdriv.o el734dc.o pipiezo.o pimotor.o COUNTEROBJ = countdriv.o simcter.o counter.o diff --git a/conman.c b/conman.c index e2cb1aa0..04c1a093 100644 --- a/conman.c +++ b/conman.c @@ -918,6 +918,7 @@ extern pServer pServ; } pBuf = (char *)malloc((iDataLen + iDataLen/10 + 50)*sizeof(char)); + memset(pBuf,0,(iDataLen + iDataLen/10 + 50)*sizeof(char) ); compStream.next_in = (Bytef *)pData; compStream.next_out = (Bytef *)pBuf; compStream.avail_in = iDataLen; diff --git a/danu.dat b/danu.dat index 03c7de69..4e4480c7 100644 --- a/danu.dat +++ b/danu.dat @@ -1,3 +1,3 @@ - 7674 + 7740 NEVER, EVER modify or delete this file You'll risk eternal damnation and a reincarnation as a cockroach!|n \ No newline at end of file diff --git a/el734driv.c b/el734driv.c index daba558e..52aede0a 100644 --- a/el734driv.c +++ b/el734driv.c @@ -124,7 +124,7 @@ EL734Error2Text converts between an EL734 error code to text -----------------------------------------------------------------------------*/ -/* extern char EL734_IllgText[256]; */ + extern char EL734_IllgText[256]; static void EL734Error2Text(char *pBuffer, int iErr) { @@ -154,9 +154,9 @@ break; case EL734__BAD_ILLG: strcat(pBuffer,"EL734__BAD_ILLG "); - /* + strcat(pBuffer,EL734_IllgText); - */ + break; case EL734__BAD_LOC: strcat(pBuffer,"EL734__BAD_LOC"); diff --git a/hardsup/el734_utility.c b/hardsup/el734_utility.c index 7a154aa1..9fc0722f 100644 --- a/hardsup/el734_utility.c +++ b/hardsup/el734_utility.c @@ -1899,7 +1899,7 @@ rply_ptr0 = AsynSrv_GetReply ( &info_ptr->asyn_info, &info_ptr->from_host, NULL); if (rply_ptr0 == NULL) rply_ptr0 = "?no_response"; - if (*rply_ptr0 == '\0') { + if (*rply_ptr0 == '\0' || *rply_ptr0 == '\r' ) { /* ** The command was accepted - so zero the statistics ** fields in the handle and return to caller. diff --git a/hardsup/el737_utility.c b/hardsup/el737_utility.c index ddce8ab7..f3021a58 100644 --- a/hardsup/el737_utility.c +++ b/hardsup/el737_utility.c @@ -805,7 +805,7 @@ if (rply_ptr0 == NULL) rply_ptr0 = "?"; if (rply_ptr1 == NULL) rply_ptr1 = "?"; - if ((*rply_ptr0 == '\0') && + if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) && (sscanf (rply_ptr1, "%d", status) == 1)) { if (EL737_errcode != 0) return False; EL737_call_depth--; @@ -851,7 +851,7 @@ rply_ptr0 = AsynSrv_GetReply ( &info_ptr->asyn_info, &info_ptr->from_host, NULL); if (rply_ptr0 == NULL) rply_ptr0 = "?"; - if (*rply_ptr0 == '\0') { + if ( (*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) { EL737_call_depth--; return True; } @@ -1343,7 +1343,7 @@ if (rply_ptr0 == NULL) rply_ptr0 = "?"; if (rply_ptr1 == NULL) rply_ptr1 = "?"; - if ((*rply_ptr0 == '\0') && + if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) && (sscanf (rply_ptr1, "%d", status) == 1)) { if (EL737_errcode != 0) return False; EL737_call_depth--; @@ -1472,7 +1472,7 @@ rply_ptr0 = AsynSrv_GetReply ( &info_ptr->asyn_info, &info_ptr->from_host, NULL); if (rply_ptr0 == NULL) rply_ptr0 = "?"; - if (*rply_ptr0 == '\0') { + if ( (*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) { if (val >= 0) return EL737_EnableThresh (handle, indx); EL737_call_depth--; return True; @@ -1519,7 +1519,7 @@ if (rply_ptr0 == NULL) rply_ptr0 = "?"; if (rply_ptr1 == NULL) rply_ptr1 = "?"; - if ((*rply_ptr0 == '\0') && + if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') ) && (sscanf (rply_ptr1, "%d", status) == 1)) { if (EL737_errcode != 0) return False; EL737_call_depth--; @@ -1569,7 +1569,7 @@ if (rply_ptr0 == NULL) rply_ptr0 = "?"; if (rply_ptr1 == NULL) rply_ptr1 = "?"; - if ((*rply_ptr0 == '\0') && + if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == 'r') ) && (sscanf (rply_ptr1, "%d", status) == 1)) { if (EL737_errcode != 0) return False; EL737_call_depth--; @@ -1635,7 +1635,7 @@ info_ptr->c5 = info_ptr->c6 = info_ptr->c7 = info_ptr->c8 = 0; nvals = 9; } - if ((*rply_ptr0 == '\0') && + if ( ((*rply_ptr0 == '\0') || (*rply_ptr0 == '\r') )&& (sscanf (rply_ptr1, "%d", rs) == 1) && (nvals == 9)) { if (EL737_errcode != 0) return False; @@ -1682,7 +1682,7 @@ if (rply_ptr0 == NULL) rply_ptr0 = "?"; - if (*rply_ptr0 == '\0') { + if ( (*rply_ptr0 == '\0' || (*rply_ptr0 == '\r') ) ) { if (EL737_errcode != 0) return False; EL737_call_depth--; return True; diff --git a/matrix/Makefile b/matrix/Makefile index 120acd94..2902297e 100644 --- a/matrix/Makefile +++ b/matrix/Makefile @@ -8,12 +8,12 @@ OBJ= matadd.o matcreat.o matdet.o matdump.o matdurbn.o materr.o \ mattran.o #---------- for Redhat linux -CC= gcc -CFLAGS= -I/usr/local/include -I. -I../ -DLINUX -g -c +#CC= gcc +#CFLAGS= -I/usr/local/include -I. -I../ -DLINUX -g -c #------------ for DigitalUnix -#CC=cc -#CFLAGS= -I/data/koenneck/include -I. -I../ -std1 -g -c +CC=cc +CFLAGS= -I/data/koenneck/include -I. -I../ -std1 -g -c #------------ for DigitalUnix with Fortify #CFLAGS= -I/data/koenneck/include -DFORTIFY -I. -I../ -std1 -g -c diff --git a/motor.c b/motor.c index 98120d17..41c558a3 100644 --- a/motor.c +++ b/motor.c @@ -967,7 +967,7 @@ extern MotorDriver *MakePiPiezo(Tcl_Interp *pTcl, char *pArray); return 1; } /* ----------------- some private functions used in MotorAction -------------*/ - static void MotorListLL(pMotor self, SConnection *pCon) + void MotorListLL(pMotor self, SConnection *pCon) { char pBueffel[512]; int i, iLen; @@ -988,7 +988,7 @@ extern MotorDriver *MakePiPiezo(Tcl_Interp *pTcl, char *pArray); } /*--------------------------------------------------------------------------*/ - static void MotorReset(pMotor pM) + void MotorReset(pMotor pM) { ObParInit(pM->ParArray,SLOW,"softlowerlim",pM->pDriver->fLower,usUser); ObParInit(pM->ParArray,SUPP,"softupperlim",pM->pDriver->fUpper,usUser); @@ -1215,3 +1215,8 @@ extern MotorDriver *MakePiPiezo(Tcl_Interp *pTcl, char *pArray); return 0; } + + + + + diff --git a/nxutil.c b/nxutil.c index f0bd3dd9..6ad7596f 100644 --- a/nxutil.c +++ b/nxutil.c @@ -250,7 +250,7 @@ } else { - /* it can still be a simpel variable */ + /* it can still be a simple variable */ pVar = (pSicsVariable)pCom->pData; fMean = pVar->fVal; } diff --git a/ofac.c b/ofac.c index 3e28f31c..e268f5d5 100644 --- a/ofac.c +++ b/ofac.c @@ -105,6 +105,7 @@ #include "tas.h" #include "synchronize.h" #include "definealias.h" +#include "swmotor.h" /*----------------------- Server options creation -------------------------*/ static int IFServerOption(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]) @@ -282,6 +283,7 @@ AddCommand(pInter,"MakeLin2Ang",MakeLin2Ang,NULL,NULL); AddCommand(pInter,"MakeTAS",TASFactory,NULL,NULL); AddCommand(pInter,"MakeSync",MakeSync,NULL,NULL); + AddCommand(pInter,"MakeSWMotor",MakeSWMotor,NULL,NULL); } /*---------------------------------------------------------------------------*/ static void KillIniCommands(SicsInterp *pSics) @@ -336,6 +338,7 @@ RemoveCommand(pSics,"MakeLin2Ang"); RemoveCommand(pSics,"MakeTAS"); RemoveCommand(pSics,"MakeSync"); + RemoveCommand(pSics,"MakeSWMotor"); } diff --git a/sinqhm/SinqHM_bootParamsConfig.c b/sinqhm/SinqHM_bootParamsConfig.c index b4f5de88..595fbd6a 100755 --- a/sinqhm/SinqHM_bootParamsConfig.c +++ b/sinqhm/SinqHM_bootParamsConfig.c @@ -368,13 +368,13 @@ sbpc_showHelp (errmsg); return False; } /* xOff*/ - if ((sscanf (p_arg2, "%i", &xOff) != 1) || (xOff <= 0)) { + if ((sscanf (p_arg2, "%i", &xOff) != 1)) { sprintf (errmsg, "The value for <#-xOff>, \"%s\", is illegal!\n" "It must be a positive integer.", p_arg1); sbpc_showHelp (errmsg); return False; } /* xFac */ - if ((sscanf (p_arg3, "%i", &xFac) != 1) || (xFac <= 0)) { + if ((sscanf (p_arg3, "%i", &xFac) != 1)|| xFac <= 0) { sprintf (errmsg, "The value for <#-xFac>, \"%s\", is illegal!\n" "It must be a positive integer.", p_arg1); sbpc_showHelp (errmsg); @@ -387,7 +387,7 @@ sbpc_showHelp (errmsg); return False; } /* yOff*/ - if ((sscanf (p_arg5, "%i", &yOff) != 1) || (yOff <= 0)) { + if ((sscanf (p_arg5, "%i", &yOff) != 1)) { sprintf (errmsg, "The value for <#-yOff>, \"%s\", is illegal!\n" "It must be a positive integer.", p_arg1); sbpc_showHelp (errmsg); diff --git a/sinqhm/SinqHM_def.h b/sinqhm/SinqHM_def.h index 2a222b6b..724cf110 100755 --- a/sinqhm/SinqHM_def.h +++ b/sinqhm/SinqHM_def.h @@ -214,11 +214,13 @@ #define LWL_TOF_C9 (0x09000000) /* TOF-Mode 9 chan dgrm hdr */ #define LWL_PSD_TSI 0x0E000000 /* PSD-Mode TSI datagram */ -#define LWL_PSD_DATA 0x13000000 /* PSD-mode data datagram */ +#define LWL_PSD_DATA 0x12000000 /* PSD-mode data datagram */ #define LWL_PSD_PWF 0x20000000 /* PSD-mode Power Fail bit */ #define LWL_PSD_TIME 0x000fffff /* PSD-mode time stamp extraction mask */ #define LWL_PSD_FLASH_MASK 0x00ff /* mask for flash count */ +#define LWL_PSD_XORF 0x2000 /* mask for TDC-XORF bit */ +#define LWL_PSD_CONF 0x0100 /* mask for TDC-CONF flag */ #define LWL_SM_NC (0x10000000) /* Strobo-Mode/No-Coinc 0 chan dgrm hdr */ #define LWL_SM_NC_C1 (0x11000000) /* Strobo-Mode/No-Coinc 1 chan dgrm hdr */ diff --git a/sinqhm/SinqHM_gbl.h b/sinqhm/SinqHM_gbl.h index 130a452b..80f06314 100755 --- a/sinqhm/SinqHM_gbl.h +++ b/sinqhm/SinqHM_gbl.h @@ -185,7 +185,8 @@ int psdFlashCount; int psdHitCount; int psdXSize; - int psdYSize; + int psdYSize; + int psdXORF, psdConf; /*========================== Define the function prototypes ================*/ void catch_int_signal ( diff --git a/sinqhm/SinqHM_srv_filler.c b/sinqhm/SinqHM_srv_filler.c index 8a9caf54..e8ebd4c9 100755 --- a/sinqhm/SinqHM_srv_filler.c +++ b/sinqhm/SinqHM_srv_filler.c @@ -167,13 +167,16 @@ if (lwl_hdr.ui4 == LWL_FIFO_EMPTY) { taskDelay (0); /* If FIFO is empty, we can take a breather! */ }else if ((lwl_hdr.ui4 & LWL_HDR_TYPE_MASK) == LWL_HM_NC_C1) { - /* Histo data, single channel */ VmioBase[VMIO_PORT_A] = 0xff; /* Set timer level (if present) */ - for (i=0; i<1000; i++) { + + for (i=0; i<1000000; i++) { lwl_data.ui4 = *Lwl_fifo; /* Get the 16 bits of data */ - if (lwl_data.ui4 != LWL_FIFO_EMPTY) break; - taskDelay (0); /* But wait if FIFO is slow! */ + if (lwl_data.ui4 != LWL_FIFO_EMPTY) { + break; + } + taskDelay (0); /* But wait if FIFO is slow! */ } + if (lwl_data.ui4 == LWL_FIFO_EMPTY) { printf ("Time-out getting histogram data word! Event # = %d\n", N_events); @@ -239,20 +242,24 @@ VmioBase[VMIO_PORT_A] = 0x00; /* Reset timer level (if present) */ N_events++; }else if ((lwl_hdr.ui4 & LWL_HDR_TYPE_MASK) == LWL_TSI_HM_NC) { + process_no_coinc_tsi (lwl_hdr.ui4); /* We have found a "normal" ** TSI (Timing-Status-Info) header. Process ** it. */ }else if ((lwl_hdr.ui4 & LWL_HDR_TYPE_MASK) == LWL_TSI_HM_C) { + process_coinc_tsi (lwl_hdr.ui4); /* We have found a "coincidence" ** type TSI header. The packet has 10 bytes ** altogether. Process it. */ }else { /* Anything else gets flushed */ lwl_Packet_Read (lwl_hdr.ui4, my_buff); + } - if (FillTimer_expired) { +/* if (FillTimer_expired) { */ + if (0) { if (Print_hdr) printf ("\nTaking data in Digitised Histogramming Mode\n" " #-Events #-Skip #-TSI Dead-Time Sync-Status\n"); Print_hdr = False; @@ -711,7 +718,7 @@ */ void SinqHM_filler_daq_psd () { /* ===================== -** Routine to handle Time-of-flight Mode +** Routine to handle PSD-TOF Mode ** Note: ** Lwl_fifo could, in principle, be accessed via a register for better ** efficiency. However, this can cause trouble with the GDB debugger @@ -727,6 +734,7 @@ } lwl_hdr, xData, yData; int xPos, yPos, iTime, dataPos; + signed int sPosx, sPosy; int i, j, is, ts, left, right, middl, not_finished; uint *edge_pntr; char er_eol[] = {ESC, '[', '0', 'J'}; /* Erase to End-of-Line */ @@ -793,8 +801,16 @@ /* We have a valid PSD packet. Find and check positions. */ - xPos = (xData.ui2[1] - psdXOffset)/psdXFactor; - yPos = (yData.ui2[1] - psdYOffset)/psdYFactor; + xPos = xData.ui2[1]; + if(xPos >= 32767) + xPos -= 65536; + + yPos = yData.ui2[1]; + if(yPos >= 32767) + yPos -= 65536; + + xPos = (xPos + psdXOffset)/psdXFactor; + yPos = (yPos + psdYOffset)/psdYFactor; if(xPos < 0 || xPos > psdXSize) { printf("X position out of range: %d, alllowed 0 - %d\n", @@ -896,6 +912,8 @@ if ((Tsi_flags & STATUS_FLAGS__SYNC0) != 0) printf (" SYNC0"); if ((Tsi_flags & STATUS_FLAGS__UD) != 0) printf (" UD"); if ((Tsi_flags & STATUS_FLAGS__GU) != 0) printf (" GU"); + if(psdXORF) printf(" XORF"); + if(psdConf) printf(" CONF"); is = timer_settime (FillTimerId, ~TIMER_ABSTIME, &FillerTime, NULL); if (is != 0) { diff --git a/sinqhm/SinqHM_srv_routines.c b/sinqhm/SinqHM_srv_routines.c index 99845351..ecb1a318 100755 --- a/sinqhm/SinqHM_srv_routines.c +++ b/sinqhm/SinqHM_srv_routines.c @@ -3469,7 +3469,9 @@ for (j=0; j<3; j++) { /* Get the remaining 6 bytes */ for (i=0; i<1000; i++) { lwl_data.ui4 = *Lwl_fifo; /* Get the last 16 bits */ - if (lwl_data.ui4 != LWL_FIFO_EMPTY) break; + if (lwl_data.ui4 != LWL_FIFO_EMPTY) { + break; + } taskDelay (0); /* But wait if FIFO is slow! */ } if (lwl_data.ui4 == LWL_FIFO_EMPTY) { @@ -3533,6 +3535,7 @@ } words[j] = lwl_data.ui2[1]; } +/* printf(" %X %X %X\n", words[0], words[1], words[2]); */ N_coin_tsi++; Dt_or_dts.both = hdr & LWL_TSI_DT_MSK; @@ -3554,6 +3557,16 @@ */ psdHitCount += words[1]; psdFlashCount += words[2] & LWL_PSD_FLASH_MASK; + if((words[2] & LWL_PSD_XORF) != 0) { + psdXORF = 1; + }else { + psdXORF = 0; + } + if((words[2] & LWL_PSD_CONF) != 0) { + psdConf = 0; + }else { + psdConf = 1; + } } /* @@ -3575,7 +3588,9 @@ for (i=0; i<1000; i++) { lwl_data.ui4 = *Lwl_fifo; /* Get the last 16 bits */ - if (lwl_data.ui4 != LWL_FIFO_EMPTY) break; + if (lwl_data.ui4 != LWL_FIFO_EMPTY) { + break; + } taskDelay (0); /* But wait if FIFO is slow! */ } if (lwl_data.ui4 == LWL_FIFO_EMPTY) { diff --git a/sinqhm/lwl_client.c b/sinqhm/lwl_client.c index ca71c9b8..17ff85be 100755 --- a/sinqhm/lwl_client.c +++ b/sinqhm/lwl_client.c @@ -360,6 +360,7 @@ printf ("\nCycle %5d", i+1); for (j = 0; j < nrec; j++) { status = send (Cnct_skt, p_recs[j], (*p_recs[j])+1, 0); + sleep(2); } } printf ("\nDone.\n"); diff --git a/sinqhmdriv.c b/sinqhmdriv.c index 4e46c0df..03027cb4 100644 --- a/sinqhmdriv.c +++ b/sinqhmdriv.c @@ -568,15 +568,16 @@ { return HWPause; } + /* else if(iDaq == 1) { status = HWBusy; - } + } + */ else if(iDaq == 0) { status = HWIdle; } - return status; } diff --git a/switchedmotor.w b/switchedmotor.w new file mode 100644 index 00000000..f9ff8841 --- /dev/null +++ b/switchedmotor.w @@ -0,0 +1,97 @@ +\subsection{Switched Motors} +At TOPSI there is a set of motors which share a single EL734 motor slot. Which + motor is adressed is switched via a SPS. The idea was to save money but really + this is a pain in the ass. Especially as the motors do not have own encoders. + This module implements sofwtare support for this setup. Virtual motors are + defined for the slave motors. The algorithm implemented works as follows: + +There is always an active motor which is currently adressed. When +{\bf reading } the motor either a stored value is returned (when the +motor is not adressed) or the real value is read from the motor. When +driving a motor the following things happen: +\begin{itemize} +\item If the motor is active the motor is directly driven. +\item If the motor is not active: +\begin{itemize} +\item The correct motor is switched to in the SPS. +\item A reference run is made. +\item The motor is finally driven. +\end{itemize} +\end{itemize} + + +In order to do all this we need yet another data structure: + +@d swdata @{ + typedef struct __SWMOT { + pObjectDescriptor pDes; + pIDrivable pDriv; + pMotor pMaster; + int *selectedMotor; + int myNumber; + float positions[3]; + char slaves[3][80]; + char *switchFunc; + int errCode; + } SWmot, *pSWmot; +@} + +The fields are: +\begin{description} +\item[pDes] The standard SICS object descriptor. +\item[pDriv] The drivable interface. +\item[pMaster] The EL734 motor used as the master motor for driving + the slaves. +\item[myNumber] The number of the motor implemented by this object. +\item[selectedMotor] The number of the selected motor. This must be a +pointer in order to be shared among multiple copies of this. +\item[slaves] The names of the slave motors. +\item[switchFunc] is the name of a interpreter function which does + the switching to another motor. Usually this will be implemented in +Tcl. This gives some level of portability to other setups. The syntax +shall be : status = switchFun motNumber. status will either hold OK on + return or the error encountered. +\item[errCode] is an internal error code. +\end{description} + +Of course there will be three copies of this structure for the three +slave motors. + +Most feautures of this module will be implemented in the functions of +the drivable interface or internal functions. The only additional +functions needed provide the interface for the interpreter: + +@d swint @{ + int MakeSWMotor(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); + + int SWMotorAction(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); +@} + +@o swmotor.h @{ +/*---------------------------------------------------------------------- + TOPSI switched motors. Three motors share a EL734 motor. Between is + switched through a SPS. + + Mark Koennecke, May 2001 +-----------------------------------------------------------------------*/ +#ifndef SWMOTOR +#define SWMOTOR +#include "obdes.h" +#include "interface.h" +#include "motor.h" +@ +#endif +@} + +@o swmotor.i @{ +/* ---------------------------------------------------------------------- + Internal data structure for the switched motor module. For + documentation see swmotor.tex. + + Mark Koennecke, May 2001 +----------------------------------------------------------------------*/ +@ + +@} \ No newline at end of file diff --git a/swmotor.c b/swmotor.c new file mode 100644 index 00000000..6a5881f3 --- /dev/null +++ b/swmotor.c @@ -0,0 +1,547 @@ +/*-------------------------------------------------------------------------- + TOPSI switched motors implementation module. Three motors share a common + EL734 motor. The actual motor is selected through a SPS. More information in + file switchedmotor.tex or with Jochen Stahn. + + copyright: see file copyright.h + + Mark Koennecke, May 2001 + --------------------------------------------------------------------------*/ +#include +#include +#include +#include +#include "fortify.h" +#include "sics.h" +#include "SCinter.h" +#include "splitter.h" +#include "hardsup/sinq_prototypes.h" +#include "hardsup/rs232c_def.h" +#include "hardsup/el734_def.h" +#include "hardsup/el734fix.h" +#include "modriv.h" +#include "swmotor.h" +#include "swmotor.i" + +/*======================================================================== + We start of by implementing the interface functions for the various + interfaces this module has to implement. + ==========================================================================*/ +static int SWHalt(void *pData) +{ + pSWmot self = (pSWmot)pData; + assert(self); + return self->pMaster->pDrivInt->Halt(self->pMaster); +} +/*--------------------------------------------------------------------*/ +static int SWCheckLimits(void *pData, float fVal, char *error, int iErrLen) +{ + pSWmot self = (pSWmot)pData; + assert(self); + return self->pMaster->pDrivInt->CheckLimits(self->pMaster, + fVal,error,iErrLen); +} +/*--------------------------------------------------------------------*/ +static int SWCheckStatus(void *pData, SConnection *pCon) +{ + pSWmot self = (pSWmot)pData; + assert(self); + return self->pMaster->pDrivInt->CheckStatus(self->pMaster, + pCon); +} +/*---------------------------------------------------------------------*/ +static int SWSaveStatus(void *pData, char *name, FILE *fd) +{ + pSWmot self = (pSWmot)pData; + assert(self); + + fprintf(fd,"%s savedValue = %f\n", name, + self->positions[self->myNumber]); + return 1; +} +/*-----------------------------------------------------------------------*/ +static void *SWGetInterface(void *pData, int ID) +{ + pSWmot self = (pSWmot)pData; + assert(self); + + if(ID == DRIVEID) + { + return self->pDriv; + } + return NULL; +} +/*----------------------------------------------------------------------*/ +static float SWGetValue(void *pData, SConnection *pCon) +{ + pSWmot self = (pSWmot)pData; + float fVal; + assert(self); + + /* + we are not selected: return stored data: + */ + if(self->myNumber != self->selectedMotor[0]) + { + SCWrite(pCon,"WARNING: motor not activem returning stored value", + eWarning); + return self->positions[self->myNumber]; + } + else + { + fVal = self->pMaster->pDrivInt->GetValue(self->pMaster, pCon); + self->positions[self->myNumber] = fVal; + return fVal; + } +} +/*-----------------------------------------------------------------------*/ +static long SWSetValue(void *pData, SConnection *pCon, float fVal) +{ + pSWmot self = (pSWmot)pData; + char pCommand[256], pError[132]; + int status; + EL734Driv *pElli; + Tcl_Interp *pTcl; + + assert(self); + self->errCode = 1; + + /* + first case: we are already selected + */ + if(self->myNumber == self->selectedMotor[0]) + { + return self->pMaster->pDrivInt->SetValue(self->pMaster,pCon,fVal); + } + else + { + /* + second case: switch to the requested motor, do a reference run + and then execute Set command + */ + sprintf(pCommand,"Switching to motor number %d", self->myNumber); + SCWrite(pCon,pCommand,eWarning); + sprintf(pCommand,"%s %d",self->switchFunc, self->myNumber); + pTcl = (Tcl_Interp *)pServ->pSics->pTcl; + status = Tcl_Eval(pTcl,pCommand); + strncpy(pError,pTcl->result, 131); + if(status != TCL_OK || strstr(pError,"OK") == NULL) + { + sprintf(pCommand,"ERROR: %s while switching motor", pError); + SCWrite(pCon,pCommand, eError); + self->errCode = -1001; + return HWFault; + } + self->selectedMotor[0] = self->myNumber; + + /* + switch done! Start a reference run + */ + SicsWait(10); + SCWrite(pCon,"Standby, starting reference run... ", eWarning); + pElli = (EL734Driv *)self->pMaster->pDriver; + sprintf(pCommand,"R %d\r",pElli->iMotor); + status = EL734_SendCmnd(&(pElli->EL734struct), + pCommand, + pError, 131); + if(status != 1) + { + sprintf(pCommand,"ERROR: %s while trying to start reference run", + pError); + SCWrite(pCon,pCommand,eError); + self->errCode = -1002; + return HWFault; + } + /* + now loop forever until reference run is done. This is either when the + motors stops being busy or when the user interrupts. + */ + sprintf(pCommand,"SS %d\r",pElli->iMotor); + for( ; ;) + { + status = EL734_SendCmnd(&(pElli->EL734struct), + pCommand, + pError, 131); + if(status != 1) + { + sprintf(pCommand,"ERROR: %s during reference run", + pError); + SCWrite(pCon,pCommand,eError); + self->errCode = -1003; + return HWFault; + } + if(strstr(pError,"?BSY") == NULL) + break; + if(SCGetInterrupt(pCon) != eContinue) + { + self->errCode = -1004; + SCWrite(pCon,"ERROR: user interrupted reference run",eError); + return HWFault; + } + SicsWait(2); + } + + /* + now this is finished. We can really start driving the motor + */ + SCWrite(pCon,"Reference run completed, starting to drive motor..", + eWarning); + return self->pMaster->pDrivInt->SetValue(self->pMaster,pCon,fVal); + } +} +/*----------------------------------------------------------------------*/ +static void KillSWFull(void *pData) +{ + pSWmot self = (pSWmot)pData; + if(self == NULL) + return; + + if(self->pDriv) + free(self->pDriv); + if(self->pDes) + DeleteDescriptor(self->pDes); + if(self->selectedMotor) + free(self->selectedMotor); + if(self->switchFunc) + free(self->switchFunc); + free(self); +} +/*---------------------------------------------------------------------*/ +static void KillSWHalf(void *pData) +{ + pSWmot self = (pSWmot)pData; + if(self) + free(self); +} +/*---------------------------------------------------------------------- + Alright, now the interpreter functions follow + Usage: + MakeSWMotor master switchFunc slave1 slave2 slave3 + -----------------------------------------------------------------------*/ +int MakeSWMotor(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]) +{ + pSWmot sw1, sw2, sw3; + char pBueffel[256]; + int i, status; + + /* + check that we have enough arguments + */ + if(argc < 6) + { + SCWrite(pCon,"ERROR: insufficient number of arguments to MakeSWMotor", + eError); + return 0; + } + + /* + allocate a new data structure + */ + sw1 = (pSWmot)malloc(sizeof(SWmot)); + if(sw1 == NULL) + { + SCWrite(pCon,"ERROR: out of memory in MakeSWMotor",eError); + return 0; + } + memset(sw1,0,sizeof(SWmot)); + + /* + fill it up with stuff + */ + sw1->pDes = CreateDescriptor("Sparbroetchen"); + sw1->pDriv = CreateDrivableInterface(); + sw1->selectedMotor = (int *)malloc(sizeof(int)); + if(!sw1->pDes || ! sw1->pDriv || !sw1->selectedMotor) + { + SCWrite(pCon,"ERROR: out of memory in MakeSWMotor",eError); + return 0; + } + sw1->selectedMotor[0] = -1; + sw1->pMaster = FindMotor(pSics,argv[1]); + if(!sw1->pMaster) + { + sprintf(pBueffel,"ERROR: cannot find master motor %s", argv[1]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + sw1->switchFunc = strdup(argv[2]); + for(i = 0; i < 3; i++) + { + strcpy(sw1->slaves[i],argv[3+i]); + } + + /* + initialize function pointers + */ + sw1->pDes->SaveStatus = SWSaveStatus; + sw1->pDes->GetInterface = SWGetInterface; + sw1->pDriv->GetValue = SWGetValue; + sw1->pDriv->SetValue = SWSetValue; + sw1->pDriv->Halt = SWHalt; + sw1->pDriv->CheckStatus = SWCheckStatus; + sw1->pDriv->CheckLimits = SWCheckLimits; + + /* + create clones of the new data structure ofr the other slaves + */ + sw2 = (pSWmot)malloc(sizeof(SWmot)); + sw3 = (pSWmot)malloc(sizeof(SWmot)); + if(!sw2 || !sw2) + { + SCWrite(pCon,"ERROR: out of memory in MakeSWMotor",eError); + return 0; + } + memcpy(sw2,sw1,sizeof(SWmot)); + sw2->myNumber = 1; + memcpy(sw3,sw1,sizeof(SWmot)); + sw3->myNumber = 2; + + /* + install commands + */ + status = AddCommand(pSics, argv[3], SWMotorAction, KillSWFull, sw1); + if(!status) + { + sprintf(pBueffel,"ERROR: command %s already exists!",argv[3]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + status = AddCommand(pSics, argv[4], SWMotorAction, KillSWHalf, sw2); + if(!status) + { + sprintf(pBueffel,"ERROR: command %s already exists!",argv[4]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + status = AddCommand(pSics, argv[5], SWMotorAction, KillSWHalf, sw3); + if(!status) + { + sprintf(pBueffel,"ERROR: command %s already exists!",argv[3]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + + return 1; +} +/*------------------------------------------------------------------- + some prototypes from functions implemented in motor.c + --------------------------------------------------------------------*/ +void MotorListLL(pMotor self, SConnection *pCon); +void MotorReset(pMotor pM); +/*---------------------------------------------------------------------*/ +int SWMotorAction(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]) +{ + char pBueffel[512]; + TokenList *pList = NULL; + TokenList *pCurrent; + TokenList *pName; + int iRet; + pSWmot self = NULL; + float fValue; + long lID; + + assert(pCon); + assert(pSics); + assert(pData); + + self = (pSWmot)pData; + + /* create Tokenlist */ + argtolower(argc,argv); + pList = SplitArguments(argc,argv); + if(!pList) + { + SCWrite(pCon,"Error parsing argument list in SWMotorAction",eError); + return 0; + } + + /* first argument can be one of list, reset or parameter name */ + pCurrent = pList->pNext; + if(!pCurrent) /* no argument, print value */ + { + fValue = self->pDriv->GetValue(self,pCon); + if(fValue < -990.) + { + sprintf(pBueffel,"Error obtaining position for %s",argv[0]); + SCWrite(pCon,pBueffel,eValue); + DeleteTokenList(pList); + return 0; + } + sprintf(pBueffel,"%s = %f",argv[0],fValue); + SCWrite(pCon,pBueffel,eValue); + DeleteTokenList(pList); + return 1; + } + + /* check for list */ + if(strcmp(pCurrent->text,"list") == 0) + { + MotorListLL(self->pMaster,pCon); + DeleteTokenList(pList); + return 1; + } /* check for reset */ + else if(strcmp(pCurrent->text,"reset") == 0) + { + if(!SCMatchRights(pCon,usUser)) + { + sprintf(pBueffel,"Insufficient privilege to reset %s", + argv[0]); + SCWrite(pCon,pBueffel,eError); + DeleteTokenList(pList); + return 0; + } + MotorReset(self->pMaster); + DeleteTokenList(pList); + SCSendOK(pCon); + return 1; + } + else if(strcmp(pCurrent->text,"savedValue") == 0) + { + pCurrent = pCurrent->pNext; + if(!pCurrent) + { + /* + print Value + */ + sprintf(pBueffel,"%s.savedValue = %f", argv[0], + self->positions[self->myNumber]); + SCWrite(pCon,pBueffel,eValue); + DeleteTokenList(pList); + return 1; + } + else + { + /* + set saveValue, must be a numeric parameter + */ + if(pCurrent->Type == eInt) + { + fValue = (float)pCurrent->iVal; + } + else if(pCurrent->Type == eFloat) + { + fValue = pCurrent->fVal; + } + else + { + sprintf(pBueffel,"Wrong argument type for %s %s ", + argv[0],"saveValue"); + SCWrite(pCon,pBueffel,eError); + DeleteTokenList(pList); + return 0; + } + self->positions[self->myNumber] = fValue; + SCSendOK(pCon); + return 1; + } + } + else if(strcmp(pCurrent->text,"selected") == 0) + { + pCurrent = pCurrent->pNext; + if(!pCurrent) + { + /* + print Value + */ + sprintf(pBueffel,"%s.selected = %d", argv[0], + self->selectedMotor[0]); + SCWrite(pCon,pBueffel,eValue); + DeleteTokenList(pList); + return 1; + } + else + { + /* + set selected, must be a numeric parameter + */ + if(pCurrent->Type == eInt) + { + fValue = (float)pCurrent->iVal; + } + else if(pCurrent->Type == eFloat) + { + fValue = pCurrent->fVal; + } + else + { + sprintf(pBueffel,"Wrong argument type for %s %s ", + argv[0],"selected"); + SCWrite(pCon,pBueffel,eError); + DeleteTokenList(pList); + return 0; + } + self->selectedMotor[0] = (int)fValue; + SCSendOK(pCon); + return 1; + } + } + else /* one of the parameter commands or error left now */ + { + pName = pCurrent; + pCurrent = pCurrent->pNext; + if(!pCurrent) /* no third par: print val */ + { + /* deal with position first */ + if(strcmp(pName->text,"position") == 0) + { + fValue = self->pDriv->GetValue(self,pCon); + if(fValue < 999.) + { + sprintf(pBueffel,"Error obtaining position for %s",argv[0]); + SCWrite(pCon,pBueffel,eValue); + DeleteTokenList(pList); + return 0; + } + sprintf(pBueffel,"%s.SoftPosition = %f",argv[0],fValue); + SCWrite(pCon,pBueffel,eValue); + DeleteTokenList(pList); + return 1; + } + iRet = MotorGetPar(self->pMaster,pName->text,&fValue); + if(!iRet) + { + sprintf(pBueffel,"Parameter %s not found ",pName->text); + SCWrite(pCon,pBueffel,eValue); + DeleteTokenList(pList); + return 0; + } + else + { + sprintf(pBueffel, " %s.%s = %f",argv[0],pName->text,fValue); + SCWrite(pCon,pBueffel,eValue); + DeleteTokenList(pList); + return 1; + } + } + else /* set */ + { /* set command */ + /* parameter must be numerical value */ + if(pCurrent->Type == eInt) + { + fValue = (float)pCurrent->iVal; + } + else if(pCurrent->Type == eFloat) + { + fValue = pCurrent->fVal; + } + else + { + sprintf(pBueffel,"Wrong argument type for %s %s set", + argv[0],pName->text); + SCWrite(pCon,pBueffel,eError); + DeleteTokenList(pList); + return 0; + } + iRet = MotorSetPar(self->pMaster,pCon,pName->text,fValue); + DeleteTokenList(pList); + if(iRet) + SCSendOK(pCon); + return iRet; + } + } + return 0; +} + + diff --git a/swmotor.h b/swmotor.h new file mode 100644 index 00000000..cc15e6a6 --- /dev/null +++ b/swmotor.h @@ -0,0 +1,20 @@ + +/*---------------------------------------------------------------------- + TOPSI switched motors. Three motors share a EL734 motor. Between is + switched through a SPS. + + Mark Koennecke, May 2001 +-----------------------------------------------------------------------*/ +#ifndef SWMOTOR +#define SWMOTOR +#include "obdes.h" +#include "interface.h" +#include "motor.h" + + int MakeSWMotor(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); + + int SWMotorAction(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); + +#endif diff --git a/swmotor.i b/swmotor.i new file mode 100644 index 00000000..5efd2413 --- /dev/null +++ b/swmotor.i @@ -0,0 +1,21 @@ + +/* ---------------------------------------------------------------------- + Internal data structure for the switched motor module. For + documentation see swmotor.tex. + + Mark Koennecke, May 2001 +----------------------------------------------------------------------*/ + + typedef struct __SWMOT { + pObjectDescriptor pDes; + pIDrivable pDriv; + pMotor pMaster; + int *selectedMotor; + int myNumber; + float positions[3]; + char slaves[3][80]; + char *switchFunc; + int errCode; + } SWmot, *pSWmot; + + diff --git a/t_update.c b/t_update.c new file mode 100644 index 00000000..11c42d3d --- /dev/null +++ b/t_update.c @@ -0,0 +1,489 @@ +/* t_update.f -- translated by f2c (version 20000817). + You must link the resulting object file with the libraries: + -lf2c -lm (in that order) +*/ + +#include "f2c.h" +#include + +/* Subroutine */ int t_update__(real *p_a__, real *p_ih__, real *c_ih__, + logical *lpa, real *dm, real *da, integer *isa, real *helm, real *f1h, + real *f1v, real *f2h, real *f2v, real *f, real *ei, real *aki, real * + ef, real *akf, real *qhkl, real *en, real *hx, real *hy, real *hz, + integer *if1, integer *if2, real *qm, integer *ier) +{ + static doublereal dakf, daki, dphi; + static integer ieri, imod, ieru; + extern /* Subroutine */ int ex_up__(doublereal *, doublereal *, + doublereal *, doublereal *, doublereal *, integer *); + static doublereal df; + static integer id; + static real qs; + static doublereal dbqhkl[3]; + extern /* Subroutine */ int sam_up__(doublereal *, doublereal *, + doublereal *, doublereal *, doublereal *, doublereal *, + doublereal *, doublereal *, integer *); + static doublereal da2, da3, da4, da6; + extern /* Subroutine */ int erreso_(integer *, integer *); + static doublereal dda, def, dei, ddm, dqm, dhx, dhy, dhz, dqs; + extern /* Subroutine */ int helm_up__(doublereal *, real *, real *, real * + , doublereal *, doublereal *, doublereal *, integer *), flip_up__( + integer *, integer *, real *, real *, real *, real *, real *, + real *, real *, integer *); + +/* =================== */ + +/* dec$ Ident 'V01C' */ +/* ------------------------------------------------------------------ */ +/* Note: */ +/* IF1,If2 changed to Int*4. They were Real*4 in ILL version. */ +/* ------------------------------------------------------------------ */ +/* Updates: */ +/* V01A 7-May-1996 DM. Put error output to IOLUN, use IMPLICIT NONE and */ +/* get the code indented so that it is readable! */ +/* V01C 12-Oct-1998 DM. Put in Mag Field calculation for SINQ Helmolz coils. */ +/* ----------------------------------------------------------------------- */ +/* Entry points in this file: */ +/* T_UPDATE : USE THE MOTOR ANGLES TO CALCULATE VALUES OF */ +/* EI,KI,EF,KF,QH,QK,QL,EN AND TO DETERMINE */ +/* WHETHER FLIPPERS F1,F2 ARE 'ON' OR 'OFF'. */ +/* EX_UP : CALCULATE EX AND AKX FORM AX2 VALUES. */ +/* SAM_UP : CALCULATE THINGS IN RECIPROCICAL LATTICE. */ +/* HELM_UP : CALCULATE HELMHOLTZ FIELDS. */ +/* FLIP_UP : CHECK IF FLIPPERS ON OR OFF. */ +/* ----------------------------------------------------------------------- */ +/* T_UPDATE: */ +/* ROUTINE TO USE THE MOTOR ANGLES TO */ +/* CALCULATE VALUES OF EI,KI,EF,KF,QH,QK,QL,EN */ +/* USE CURRENT-SUPPLY VALUES TO COMPUTE HELMHOLTZ FIELDS HX,HY,HZ */ +/* AND TO DETERMINE WHETHER FLIPPERS F1,F2 ARE 'ON' OR 'OFF'. */ +/* FLIPPERS ARE 'ON' ONLY IF CURRENTS ARE THOSE GIVEN BY */ +/* F1V,F1H,F2V,F2H */ +/* ----------------------------------------------------------------------- */ +/* File [MAD.SRC]T_UPDATE.FOR */ +/* cc IMPLICIT DOUBLE PRECISION (A-H,O-Z) */ +/* include 'iolsddef.inc' */ +/* ----------------------------------------------------------------------- */ +/* Define the dummy arguments */ +/* Input: */ +/* Positions of angles A1-A6. */ +/* .. helmotz (8 currents). */ +/* Position of currents for flippers and .. */ +/* Configuration of the machine ... */ +/* Conversion factors for Helmotz (4 currents). */ +/* True if machine in polarization mode. */ +/* Monochr. d-spacing */ +/* Analyser d-spacing */ +/* .. +ve to the left. */ +/* Scattering sense at analyser (probably) .. */ +/* .. ki (probably). */ +/* Angle between axis of Helmolz pair one and .. */ +/* .. current is possibly ki*f1h ??) */ +/* Flipper 1 hor and vert currents (hor .. */ +/* .. current is possibly kf*f2h ??) */ +/* Flipper 2 hor and vert currents (hor .. */ +/* Output: */ +/* Energy unit */ +/* Incident neutron energy */ +/* Incident neutron wave vector */ +/* Final neutron energy */ +/* Final neutron wave vector */ +/* Components of q in reciprocal space */ +/* Energy transfer */ +/* Components of Helmolz field on sample */ +/* Status of Flippers 1 and 2 */ +/* Length of q */ +/* ----------------------------------------------------------------------- */ +/* Error status */ + +/* ----------------------------------------------------------------------- */ +/* SET UP */ + + /* Parameter adjustments */ + --qhkl; + --c_ih__; + --p_ih__; + --p_a__; + + /* Function Body */ + ddm = *dm; + dda = *da; + df = *f; + da2 = p_a__[2]; + da3 = p_a__[3]; + da4 = p_a__[4]; + da6 = p_a__[6]; +/* ----------------------------------------------------------------------- */ + + ieri = 0; + ieru = 1; + ex_up__(&ddm, &dei, &daki, &da2, &df, &ieri); + if (ieri == 0) { + *ei = dei; + *aki = daki; + ieru = 0; + } else { + imod = 3; + erreso_(&imod, &ieri); + } + ieri = 0; + ieru = 1; + ex_up__(&dda, &def, &dakf, &da6, &df, &ieri); + if (ieri == 0) { + *ef = def; + *akf = dakf; + ieru = 0; + } else { + if (*isa == 0) { + *ef = dei; + *akf = daki; + def = dei; + dakf = daki; + ieru = 0; + } else { + imod = 3; + erreso_(&imod, &ieri); + } + } + if (*isa == 0) { + *ef = dei; + *akf = daki; + def = dei; + dakf = daki; + ieru = 0; + } + if (ieru == 0) { + *en = dei - def; + } + ieri = 0; + ieru = 1; + sam_up__(dbqhkl, &dqm, &dqs, &dphi, &daki, &dakf, &da3, &da4, &ieri); + if (ieri == 0) { + for (id = 1; id <= 3; ++id) { + qhkl[id] = dbqhkl[id - 1]; + } + *qm = dqm; + qs = dqs; + ieru = 0; + } else { + imod = 2; + erreso_(&imod, &ieri); + } + + ieri = 0; + if (*lpa) { + ieru = 1; + helm_up__(&dphi, helm, &p_ih__[1], &c_ih__[1], &dhx, &dhy, &dhz, & + ieri); + if (ieri != 0) { +/* WRITE(6,*) 'ERROR IN HELM_UP CHECK COEFF' */ + } else { + *hx = dhx; + *hy = dhy; + *hz = dhz; + ieru = 0; + } + flip_up__(if1, if2, &p_ih__[1], f1v, f1h, f2v, f2h, aki, akf, &ieri); + } +/* ----------------------------------------------------------------------- */ + *ier = ieru; + return 0; +} /* t_update__ */ + + +/* Subroutine */ int ex_up__(doublereal *dx, doublereal *ex, doublereal *akx, + doublereal *ax2, doublereal *f, integer *ier) +{ + /* System generated locals */ + doublereal d__1; + + /* Builtin functions */ + double sin(doublereal); + + /* Local variables */ + static doublereal arg; + +/* ================ */ + +/* ----------------------------------------------------------------------- */ +/* CALCULATE EX AND AKX FORM AX2 VALUES */ +/* ----------------------------------------------------------------------- */ +/* Part of [MAD.SRC]T_UPDATE.FOR */ + +/* ----------------------------------------------------------------------- */ +/* Define the dummy arguments */ +/* Input: */ +/* D-SPACING OF CRISTAL */ +/* TAKE OFF ANGLE */ +/* Output: */ +/* ENERGY UNIT */ +/* ENERGY */ +/* MOMENTUM */ +/* ----------------------------------------------------------------------- */ +/* Error - IER=1 if DX OR AX TOO SMALL */ +/* ----------------------------------------------------------------------- */ + arg = *dx * sin(*ax2 / 114.59155902616465); + if(arg < .0) + arg = -arg; + + if (arg <= 1e-4) { + *ier = 1; + } else { + *ier = 0; + *akx = 3.1415926535897932384626433832795 / arg; +/* Computing 2nd power */ + d__1 = *akx; + *ex = *f * (d__1 * d__1); + } +/* ----------------------------------------------------------------------- */ + return 0; +} /* ex_up__ */ + + +/* Subroutine */ int sam_up__(doublereal *qhkl, doublereal *qm, doublereal * + qs, doublereal *phi, doublereal *aki, doublereal *akf, doublereal *a3, + doublereal *a4, integer *ier) +{ + /* Builtin functions */ + double cos(doublereal), sin(doublereal), atan2(doublereal, doublereal); + + /* Local variables */ + static doublereal qpar, qperp; + extern /* Subroutine */ int sp2rlv_(doublereal *, doublereal *, + doublereal *, doublereal *, integer *); + static doublereal qt[3]; + +/* ================= */ +/* ----------------------------------------------------------------------- */ +/* Part of [MAD.SRC]T_UPDATE.FOR */ + +/* ----------------------------------------------------------------------- */ +/* Define the dummy arguments */ +/* Input: */ +/* Actual value of KI */ +/* Actual value of KF */ +/* Actual value of A3 */ +/* Output: */ +/* Actual value of A4 */ +/* CALCULATED POSITIONS IN RECIP. LATTICE */ +/* Q MODULUS */ +/* Q MODULUS SQUARED */ +/* ANGLE BETWEEN KI AND Q */ +/* NOT CALCULATED) */ +/* ----------------------------------------------------------------------- */ +/* LOCAL PARAMETERS */ +/* Error status. IER=1 if QM TOO SMALL (PHI */ +/* ----------------------------------------------------------------------- */ +/* QPAR AND QPERP ARE COMPONENTS OF Q PARALLEL AND PERP TO KI */ +/* TRANSFORM FROM SCATTERING PLANE INTO RECIPROCAL LATTICE */ + + /* Parameter adjustments */ + --qhkl; + + /* Function Body */ + qpar = *aki - *akf * cos(*a4 / 57.29577951308232087679815481410517); + qperp = -(*akf) * sin(*a4 / 57.29577951308232087679815481410517); + qt[0] = qpar * cos(*a3 / 57.29577951308232087679815481410517) + qperp * + sin(*a3 / 57.29577951308232087679815481410517); + qt[1] = -qpar * sin(*a3 / 57.29577951308232087679815481410517) + qperp * + cos(*a3 / 57.29577951308232087679815481410517); + qt[2] = 0.; + sp2rlv_(&qhkl[1], qt, qm, qs, ier); + *ier = 3; + if (*qm > .001) { + *ier = 0; + } + *phi = 0.; + if (abs(qperp) > .001 && abs(qpar) > .001) { + *phi = atan2(qperp, qpar); + } else if (abs(qpar) < .001) { + if (*a4 > 0.f) { + *phi = -1.5707963267948966; + } else { + *phi = 1.5707963267948966; + } + } +/* ----------------------------------------------------------------------- */ + return 0; +} /* sam_up__ */ + + +/* Subroutine */ int helm_up__(doublereal *phi, real *helm, real *p_ih__, + real *c_ih__, doublereal *dhx, doublereal *dhy, doublereal *dhz, + integer *ier) +{ + /* System generated locals */ + real r__1; + doublereal d__1, d__2; + + /* Builtin functions */ + double sqrt(doublereal), atan2(doublereal, doublereal), cos(doublereal), + sin(doublereal); + + /* Local variables */ + static doublereal hdir, hmod, hpar, hdir2, h__[4], hperp; + static integer ic; + static logical at_sinq__; + +/* ================== */ + +/* ---------------------------------------------------------------- */ +/* HELMHOLTZ COILS UPDATE (ONLY IF LPA IS TRUE) */ +/* ---------------------------------------------------------------- */ +/* Part of [MAD.SRC]T_UPDATE.FOR */ + +/* include 'common_sinq.inc' */ + +/* ----------------------------------------------------------------------- */ +/* At ILL: */ +/* There are 3 coils for Hx/Hy at 120 degrees to each other. */ + +/* There is a 4th coil for Hz. */ + +/* At SINQ: */ +/* There is an Hx coil and an Hy coil (actually each is 4 coils powered */ +/* in series). They are mounted on a ring (SRO). The value of HELM is */ +/* the angle between the Hx coil and ki. */ + +/* There is a 3rd coil for Hz. */ +/* ----------------------------------------------------------------------- */ +/* Define the dummy arguments */ +/* Input: */ +/* Angle between KI and Q in scatt'g plane (rad) */ +/* Angle between first coil and KI (degrees) */ +/* with Helmolz coils */ +/* Current values of 4 currents associated .. */ +/* Output: */ +/* Conversion factor between Amperes and Gauss */ +/* \ */ +/* > The calculated fields */ +/* / */ +/* ---------------------------------------------------------------- */ +/* LOCAL VARIABLES */ +/* Error status. IER=1 if C_I HAS A ZERO COEF */ +/* ---------------------------------------------------------------- */ +/* H !FIELD OF 4 COILS AROUND SAMPLE */ +/* HPAR !FIELD PAR COIL 1 */ +/* HPERP !FIELD PERP. TO COIL 1 */ +/* HDIR2 !ANGLE BETWEEN FIELD AND COIL 1 */ +/* HDIR !ANGLE BETWEEN FIELD AND Q */ +/* ---------------------------------------------------------------- */ + /* Parameter adjustments */ + --c_ih__; + --p_ih__; + + /* Function Body */ + *ier = 0; + at_sinq__ = TRUE_; + if (! at_sinq__) { + for (ic = 1; ic <= 4; ++ic) { + h__[ic - 1] = 0.; + if ((r__1 = c_ih__[ic], dabs(r__1)) > .001) { + h__[ic - 1] = p_ih__[ic + 4] * c_ih__[ic]; + } else { + *ier = 1; + } + } + hpar = h__[0] - (h__[1] + h__[2]) * .5; + hperp = sqrt(3.) * .5 * (h__[1] - h__[2]); + *dhz = h__[3]; + } else { + for (ic = 1; ic <= 3; ++ic) { + h__[ic - 1] = 0.; + if ((r__1 = c_ih__[ic], dabs(r__1)) > .001) { + h__[ic - 1] = p_ih__[ic + 4] * c_ih__[ic]; + } else { + *ier = 1; + } + } + hpar = h__[0]; + hperp = h__[1]; + *dhz = h__[2]; + } + +/* Computing 2nd power */ + d__1 = hpar; +/* Computing 2nd power */ + d__2 = hperp; + hmod = sqrt(d__1 * d__1 + d__2 * d__2); + if (abs(hpar) > .001 && abs(hperp) > .001) { + hdir2 = atan2((abs(hperp)), (abs(hpar))); + if (hpar > 0. && hperp < 0.) { + hdir2 = -hdir2; + } else if (hpar < 0. && hperp > 0.) { + hdir2 = 3.1415926535897932384626433832795 - hdir2; + } else if (hpar < 0. && hperp < 0.) { + hdir2 += -3.1415926535897932384626433832795; + } + } else if (abs(hpar) > .001) { + if (hpar >= 0.f) { + hdir2 = 0.f; + } + if (hpar < 0.f) { + hdir2 = 3.1415926535897932384626433832795; + } + } else if (abs(hperp) > .001) { + if (hperp >= 0.f) { + hdir2 = 1.5707963267948966; + } + if (hperp < 0.f) { + hdir2 = -1.5707963267948966; + } + } else { + hdir2 = 0.f; + } + hdir = hdir2 + *helm / 57.29577951308232087679815481410517 - *phi; + *dhx = hmod * cos(hdir); + *dhy = hmod * sin(hdir); + + return 0; +} /* helm_up__ */ + + +/* Subroutine */ int flip_up__(integer *if1, integer *if2, real *p_ih__, real + *f1v, real *f1h, real *f2v, real *f2h, real *aki, real *akf, integer * + ier) +{ + /* System generated locals */ + real r__1, r__2; + +/* ================== */ +/* ---------------------------------------------------------------- */ +/* FLIPPERS; ONLY IF LPA */ +/* ---------------------------------------------------------------- */ +/* Part of [MAD.SRC]T_UPDATE.FOR */ +/* ----------------------------------------------------------------------- */ +/* Define the dummy arguments */ +/* Input: */ +/* with flipper coils */ +/* Current values of 4 currents associated .. */ +/* .. current is possibly aki*f1h ??) */ +/* Flipper 1 vert and hor currents (hor .. */ +/* .. current is possibly akf*f2h ??) */ +/* Flipper 2 vert and hor currents (hor .. */ +/* Incident neutron wave vector */ +/* Output: */ +/* Final neutron wave vector */ +/* Status of Flipper 1 (=1 if on and set OK) */ +/* Status of Flipper 2 (=1 if on and set OK) */ +/* ---------------------------------------------------------------- */ +/* Error status. 0 if no error. */ + /* Parameter adjustments */ + --p_ih__; + + /* Function Body */ + *ier = 0; + *if1 = 0; + *if2 = 0; + if ((r__1 = p_ih__[1] - *f1v, dabs(r__1)) < .05f && (r__2 = p_ih__[2] - * + aki * *f1h, dabs(r__2)) < .05f) { + *if1 = 1; + } + if ((r__1 = p_ih__[3] - *f2v, dabs(r__1)) < .05f && (r__2 = p_ih__[4] - * + akf * *f2h, dabs(r__2)) < .05f) { + *if2 = 1; + } +/* ----------------------------------------------------------------------- */ + return 0; +} /* flip_up__ */ + diff --git a/t_update.f b/t_update.f new file mode 100755 index 00000000..0ff78f9d --- /dev/null +++ b/t_update.f @@ -0,0 +1,406 @@ + SUBROUTINE T_UPDATE ( ! File [MAD.SRC]T_UPDATE.FOR +c =================== + + P_A, P_IH, C_IH, + + LPA ,DM, DA, ISA, HELM, F1H, F1V, F2H, F2V, F, + + EI, AKI, EF, AKF, QHKL, EN, + + HX, HY, HZ, IF1, IF2, QM, IER) +c +cdec$ Ident 'V01C' +c------------------------------------------------------------------ +c Note: +c IF1,If2 changed to Int*4. They were Real*4 in ILL version. +c------------------------------------------------------------------ +c Updates: +c V01A 7-May-1996 DM. Put error output to IOLUN, use IMPLICIT NONE and +c get the code indented so that it is readable! +c V01C 12-Oct-1998 DM. Put in Mag Field calculation for SINQ Helmolz coils. +C----------------------------------------------------------------------- +c Entry points in this file: +C T_UPDATE : USE THE MOTOR ANGLES TO CALCULATE VALUES OF +c EI,KI,EF,KF,QH,QK,QL,EN AND TO DETERMINE +c WHETHER FLIPPERS F1,F2 ARE 'ON' OR 'OFF'. + +c EX_UP : CALCULATE EX AND AKX FORM AX2 VALUES. +c SAM_UP : CALCULATE THINGS IN RECIPROCICAL LATTICE. +c HELM_UP : CALCULATE HELMHOLTZ FIELDS. +c FLIP_UP : CHECK IF FLIPPERS ON OR OFF. +C----------------------------------------------------------------------- +c T_UPDATE: +C ROUTINE TO USE THE MOTOR ANGLES TO +C CALCULATE VALUES OF EI,KI,EF,KF,QH,QK,QL,EN +C USE CURRENT-SUPPLY VALUES TO COMPUTE HELMHOLTZ FIELDS HX,HY,HZ +C AND TO DETERMINE WHETHER FLIPPERS F1,F2 ARE 'ON' OR 'OFF'. +C FLIPPERS ARE 'ON' ONLY IF CURRENTS ARE THOSE GIVEN BY +C F1V,F1H,F2V,F2H +C----------------------------------------------------------------------- + IMPLICIT NONE +ccc IMPLICIT DOUBLE PRECISION (A-H,O-Z) +C include 'iolsddef.inc' +C----------------------------------------------------------------------- +c Define the dummy arguments +c Input: + real*4 p_a(6) ! Positions of angles A1-A6. + real*4 p_ih(8) ! Position of currents for flippers and .. + ! .. helmotz (8 currents). + real*4 c_ih(4) ! Conversion factors for Helmotz (4 currents). + ! Configuration of the machine ... + logical*4 lpa ! True if machine in polarization mode. + real*4 dm ! Monochr. d-spacing + real*4 da ! Analyser d-spacing + integer*4 isa ! Scattering sense at analyser (probably) .. + ! .. +ve to the left. + real*4 helm ! Angle between axis of Helmolz pair one and .. + ! .. ki (probably). + real*4 f1h, f1v ! Flipper 1 hor and vert currents (hor .. + ! .. current is possibly ki*f1h ??) + real*4 f2h, f2v ! Flipper 2 hor and vert currents (hor .. + ! .. current is possibly kf*f2h ??) + real*4 f ! Energy unit +c Output: + real*4 ei ! Incident neutron energy + real*4 aki ! Incident neutron wave vector + real*4 ef ! Final neutron energy + real*4 akf ! Final neutron wave vector + real*4 qhkl(3) ! Components of q in reciprocal space + real*4 en ! Energy transfer + real*4 hx, hy, hz ! Components of Helmolz field on sample + integer*4 if1, if2 ! Status of Flippers 1 and 2 + real*4 qm ! Length of q + integer*4 ier ! Error status +C----------------------------------------------------------------------- + double precision dbqhkl(3), dhx, dhy, dhz + double precision ddm, dda, df + double precision da2, da3, da4, da6 + double precision dei, daki, def, dakf + double precision dqm, dqs, dphi + real*4 qs +c + integer*4 ieri, ieru, imod, id +C----------------------------------------------------------------------- +C SET UP +C + DDM=DM + DDA=DA + DF=F + DA2=P_A(2) + DA3=P_A(3) + DA4=P_A(4) + DA6=P_A(6) +C----------------------------------------------------------------------- +C + IERI=0 + IERU=1 + CALL EX_UP(DDM,DEI,DAKI,DA2,DF,IERI) + IF (IERI.EQ.0) THEN + EI=DEI + AKI=DAKI + IERU=0 + ELSE + IMOD=3 + CALL ERRESO(IMOD,IERI) + ENDIF + IERI=0 + IERU=1 + CALL EX_UP(DDA,DEF,DAKF,DA6,DF,IERI) + IF (IERI.EQ.0) THEN + EF=DEF + AKF=DAKF + IERU=0 + ELSE + IF (ISA.EQ.0) THEN + EF=DEI + AKF=DAKI + DEF=DEI + DAKF=DAKI + IERU=0 + ELSE + IMOD=3 + CALL ERRESO(IMOD,IERI) + ENDIF + ENDIF + IF (ISA.EQ.0) THEN + EF=DEI + AKF=DAKI + DEF=DEI + DAKF=DAKI + IERU=0 + ENDIF + IF (IERU.EQ.0) EN=DEI-DEF + IERI=0 + IERU=1 + CALL SAM_UP(DBQHKL,DQM,DQS,DPHI,DAKI,DAKF,DA3,DA4,IERI) + IF (IERI.EQ.0) THEN + DO ID=1,3 + QHKL(ID)=DBQHKL(ID) + ENDDO + QM=DQM + QS=DQS + IERU=0 + ELSE + IMOD=2 + CALL ERRESO(IMOD,IERI) + ENDIF +C + IERI=0 + IF (LPA) THEN + IERU=1 + CALL HELM_UP(DPHI,HELM,P_IH,C_IH,DHX,DHY,DHZ,IERI) + IF (IERI.NE.0) THEN +C WRITE(6,*) 'ERROR IN HELM_UP CHECK COEFF' + ELSE + HX=DHX + HY=DHY + HZ=DHZ + IERU=0 + ENDIF + CALL FLIP_UP(IF1,IF2,P_IH,F1V,F1H,F2V,F2H,AKI,AKF,IERI) + ENDIF +C----------------------------------------------------------------------- + IER=IERU + RETURN + END +c + SUBROUTINE EX_UP(DX,EX,AKX,AX2,F,IER) ! Part of [MAD.SRC]T_UPDATE.FOR +c ================ +c +C----------------------------------------------------------------------- +C CALCULATE EX AND AKX FORM AX2 VALUES +C----------------------------------------------------------------------- + implicit none +c + DOUBLE PRECISION PI + PARAMETER (PI=3.1415926535897932384626433832795E0) + DOUBLE PRECISION RD + PARAMETER (RD=57.29577951308232087679815481410517E0) + DOUBLE PRECISION EPS4 + PARAMETER (EPS4=1.D-4) +C----------------------------------------------------------------------- +c Define the dummy arguments +c Input: + DOUBLE PRECISION DX ! D-SPACING OF CRISTAL + DOUBLE PRECISION AX2 ! TAKE OFF ANGLE + DOUBLE PRECISION F ! ENERGY UNIT +c Output: + DOUBLE PRECISION EX ! ENERGY + DOUBLE PRECISION AKX ! MOMENTUM + INTEGER*4 IER ! Error - IER=1 if DX OR AX TOO SMALL +C----------------------------------------------------------------------- + DOUBLE PRECISION ARG +C----------------------------------------------------------------------- +C!!!!!!!!!! This has to be fixed manually after conversion by f2c. +C!!!!!!!!!! The reason is a different definition of the abs function. +C!!!!!!!!!! MK, May 2001 + + ARG=ABS(DX*SIN(AX2/(2.D0*RD))) + IF(ARG.LE.EPS4) THEN + IER=1 + ELSE + IER=0 + AKX=PI/ARG + EX=F*AKX**2 + ENDIF +C----------------------------------------------------------------------- + RETURN + END +c + SUBROUTINE SAM_UP ( ! Part of [MAD.SRC]T_UPDATE.FOR +c ================= + + QHKL, QM, QS, PHI, + + AKI, AKF, A3, A4, IER) +C----------------------------------------------------------------------- + implicit none +c + double precision PI + PARAMETER (PI=3.1415926535897932384626433832795D0) + double precision RD + PARAMETER (RD=57.29577951308232087679815481410517D0) + double precision EPS3 + PARAMETER (EPS3=1.D-3) +C----------------------------------------------------------------------- +c Define the dummy arguments +c Input: + double precision AKI ! Actual value of KI + double precision AKF ! Actual value of KF + double precision A3 ! Actual value of A3 + double precision A4 ! Actual value of A4 +c Output: + double precision QHKL(3) ! CALCULATED POSITIONS IN RECIP. LATTICE + double precision QM ! Q MODULUS + double precision QS ! Q MODULUS SQUARED + double precision PHI ! ANGLE BETWEEN KI AND Q + integer*4 IER ! Error status. IER=1 if QM TOO SMALL (PHI + ! NOT CALCULATED) +C----------------------------------------------------------------------- +C LOCAL PARAMETERS + double precision QT(3) + double precision QPAR, QPERP +C----------------------------------------------------------------------- +C QPAR AND QPERP ARE COMPONENTS OF Q PARALLEL AND PERP TO KI +C TRANSFORM FROM SCATTERING PLANE INTO RECIPROCAL LATTICE +C + qpar = aki - akf * cos(a4/RD) + qperp = -akf * sin(a4/RD) + qt(1) = qpar * cos(a3/RD) + qperp * sin(a3/RD) + qt(2) = -qpar * sin(a3/RD) + qperp * cos(a3/RD) + qt(3) = 0.d0 + call sp2rlv (qhkl, qt, qm, qs, ier) + ier = 3 + if (qm .gt. EPS3) ier = 0 + phi = 0.d0 + if (abs(qperp) .gt. EPS3 .and. abs(qpar) .gt. EPS3) then + phi = atan2 (qperp, qpar) + elseif (abs(qpar) .lt. EPS3) then + if (a4 .gt. 0.0) then + phi = -0.5 * PI + else + phi = 0.5 * PI + endif + endif +c----------------------------------------------------------------------- + return + end +c + SUBROUTINE HELM_UP ( ! Part of [MAD.SRC]T_UPDATE.FOR +c ================== + + PHI, HELM, P_IH, C_IH, + + DHX, DHY, DHZ, IER) +c +C---------------------------------------------------------------- +C HELMHOLTZ COILS UPDATE (ONLY IF LPA IS TRUE) +C---------------------------------------------------------------- + implicit none +c +C include 'common_sinq.inc' +c + double precision PI + PARAMETER (PI = 3.1415926535897932384626433832795D0) + double precision RD + PARAMETER (RD = 57.29577951308232087679815481410517D0) + double precision EPS3 + PARAMETER (EPS3 = 1.0D-3) +C----------------------------------------------------------------------- +c At ILL: +c There are 3 coils for Hx/Hy at 120 degrees to each other. +c +c There is a 4th coil for Hz. +c +c At SINQ: +c There is an Hx coil and an Hy coil (actually each is 4 coils powered +c in series). They are mounted on a ring (SRO). The value of HELM is +c the angle between the Hx coil and ki. +c +c There is a 3rd coil for Hz. +C----------------------------------------------------------------------- +c Define the dummy arguments +c Input: + double precision PHI ! Angle between KI and Q in scatt'g plane (rad) + real*4 HELM ! Angle between first coil and KI (degrees) + real*4 P_IH(8) ! Current values of 4 currents associated .. + ! with Helmolz coils + real*4 C_IH(4) ! Conversion factor between Amperes and Gauss +c Output: + double precision DHX ! \ + double precision DHY ! > The calculated fields + double precision DHZ ! / + integer*4 IER ! Error status. IER=1 if C_I HAS A ZERO COEF +C---------------------------------------------------------------- +C LOCAL VARIABLES + integer*4 ic + double precision h(4), hpar, hperp, hmod, hdir, hdir2 + LOGICAL AT_SINQ +C---------------------------------------------------------------- +C H !FIELD OF 4 COILS AROUND SAMPLE +C HPAR !FIELD PAR COIL 1 +C HPERP !FIELD PERP. TO COIL 1 +C HDIR2 !ANGLE BETWEEN FIELD AND COIL 1 +C HDIR !ANGLE BETWEEN FIELD AND Q +C---------------------------------------------------------------- + ier = 0 + AT_SINQ = .TRUE. + if (.not. at_sinq) then + do ic = 1, 4 + h(ic) = 0.d0 + if (abs(c_ih(ic)) .gt. EPS3) then + h(ic) = p_ih(ic+4) * c_ih(ic) + else + ier = 1 + endif + enddo + hpar = h(1) - .5d0 * (h(2) + h(3)) + hperp = .5d0 * sqrt(3.d0) * (h(2) - h(3)) + dhz = h(4) + else + do ic = 1, 3 + h(ic) = 0.d0 + if (abs(c_ih(ic)) .gt. EPS3) then + h(ic) = p_ih(ic+4) * c_ih(ic) + else + ier = 1 + endif + enddo + hpar = h(1) + hperp = h(2) + dhz = h(3) + endif +c + hmod = sqrt (hpar**2 + hperp**2) + if (abs(hpar) .gt. EPS3 .and. abs(hperp) .gt. EPS3) then + hdir2 = atan2 (abs(hperp), abs(hpar)) + if (hpar .gt. 0 .and. hperp .lt. 0) then + hdir2 = -hdir2 + elseif (hpar .lt. 0 .and. hperp .gt. 0) then + hdir2 = PI - hdir2 + elseif (hpar .lt. 0 .and. hperp .lt. 0) then + hdir2 = hdir2 - PI + endif + elseif (abs(hpar) .gt. EPS3) then + if (hpar .ge. 0.0) hdir2 = 0.0 + if (hpar .lt. 0.0) hdir2 = PI + elseif (abs(hperp) .gt. EPS3) then + if (hperp .ge. 0.0) hdir2 = 0.5 * PI + if (hperp .lt. 0.0) hdir2 = -0.5 * PI + else + hdir2 = 0.0 + endif + hdir = hdir2 + (helm/RD) - phi + dhx = hmod * cos(hdir) + dhy = hmod * sin(hdir) +c + return + end +c + SUBROUTINE FLIP_UP ( ! Part of [MAD.SRC]T_UPDATE.FOR +c ================== + + IF1, IF2, + + P_IH, F1V, F1H, F2V, F2H, + + AKI, AKF, IER) +C---------------------------------------------------------------- +C FLIPPERS; ONLY IF LPA +C---------------------------------------------------------------- + implicit none +C----------------------------------------------------------------------- +c Define the dummy arguments +c Input: + real*4 p_ih(8) ! Current values of 4 currents associated .. + ! with flipper coils + real*4 f1v, f1h ! Flipper 1 vert and hor currents (hor .. + ! .. current is possibly aki*f1h ??) + real*4 f2v, f2h ! Flipper 2 vert and hor currents (hor .. + ! .. current is possibly akf*f2h ??) + real*4 aki ! Incident neutron wave vector + real*4 akf ! Final neutron wave vector +c Output: + integer*4 if1 ! Status of Flipper 1 (=1 if on and set OK) + integer*4 if2 ! Status of Flipper 2 (=1 if on and set OK) + integer*4 ier ! Error status. 0 if no error. +C---------------------------------------------------------------- + IER = 0 + IF1 = 0 + IF2 = 0 + IF ((ABS(P_IH(1) - F1V) .LT. 0.05) .AND. + + (ABS(P_IH(2) - AKI*F1H) .LT. 0.05)) IF1 = 1 + IF ((ABS(P_IH(3) - F2V) .LT. 0.05) .AND. + + (ABS(P_IH(4) - AKF*F2H) .LT. 0.05)) IF2 = 1 +C----------------------------------------------------------------------- + RETURN + END diff --git a/tasdrive.c b/tasdrive.c index a5aed3a1..d018bfbb 100644 --- a/tasdrive.c +++ b/tasdrive.c @@ -273,6 +273,7 @@ int TASDrive(SConnection *pCon, SicsInterp *pSics, void *pData, wait till we are finished */ status = Wait4Success(GetExecutor()); + TASUpdate(self,pCon); if(status == DEVINT) { if(SCGetInterrupt(pCon) == eAbortOperation) diff --git a/tasscan.c b/tasscan.c index 3e6cf19c..ebc76225 100644 --- a/tasscan.c +++ b/tasscan.c @@ -598,6 +598,7 @@ static int TASScanDrive(pScanData self, int iPoint) status = Wait4Success(GetExecutor()); } + TASUpdate(pTAS,self->pCon); return 1; } /*----------------------------------------------------------------------- diff --git a/tasu.h b/tasu.h index e813cc24..3bf1eaab 100644 --- a/tasu.h +++ b/tasu.h @@ -2,9 +2,11 @@ This is a helper header file which contains the prototypes for some functions to be used in the implementation of the triple axis spectrometer module. For more info on the functions see the comments in the - implemntation file tasutil.c + implementation file tasutil.c + + Initial Coding: Mark Koennecke, November 2000 + Added TASUpdate: Mark Koennecke, May 2001 - Mark Koennecke, November 2000 */ #ifndef TASUSICS #define TASUSICS @@ -38,6 +40,7 @@ int TASStart(pTASdata self, SConnection *pCon, SicsInterp *pSics, float motorTargets[20], unsigned char motorMask[20]); +int TASUpdate(pTASdata self, SConnection *pCon); #endif diff --git a/tasutil.c b/tasutil.c index 74825a3d..69487666 100644 --- a/tasutil.c +++ b/tasutil.c @@ -289,7 +289,7 @@ int TASCalc(pTASdata self, SConnection *pCon, if(self->tasPar[LPA]->iVal > 0) lpa = (logical)1; dm = (real)self->tasPar[DM]->fVal; - da = (real)self->tasPar[DM]->fVal; + da = (real)self->tasPar[DA]->fVal; qm = (real)self->tasPar[QM]->fVal; helm = (real)self->tasPar[HELM]->fVal; f1h = (real)self->tasPar[IF1H]->fVal; @@ -303,7 +303,7 @@ int TASCalc(pTASdata self, SConnection *pCon, /* initialize the helmholts currents. This needs work when - polarisation anlaysis is really supported. + polarisation analysis is really supported. */ for(i = 0; i < 4; i++) { @@ -474,5 +474,239 @@ int TASStart(pTASdata self, SConnection *pCon, SicsInterp *pSics, */ return 1; -} +} +/*------------------ from t_update.f converted to t_update.c -----------*/ +extern int t_update__(real *p_a__, real *p_ih__, real *c_ih__, + logical *lpa, real *dm, real *da, integer *isa, + real *helm, real *f1h, real *f1v, real *f2h, real *f2v, + real *f, real *ei, real *aki, real *ef, real *akf, + real *qhkl, real *en, real *hx, real *hy, real *hz, + integer *if1, integer *if2, real *qm, integer *ier); +/*--------------------------------------------------------------------------- + TASUpdate calculates the Q/E variables back from the motors A1-A6 and + then proceeds to update the energy variables. It also checks if the + analyzer monochromator motors match up i.e tth = 2*om. + ----------------------------------------------------------------------------*/ +int TASUpdate(pTASdata self, SConnection *pCon) +{ + real sam[16], amot[6], helmCurrent[8], convH[4], dm, da, helm, f1h, f1v; + real f, ei, aki, ef, akf, qhkl[3], en, hx, hy, hz, qm, f2v, f2h; + logical lpa; + integer isa, if1, if2, ier, ifx; + pMotor pMot; + char pBueffel[132]; + float fMot, diff; + int i, status; + + assert(self); + assert(pCon); + + /* + The first thing we need to do is to set up the orientation matrix + from the sample parameters. + */ + sam[0] = (real)self->tasPar[AS]->fVal; + sam[1] = (real)self->tasPar[BS]->fVal; + sam[2] = (real)self->tasPar[CS]->fVal; + sam[3] = (real)self->tasPar[AA]->fVal; + sam[4] = (real)self->tasPar[BB]->fVal; + sam[5] = (real)self->tasPar[CC]->fVal; + sam[6] = (real)self->tasPar[AX]->fVal; + sam[7] = (real)self->tasPar[AY]->fVal; + sam[8] = (real)self->tasPar[AZ]->fVal; + sam[9] = (real)self->tasPar[BX]->fVal; + sam[10] = (real)self->tasPar[BY]->fVal; + sam[11] = (real)self->tasPar[BZ]->fVal; + setrlp_(sam,&ier); + switch(ier) + { + case 1: + SCWrite(pCon,"ERROR: error on lattice parameters",eError); + return 0; + break; + case 2: + SCWrite(pCon,"ERROR: error on lattice angles",eError); + return 0; + break; + case 3: + SCWrite(pCon,"ERROR: error on vectors A1, A2",eError); + return 0; + break; + default: + break; + } + + /* + get the motor angles A1-A6 + */ + for(i = 0; i < 6; i++) + { + pMot = FindMotor(pServ->pSics,tasMotorOrder[i]); + if(!pMot) + { + sprintf(pBueffel,"ERROR: internal: motor %s NOT found", + tasMotorOrder[i]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + status = MotorGetSoftPosition(pMot,pCon,&fMot); + if(status != 1) + { + sprintf(pBueffel, "ERROR: failed to read motor %s", + tasMotorOrder[i]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + amot[i] = fMot; + } + + /* + initialize magnet things to harmless. TODO: update to read properly + when installed. + */ + for(i = 0; i < 4; i++) + { + helmCurrent[i] = .0; + helmCurrent[4+i] = .0; + convH[i] = .0; + } + + /* + collect all the other machine parameters needed for a call to + t_update + */ + if(self->tasPar[LPA]->iVal > 0) + lpa = (logical)1; + da = (real)self->tasPar[DA]->fVal; + dm = (real)self->tasPar[DM]->fVal; + isa = (integer)self->tasPar[SA]->iVal; + helm = (real)self->tasPar[HELM]->fVal; + f1h = (real)self->tasPar[IF1H]->fVal; + f1v = (real)self->tasPar[IF1V]->fVal; + f2h = (real)self->tasPar[IF2H]->fVal; + f2v = (real)self->tasPar[IF2V]->fVal; + f = (real)2.072; /* energy unit meV */ + + ifx = (integer)self->tasPar[FX]->iVal; + + /* + now call t_update to do the calculation + */ + t_update__(amot, helmCurrent, convH, &lpa, &dm, &da, &isa, &helm, + &f1h, &f1v, &f2h, &f2v, &f, &ei, &aki, &ef, &akf, + qhkl, &en, &hx, &hy, &hz, &if1, &if2, &qm, &ier); + /* + !!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + t_update's function ex_up must be dited manually after conversion + to c by f2c. The reason is a different definition of the abs function. + The line: + arg = (d__1 = *dx * sin(*ax2 / 114.59155902616465, abs(d__1)); + + has to be changed to: + arg = *dx * sin(*ax2 / 114.59155902616465); + if(arg < .0) + arg = -arg; + + !!!!!!!!!!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!!!!!!!!!!!!!*/ + + + /* + error messages taken from erreso + */ + switch(ier) + { + case 1: + SCWrite(pCon,"ERROR: Bad lattice parameters",eError); + return 0; + break; + case 2: + SCWrite(pCon,"ERROR: Bad cell angles",eError); + return 0; + break; + case 3: + SCWrite(pCon,"ERROR: Bad scattering plane ",eError); + return 0; + break; + case 4: + SCWrite(pCon,"ERROR: Bad lattice or lattice plane",eError); + return 0; + break; + case 5: + SCWrite(pCon,"ERROR: Q not in scattering plane",eError); + return 0; + break; + case 6: + SCWrite(pCon,"ERROR: Q modulus to small",eError); + return 0; + break; + case 7: + case 12: + SCWrite(pCon,"ERROR: KI, KF, Q triangle cannot close ",eError); + return 0; + break; + case 8: + SCWrite(pCon,"ERROR: in KI, KF, check d-spacings",eError); + return 0; + break; + case 9: + SCWrite(pCon,"ERROR: KI or KF cannot be obtained",eError); + return 0; + break; + case 10: + SCWrite(pCon,"ERROR: KI or KF to small",eError); + return 0; + break; + case 11: + SCWrite(pCon,"ERROR: KI or KF cannot be obtained",eError); + return 0; + break; + default: + break; + } + + /* + update all the energy variables + */ + self->tasPar[EI]->fVal = ei; + self->tasPar[KI]->fVal = aki; + self->tasPar[EF]->fVal = ef; + self->tasPar[KF]->fVal = akf; + self->tasPar[QH]->fVal = qhkl[0]; + self->tasPar[QK]->fVal = qhkl[1]; + self->tasPar[QL]->fVal = qhkl[2]; + self->tasPar[EN]->fVal = en; + self->tasPar[HX]->fVal = hx; + self->tasPar[HY]->fVal = hy; + self->tasPar[HZ]->fVal = hz; + self->tasPar[QM]->fVal = qm; + + /* + now check the analyzer or monochromator angles + */ + if(ifx == 1) + { + diff = amot[1]/2 - amot[0]; + if(diff < .0) + diff = -diff; + if(diff > .1) + { + sprintf(pBueffel,"WARNING: A2 = %f is not half of A1 = %f", + amot[1], amot[0]); + SCWrite(pCon,pBueffel,eWarning); + } + } + else if (ifx == 2) + { + diff = amot[5]/2 - amot[4]; + if(diff < .0) + diff = -diff; + if(diff > .1) + { + sprintf(pBueffel,"WARNING: A6 = %f is not half of A5 = %f", + amot[5], amot[4]); + SCWrite(pCon,pBueffel,eWarning); + } + } + return 1; +} diff --git a/test.tcl b/test.tcl index a8e2a9e1..6be643f5 100644 --- a/test.tcl +++ b/test.tcl @@ -115,6 +115,7 @@ sampledist lock Motor A1 SIM 15.0 120. .1 2. # Monochromator Theta Motor A2 SIM -73. 137. .1 1. # Monochromator 2Theta Motor A3 SIM -360. 360. .1 3. # Sample Omega +#Motor A3 el734 localhost 4000 2 3 Motor A4 SIM -130. 130. .1 1. # Sample 2Theta Motor A5 SIM -30. 30. .1 3. # ? horiz. Translation Motor A6 SIM -30. 30. .1 3. # ? vert Translation diff --git a/utils/Makefile b/utils/Makefile index a5f8911a..5a0d0f8c 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -42,7 +42,7 @@ $(BIN)/el734: el734.c @ echo "el734 needs Motif library. Not yet found on linux" rm -f $(BIN)/el734 $(CC) $(CFLAGS) -o $(BIN)/el734 \ - el734.c $(LFLAGS) -lhlib -lX11 -lXm + el734.c $(LFLAGS) -lhlib -lX11 -lXt -lXm $(BIN)/el734_test: el734_test.c rm -f $(BIN)/el734_test diff --git a/utils/SerPortServer.c b/utils/SerPortServer.c index 07aa840b..40cf050a 100755 --- a/utils/SerPortServer.c +++ b/utils/SerPortServer.c @@ -69,6 +69,8 @@ ** *serPortTrace -trace Turn on tracing. ** *serPortTraceSize -tsize 0x40000 (= 256k) Trace buffer size. ** *serPortPeriod -period 60 Period for writing trace time-stamps +** *serPortMax -max 20 Maximum number of serial ports +** to use ** ** A value given via -name will be converted to lowercase before being used. **--------------------------------------------------------------------------- @@ -173,8 +175,8 @@ #endif #define RS__MAX_CLIENTS 8 /* Up to 8 clients will be supported */ -#define RS__MAX_ASYNCH 20 /* Asynch "ports" 0 - 19 will be allowed */ -#define MAX_OPEN_CHANS RS__MAX_ASYNCH +static int RS__MAX_ASYNCH = 20; /* Asynch "ports" 0 - 19 will be allowed */ +#define MAX_OPEN_CHANS 20 #define MAX_PKT_SIZE 10000 /* The SerPortServer packet protocol has a ** 4 char ASCII header giving the packet length. @@ -902,6 +904,7 @@ bytes_to_come -= status; p_nxt_byte += status; } + if (bytes_to_come != 0) { printf ("recv: Did not get all of expected data on " "socket %d.\n", Cl_info[indx].skt); @@ -1254,7 +1257,7 @@ char *buff, /* In -- Pntr to buffer to search */ int nch) { /* In -- The number of chars in buff */ - int i, j; + int i, j, noTerm = -1, nLen = -1; if (nterm <= 0) { *len = nch; /* No terminator. So return complete string */ @@ -1262,13 +1265,18 @@ return False; }else { /* Search string for a terminator */ for (i = 0; i < nch; i++) { - for (j = 0; j < nterm; j++) if (buff[i] == terms[j]) break; - if (buff[i] == terms[j]) break; + for (j = 0; j < nterm; j++) { + if (buff[i] == terms[j]) { + /* replace terminator with NIL */ + buff[i] = NIL; /* replace terminator with NIL */ + noTerm = j; + break; + } + } } *len = i; - if (buff[i] == terms[j]) { /* Was a terminator found? */ - *term = terms[j]; /* Yes. Return it */ - buff[i] = NIL; /* Replace the terminator with a NIL */ + if (noTerm >= 0 ) { /* Was a terminator found? */ + *term = terms[noTerm]; /* Yes. Return it */ *len += 1; /* And include the term in the length */ return True; }else { @@ -1585,7 +1593,7 @@ } Cl_info[cl_indx].nxt_cmnd_ptr = nxt_cmnd_ptr; Cl_info[cl_indx].nxt_rply_ptr0 = nxt_rply_ptr0; - Cl_info[cl_indx].nxt_rply_ptr1 = nxt_rply_ptr1; + Cl_info[cl_indx].nxt_rply_ptr1 = nxt_rply_ptr1; if (Ts_info[ts_indx].tmo < Next_tmo_secs) Next_tmo_secs = Ts_info[ts_indx].tmo; @@ -1745,6 +1753,7 @@ {"-tsize", ".serPortTraceSize", XrmoptionSepArg, (XPointer) NULL}, {"-period", ".serPortPeriod", XrmoptionSepArg, (XPointer) NULL}, {"-debug", ".serPortDebug", XrmoptionNoArg, (XPointer) "1"}, + {"-max", ".serPortMax", XrmoptionSepArg, (XPointer) NULL}, }; static char our_name[80] = "Unknown"; /* This holds the program name */ @@ -2333,6 +2342,19 @@ "ProgramName.Values", &type, &value); Debug = (status) ? True : False; + /* - - - - - - - - - - - - - - - - - - - - - - - - -max */ + status = XrmGetResource (my_db, + StrJoin (buff, sizeof (buff), + appName, ".serPortMax"), + "ProgramName.Values", + &type, &value); + if (!status || + (sscanf (value.addr, "%d", &RS__MAX_ASYNCH) != 1)) { + RS__MAX_ASYNCH = 20; + printf (" Max Serial Lines defaulting to %d\n", RS__MAX_ASYNCH); + }else { + printf (" Max Serial Lines Taken = %d\n", RS__MAX_ASYNCH); + } /*-----------------------------------------------------------------------*/ N_clients = N_open_chans = 0; @@ -2441,6 +2463,10 @@ if (Ts_info[i].status != TS_SS_IDLE) { if (subtractTimes (time_now, Ts_info[i].time_stamp) >= Ts_info[i].tmo) { + subtractTimes(time_now, Ts_info[i].time_stamp); + printf("TMO: Difference: %f, allowed %f\n", + subtractTimes(time_now, Ts_info[i].time_stamp), + Ts_info[i],tmo); handleTmo (i); /* This channel has timed-out! */ } } diff --git a/varlog.c b/varlog.c index e5d3b397..be83b935 100644 --- a/varlog.c +++ b/varlog.c @@ -184,21 +184,24 @@ int VarlogGetMean(pVarLog self, float *fMean, float *fStdDev) { double dMean, dStdDev; - + int success; + if(self->iCount > 0) { dMean = self->dSum/(double)self->iCount; dStdDev = sqrt(self->dDeviation/(double)self->iCount); + success = 1; } else { dMean = .0; dStdDev = .0; + success = 0; } *fMean = (float)dMean; *fStdDev = (float)dStdDev; - return 1; + return success; } /*--------------------------------------------------------------------------*/ int VarlogWrapper(pVarLog self, SConnection *pCon,