From dfc8c8e28ced3a6c3db0447d2e789acd0463a99c Mon Sep 17 00:00:00 2001 From: cvs Date: Fri, 23 Aug 2002 11:35:56 +0000 Subject: [PATCH] - Fix to AMOR s2t, wrong reading corrected - Some problems at TASP with polarisation resolved --- Makefile | 3 +- amor2t.c | 35 +-- danu.dat | 2 +- nserver.c | 3 +- nxdata.c | 9 + s_rnge.c | 32 ++ sicsstatus.tcl | 91 +++--- sig_die.c | 53 ++++ t_conv.c | 802 ++----------------------------------------------- t_conv.f | 2 +- t_update.c | 95 +++--- tas.h | 2 +- tascom.tcl | 10 +- tasinit.c | 3 + tasscan.c | 2 +- tastest.tcl | 2 +- tasu.h | 4 +- tasutil.c | 4 +- test.tcl | 4 +- 19 files changed, 237 insertions(+), 921 deletions(-) create mode 100644 s_rnge.c create mode 100644 sig_die.c diff --git a/Makefile b/Makefile index c390d520..ff7c8a84 100644 --- a/Makefile +++ b/Makefile @@ -49,7 +49,8 @@ SOBJ = network.o ifile.o conman.o SCinter.o splitter.o passwd.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 swmotor.o t_update.o \ hmcontrol.o userscan.o slsmagnet.o rs232controller.o lomax.o \ - polterwrite.o fourlib.o motreg.o motreglist.o anticollider.o + polterwrite.o fourlib.o motreg.o motreglist.o anticollider.o \ + s_rnge.o sig_die.o MOTOROBJ = motor.o el734driv.o simdriv.o el734dc.o pipiezo.o pimotor.o COUNTEROBJ = countdriv.o simcter.o counter.o diff --git a/amor2t.c b/amor2t.c index a6576388..96bf3b7f 100644 --- a/amor2t.c +++ b/amor2t.c @@ -475,32 +475,21 @@ { float fVal, fMOM, fResult; int iRet; - pIDrivable pDriv = NULL; pAmor2T self = (pAmor2T) pData; assert(self); /* get COM */ - pDriv = self->aEngine[MOTCOM]->pDescriptor->GetInterface( - self->aEngine[MOTCOM],DRIVEID); - if(pDriv) + iRet = MotorGetSoftPosition(self->aEngine[MOTCOM], pCon, &fVal); + if(!iRet) { - fVal = pDriv->GetValue(self->aEngine[MOTCOM],pCon); - if(fVal < -9000) - { - return fVal; - } + return -9999.99; } /* get MOM */ - pDriv = self->aEngine[MOTCOM]->pDescriptor->GetInterface( - self->aEngine[MOTMOM],DRIVEID); - if(pDriv) + iRet = MotorGetSoftPosition(self->aEngine[MOTMOM], pCon, &fMOM); + if(!iRet) { - fMOM = pDriv->GetValue(self->aEngine[MOTMOM],pCon); - if(fMOM < -9000) - { - return fMOM; - } + return -9999.99; } /* retrocalculate 2 theta */ @@ -512,21 +501,15 @@ { float fVal, fMOM, fResult; int iRet; - pIDrivable pDriv = NULL; pAmor2T self = (pAmor2T) pData; assert(self); /* get AOM */ - pDriv = self->aEngine[MOTAOM]->pDescriptor->GetInterface( - self->aEngine[MOTAOM],DRIVEID); - if(pDriv) + iRet = MotorGetSoftPosition(self->aEngine[MOTAOM], pCon, &fVal); + if(!iRet) { - fVal = pDriv->GetValue(self->aEngine[MOTAOM],pCon); - if(fVal < -9000) - { - return fVal; - } + return -9999.99; } return 2. * fVal; diff --git a/danu.dat b/danu.dat index 4d167238..51d3e2e7 100644 --- a/danu.dat +++ b/danu.dat @@ -1,3 +1,3 @@ - 231 + 233 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/nserver.c b/nserver.c index 67b0b10d..6d5b9d89 100644 --- a/nserver.c +++ b/nserver.c @@ -227,8 +227,7 @@ iRet = ServerSetupInterrupt(iPort,pReader,self->pTasker); if(!iRet) { - StopServer(self); - return 0; + SCWrite(pCon,"WARNING: UDP interrupt port not initialized",eWarning); } /* install a secret fully priviledged entry point for ME */ AddUser("Achterbahn","Kiel",usInternal); diff --git a/nxdata.c b/nxdata.c index e02c2d68..eb4b2a5b 100644 --- a/nxdata.c +++ b/nxdata.c @@ -691,6 +691,15 @@ return 0; } iStat = SNputdata1(Nfil,"Monitor",NX_INT32,1, &iVal); + /* + count time + */ + fVal = GetHistCountTime(pHist,pCon); + SNputdata1att(Nfil,"time",NX_FLOAT32,1,&fVal,"Units","seconds"); + + /* + more monitors + */ iVal = GetHistMonitor(pHist, 0, pCon); SNputdata1(Nfil,"beam_monitor",NX_INT32,1, &iVal); iVal = GetHistMonitor(pHist, 4, pCon); diff --git a/s_rnge.c b/s_rnge.c new file mode 100644 index 00000000..5c12b949 --- /dev/null +++ b/s_rnge.c @@ -0,0 +1,32 @@ +#include "stdio.h" +#include "f2c.h" +#ifdef __cplusplus +extern "C" { +#endif + +/* called when a subscript is out of range */ + +#ifdef KR_headers +extern VOID sig_die(); +integer s_rnge(varn, offset, procn, line) char *varn, *procn; ftnint offset, line; +#else +extern VOID sig_die(char*,int); +integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line) +#endif +{ +register int i; + +fprintf(stderr, "Subscript out of range on file line %ld, procedure ", + (long)line); +while((i = *procn) && i != '_' && i != ' ') + putc(*procn++, stderr); +fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", + (long)offset+1); +while((i = *varn) && i != ' ') + putc(*varn++, stderr); +sig_die(".", 1); +return 0; /* not reached */ +} +#ifdef __cplusplus +} +#endif diff --git a/sicsstatus.tcl b/sicsstatus.tcl index 3e28b14c..79513302 100644 --- a/sicsstatus.tcl +++ b/sicsstatus.tcl @@ -1,75 +1,48 @@ -yfactor 1.420000 -yfactor setAccess 1 -xfactor 0.715000 -xfactor setAccess 1 -ps.listfile peaksearch.dat -ps.listfile setAccess 2 -ps.scansteps 24 -ps.scansteps setAccess 2 -ps.scanpreset 1000000.000000 -ps.scanpreset setAccess 2 -ps.preset 1000.000000 -ps.preset setAccess 2 -ps.countmode monitor -ps.countmode setAccess 2 -ps.cogcontour 0.200000 -ps.cogcontour setAccess 2 -ps.cogwindow 60 -ps.cogwindow setAccess 2 -ps.window 7 -ps.window setAccess 2 -ps.steepness 3 -ps.steepness setAccess 2 -ps.threshold 30 -ps.threshold setAccess 2 -ps.sttstep 3.000000 -ps.sttstep setAccess 2 -ps.sttend 70.000000 -ps.sttend setAccess 2 -ps.sttstart 5.000000 -ps.sttstart setAccess 2 -ps.omstep 3.000000 -ps.omstep setAccess 2 -ps.omend 30.000000 -ps.omend setAccess 2 -ps.omstart 0.000000 -ps.omstart setAccess 2 -ps.chistep 12.000000 -ps.chistep setAccess 2 -ps.chiend 180.000000 -ps.chiend setAccess 2 -ps.chistart 0.000000 -ps.chistart setAccess 2 -ps.phistep 3.000000 -ps.phistep setAccess 2 -ps.phiend 180.000000 -ps.phiend setAccess 2 -ps.phistart 0.000000 -ps.phistart setAccess 2 -hm3 CountMode timer -hm3 preset 10.000000 +a5l.length 80.000000 +flightpathlength 0.000000 +flightpathlength setAccess 1 +flightpath 0.000000 +flightpath setAccess 1 +delay 2500.000000 +delay setAccess 1 +hm CountMode timer +hm preset 100.000000 +hm genbin 120.000000 35.000000 512 +hm init +datafile focus-1001848.hdf +datafile setAccess 3 hm2 CountMode timer hm2 preset 10.000000 hm1 CountMode timer hm1 preset 10.000000 +dbfile UNKNOWN +dbfile setAccess 2 +# Motor th +th sign 1.000000 +th SoftZero 0.000000 +th SoftLowerLim 4.000000 +th SoftUpperLim 113.000000 +th Fixed -1.000000 +th InterruptMode 0.000000 +th AccessCode 2.000000 #Crystallographic Settings hkl lambda 1.179000 hkl setub -0.017880 -0.074923 0.028280 -0.007008 -0.036800 -0.057747 0.160912 -0.009928 0.000627 hkl hm 0 -detdist3 0.000000 -detdist3 setAccess 1 +det3dist 300.000000 +det3dist setAccess 1 det3zeroy 128.000000 det3zeroy setAccess 1 det3zerox 128.000000 det3zerox setAccess 1 -detdist2 0.000000 -detdist2 setAccess 1 +det2dist 300.000000 +det2dist setAccess 1 det2zeroy 128.000000 det2zeroy setAccess 1 det2zerox 128.000000 det2zerox setAccess 1 -detdist1 0.000000 -detdist1 setAccess 1 +det1dist 300.000000 +det1dist setAccess 1 det1zeroy 128.000000 det1zeroy setAccess 1 det1zerox 128.000000 @@ -176,6 +149,8 @@ twotheta InterruptMode 0.000000 twotheta AccessCode 2.000000 lastscancommand cscan a4 10. .1 10 5 lastscancommand setAccess 2 +banana CountMode timer +banana preset 20.000000 sample_mur 0.000000 sample_mur setAccess 2 email UNKNOWN @@ -187,7 +162,7 @@ phone setAccess 2 adress UNKNOWN adress setAccess 2 # Counter counter -counter SetPreset 1.000000 +counter SetPreset 20.000000 counter SetMode Timer # Motor som som sign 1.000000 @@ -453,6 +428,8 @@ a1 SoftUpperLim 120.000000 a1 Fixed -1.000000 a1 InterruptMode 0.000000 a1 AccessCode 2.000000 +batchroot /data/koenneck/src/sics +batchroot setAccess 2 user Uwe Filges user setAccess 2 sample D20 30K SNP Okt 2001 GS diff --git a/sig_die.c b/sig_die.c new file mode 100644 index 00000000..cf20f5a1 --- /dev/null +++ b/sig_die.c @@ -0,0 +1,53 @@ +#include "stdio.h" +#include "signal.h" + +#ifndef SIGIOT +#ifdef SIGABRT +#define SIGIOT SIGABRT +#endif +#endif + +#ifdef KR_headers +void sig_die(s, kill) register char *s; int kill; +#else +#include "stdlib.h" +#ifdef __cplusplus +extern "C" { +#endif +#ifdef __cplusplus +extern "C" { +#endif + void f_exit(void){ + exit(0); + } + +void sig_die(register char *s, int kill) +#endif +{ + /* print error message, then clear buffers */ + fprintf(stderr, "%s\n", s); + + if(kill) + { + fflush(stderr); + f_exit(); + fflush(stderr); + /* now get a core */ +#ifdef SIGIOT + signal(SIGIOT, SIG_DFL); +#endif + abort(); + } + else { +#ifdef NO_ONEXIT + f_exit(); +#endif + exit(1); + } + } +#ifdef __cplusplus +} +#endif +#ifdef __cplusplus +} +#endif diff --git a/t_conv.c b/t_conv.c index e0de4c1a..14ce9ad0 100644 --- a/t_conv.c +++ b/t_conv.c @@ -1,4 +1,3 @@ -#line 1 "t_conv.f" /* t_conv.f -- translated by f2c (version 20000817). You must link the resulting object file with the libraries: -lf2c -lm (in that order) @@ -6,7 +5,6 @@ #include "f2c.h" -#line 1 "t_conv.f" /* Common Block Declarations */ struct { @@ -29,8 +27,12 @@ static doublereal c_b12 = 360.; /* slightly edited version for inclusion into SICS */ /* Mark Koennecke, November 2000 */ + +/* Found that ERRESO looks error messages up in a 2D array. Modified IER */ +/* values to refer to a 1D array. */ + +/* Mark Koennecke, January 2002 */ /* ------------------------------------------------------------------------- */ -/*< >*/ /* Subroutine */ int inicurve_(integer *midx, real *mrx1, real *mrx2, integer *aidx, real *arx1, real *arx2, real *mmin, real *mmax, real *amin, real *amax) @@ -39,60 +41,23 @@ static doublereal c_b12 = 360.; /* Initializes a common with the curvature parameters. */ /* In: monochrmoator curvatuure motor index and parameters */ /* 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 >*/ -/*< >*/ -/*< ICRM = MIDX >*/ -#line 21 "t_conv.f" curve_1.icrm = *midx; -/*< ICRA = AIDX >*/ -#line 22 "t_conv.f" curve_1.icra = *aidx; -/*< CM1RX = MRX1 >*/ -#line 23 "t_conv.f" curve_1.cm1rx = *mrx1; -/*< CM2RX = MRX2 >*/ -#line 24 "t_conv.f" curve_1.cm2rx = *mrx2; -/*< CA1RX = ARX1 >*/ -#line 25 "t_conv.f" curve_1.ca1rx = *arx1; -/*< CA2RX = ARX2 >*/ -#line 26 "t_conv.f" curve_1.ca2rx = *arx2; -/*< RMMIN = MMIN >*/ -#line 27 "t_conv.f" curve_1.rmmin = *mmin; -/*< RMMAX = MMAX >*/ -#line 28 "t_conv.f" curve_1.rmmax = *mmax; -/*< RAMIN = AMIN >*/ -#line 29 "t_conv.f" curve_1.ramin = *amin; -/*< RAMAX = AMAX >*/ -#line 30 "t_conv.f" curve_1.ramax = *amax; -/*< INX = 0 >*/ -#line 31 "t_conv.f" curve_1.inx = 0; -/*< AT_SINQ = .TRUE. >*/ -#line 32 "t_conv.f" curve_1.at_sinq__ = TRUE_; -/*< ICLM = 0 >*/ -#line 33 "t_conv.f" curve_1.iclm = 0; -/*< RETURN >*/ -#line 34 "t_conv.f" return 0; -/*< END >*/ } /* 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, @@ -174,44 +139,17 @@ static doublereal c_b12 = 360.; /* TARGET OF EI(EF) IS UPDATED IS KI(KF) IS DRIVEN */ /* TARGET OF VARIABLE ENERGY IS UPDATED IF EN IS DRIVEN */ /* ----------------------------------------------------------------------- */ -/*< implicit none >*/ +/* File [MAD.SRC]T_CONV.FOR */ -/*< 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 >*/ -/*< >*/ /* include 'curve.inc' */ /* ----------------------------------------------------------------------- */ /* Define the dummy arguments */ -/*< 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 >*/ /* ----------------------------------------------------------------------- */ /* LOCAL VARIABLES */ -/*< integer*4 i, id, imod, iq >*/ -/*< logical*4 lmoan(2), lqhkle >*/ -/*< 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 >*/ /* ----------------------------------------------------------------------- */ /* SET UP */ /* IMOD INDEX FOR ERROR TREATMENAT BY ERRESO */ @@ -221,164 +159,66 @@ static doublereal c_b12 = 360.; /* AND VARIABLE ENERGY IN EDEF(2) */ /* IF ISA IS NUL SET IFX TO 1 AND PUT EF,KF, EQUAL TO EI,KI */ -/*< IMOD = 3 >*/ -#line 135 "t_conv.f" /* Parameter adjustments */ -#line 135 "t_conv.f" --c_ih__; -#line 135 "t_conv.f" --p_ih__; -#line 135 "t_conv.f" --ldra; -#line 135 "t_conv.f" --t_a__; -#line 135 "t_conv.f" --ldk; -#line 135 "t_conv.f" --qhkl; -#line 135 "t_conv.f" -#line 135 "t_conv.f" /* Function Body */ -#line 135 "t_conv.f" imod = 3; -/*< DDM = DM >*/ -#line 136 "t_conv.f" ddm = *dm; -/*< DDA = DA >*/ -#line 137 "t_conv.f" dda = *da; -/*< DO I = 1,2 >*/ -#line 138 "t_conv.f" for (i__ = 1; i__ <= 2; ++i__) { -/*< LMOAN(I) = .FALSE. >*/ -#line 139 "t_conv.f" lmoan[i__ - 1] = FALSE_; -/*< ENDDO >*/ -#line 140 "t_conv.f" } -/*< LQHKLE = .FALSE. >*/ -#line 141 "t_conv.f" lqhkle = FALSE_; -/*< DO IQ = 5,8 >*/ -#line 142 "t_conv.f" for (iq = 5; iq <= 8; ++iq) { -/*< LQHKLE = (LQHKLE .OR. LDK(IQ)) >*/ -#line 143 "t_conv.f" lqhkle = lqhkle || ldk[iq]; -/*< ENDDO >*/ -#line 144 "t_conv.f" } -/*< DAKI = AKI >*/ -#line 145 "t_conv.f" daki = *aki; -/*< DAKF = AKF >*/ -#line 146 "t_conv.f" dakf = *akf; -/*< IF (ISA .EQ. 0) IFX = 1 >*/ -#line 147 "t_conv.f" if (*isa == 0) { -#line 147 "t_conv.f" *ifx = 1; -#line 147 "t_conv.f" } -/*< EDEF(IFX) = EI >*/ -#line 148 "t_conv.f" edef[*ifx - 1] = *ei; -/*< AKDEF(IFX) = AKI >*/ -#line 149 "t_conv.f" akdef[*ifx - 1] = *aki; -/*< EDEF(3-IFX) = EF >*/ -#line 150 "t_conv.f" edef[3 - *ifx - 1] = *ef; -/*< AKDEF(3-IFX) = AKF >*/ -#line 151 "t_conv.f" akdef[3 - *ifx - 1] = *akf; -/*< IF( ISA .EQ. 0) THEN >*/ -#line 152 "t_conv.f" if (*isa == 0) { -/*< EDEF(2) = EDEF(1) >*/ -#line 153 "t_conv.f" edef[1] = edef[0]; -/*< AKDEF(2) = AKDEF(1) >*/ -#line 154 "t_conv.f" akdef[1] = akdef[0]; -/*< LDK(3) = .TRUE. >*/ -#line 155 "t_conv.f" ldk[3] = TRUE_; -/*< LDK(4) = .TRUE. >*/ -#line 156 "t_conv.f" ldk[4] = TRUE_; -/*< T_A(5) = 0. >*/ -#line 157 "t_conv.f" t_a__[5] = 0.f; -/*< T_A(6) = 0. >*/ -#line 158 "t_conv.f" t_a__[6] = 0.f; -/*< LDRA(5) = .TRUE. >*/ -#line 159 "t_conv.f" ldra[5] = TRUE_; -/*< LDRA(6) = .TRUE. >*/ -#line 160 "t_conv.f" ldra[6] = TRUE_; -/*< ENDIF >*/ -#line 161 "t_conv.f" } /* ----------------------------------------------------------------------- */ /* FIRST TAKE IN ACCOUNT THE FIXED ENERGY PB */ -/*< IF (LDK(2*IFX-1) .OR. LDK(2*IFX)) THEN >*/ -#line 165 "t_conv.f" if (ldk[(*ifx << 1) - 1] || ldk[*ifx * 2]) { -/*< LMOAN(IFX) = .TRUE. >*/ -#line 166 "t_conv.f" lmoan[*ifx - 1] = TRUE_; -/*< IF (LDK(2*IFX-1)) THEN >*/ -#line 167 "t_conv.f" if (ldk[(*ifx << 1) - 1]) { -/*< IER = 1 + 8 >*/ -#line 168 "t_conv.f" *ier = 9; -/*< IF(EDEF(1) .LT. EPS1) GOTO 999 >*/ -#line 169 "t_conv.f" if (edef[0] < .1f) { -#line 169 "t_conv.f" goto L999; -#line 169 "t_conv.f" } -/*< IER = 0 >*/ -#line 170 "t_conv.f" *ier = 0; -/*< AKDEF(1) = SQRT(EDEF(1)/F) >*/ -#line 171 "t_conv.f" akdef[0] = sqrt(edef[0] / *f); -/*< ELSE >*/ -#line 172 "t_conv.f" } else { -/*< IER = 1 + 8 >*/ -#line 173 "t_conv.f" *ier = 9; -/*< IF(AKDEF(1) .LT. EPS1) GOTO 999 >*/ -#line 174 "t_conv.f" if (akdef[0] < .1f) { -#line 174 "t_conv.f" goto L999; -#line 174 "t_conv.f" } -/*< IER = 0 >*/ -#line 175 "t_conv.f" *ier = 0; -/*< EDEF(1) = F*AKDEF(1)**2 >*/ /* Computing 2nd power */ -#line 176 "t_conv.f" d__1 = akdef[0]; -#line 176 "t_conv.f" edef[0] = *f * (d__1 * d__1); -/*< ENDIF >*/ -#line 177 "t_conv.f" } -/*< ENDIF >*/ -#line 178 "t_conv.f" } /* ----------------------------------------------------------------------- */ /* NOW TAKE IN ACCOUNT THE VARIABLE ENERGY PB */ @@ -394,331 +234,130 @@ static doublereal c_b12 = 360.; /* 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-2*IFX) .OR. LDK(6-2*IFX)) THEN >*/ -#line 193 "t_conv.f" if (ldk[5 - (*ifx << 1)] || ldk[6 - (*ifx << 1)]) { -/*< LMOAN(3-IFX) = .TRUE. >*/ -#line 194 "t_conv.f" lmoan[3 - *ifx - 1] = TRUE_; -/*< IF (LDK(5-2*IFX)) THEN >*/ -#line 195 "t_conv.f" if (ldk[5 - (*ifx << 1)]) { -/*< IER = 1 + 8 >*/ -#line 196 "t_conv.f" *ier = 9; -/*< IF(EDEF(2) .LT. EPS4) GOTO 999 >*/ -#line 197 "t_conv.f" if (edef[1] < 1e-4f) { -#line 197 "t_conv.f" goto L999; -#line 197 "t_conv.f" } -/*< IER = 0 >*/ -#line 198 "t_conv.f" *ier = 0; -/*< AKDEF(2) = SQRT(EDEF(2)/F) >*/ -#line 199 "t_conv.f" akdef[1] = sqrt(edef[1] / *f); -/*< ELSE >*/ -#line 200 "t_conv.f" } else { -/*< IER = 1 + 8 >*/ -#line 201 "t_conv.f" *ier = 9; -/*< IF(AKDEF(2) .LT. EPS4) GOTO 999 >*/ -#line 202 "t_conv.f" if (akdef[1] < 1e-4f) { -#line 202 "t_conv.f" goto L999; -#line 202 "t_conv.f" } -/*< IER = 0 >*/ -#line 203 "t_conv.f" *ier = 0; -/*< EDEF(2) = F*AKDEF(2)**2 >*/ /* Computing 2nd power */ -#line 204 "t_conv.f" d__1 = akdef[1]; -#line 204 "t_conv.f" edef[1] = *f * (d__1 * d__1); -/*< ENDIF >*/ -#line 205 "t_conv.f" } -/*< EN = (3-2*IFX)*(EDEF(1)-EDEF(2)) >*/ -#line 206 "t_conv.f" *en = (3 - (*ifx << 1)) * (edef[0] - edef[1]); -/*< ELSEIF (LQHKLE) THEN >*/ -#line 207 "t_conv.f" } else if (lqhkle) { -/*< LMOAN(3-IFX) = .TRUE. >*/ -#line 208 "t_conv.f" lmoan[3 - *ifx - 1] = TRUE_; -/*< EDEF(2) = EDEF(1)+(2*IFX-3)*EN >*/ -#line 209 "t_conv.f" edef[1] = edef[0] + ((*ifx << 1) - 3) * *en; -/*< IER = 1 + 8 >*/ -#line 210 "t_conv.f" *ier = 9; -/*< IF(EDEF(2) .LT. EPS4) GOTO 999 >*/ -#line 211 "t_conv.f" if (edef[1] < 1e-4f) { -#line 211 "t_conv.f" goto L999; -#line 211 "t_conv.f" } -/*< IER = 0 >*/ -#line 212 "t_conv.f" *ier = 0; -/*< AKDEF(2) = SQRT(EDEF(2)/F) >*/ -#line 213 "t_conv.f" akdef[1] = sqrt(edef[1] / *f); -/*< ENDIF >*/ -#line 214 "t_conv.f" } /* ----------------------------------------------------------------------- */ /* CALCULATE MONOCHROMATOR AND ANALYSER ANGLES */ -/*< IF(LMOAN(1)) THEN >*/ -#line 218 "t_conv.f" if (lmoan[0]) { -/*< DEI = EDEF(IFX) >*/ -#line 219 "t_conv.f" dei = edef[*ifx - 1]; -/*< DAKI = AKDEF(IFX) >*/ -#line 220 "t_conv.f" daki = akdef[*ifx - 1]; -/*< CALL EX_CASE(DDM,ISM,DAKI,A1,A2,RM,ALM,0,IER) >*/ -#line 221 "t_conv.f" ex_case__(&ddm, ism, &daki, &a1, &a2, &rm, &alm, &c__0, ier); -/*< IF (IER .EQ. 0) THEN >*/ -#line 222 "t_conv.f" if (*ier == 0) { -/*< AKI = DAKI >*/ -#line 223 "t_conv.f" *aki = daki; -/*< EI = DEI >*/ -#line 224 "t_conv.f" *ei = dei; -/*< T_A(1) = A1 >*/ -#line 225 "t_conv.f" t_a__[1] = a1; -/*< T_A(2) = A2 >*/ -#line 226 "t_conv.f" t_a__[2] = a2; -/*< LDRA(1) = .TRUE. >*/ -#line 227 "t_conv.f" ldra[1] = TRUE_; -/*< LDRA(2) = .TRUE. >*/ -#line 228 "t_conv.f" ldra[2] = TRUE_; -/*< if (icrm .ne. 0) then >*/ -#line 229 "t_conv.f" if (curve_1.icrm != 0) { -/*< T_RM = RM >*/ -#line 230 "t_conv.f" *t_rm__ = rm; -/*< LDR_RM = .TRUE. >*/ -#line 231 "t_conv.f" *ldr_rm__ = TRUE_; -/*< endif >*/ -#line 232 "t_conv.f" } -/*< if ((iclm .ne. 0) .and. (inx .ne. 0)) then >*/ -#line 233 "t_conv.f" if (curve_1.iclm != 0 && curve_1.inx != 0) { -/*< T_ALM = ALM >*/ -#line 234 "t_conv.f" *t_alm__ = alm; -/*< LDR_ALM = .TRUE. >*/ -#line 235 "t_conv.f" *ldr_alm__ = TRUE_; -/*< endif >*/ -#line 236 "t_conv.f" } -/*< ELSE >*/ -#line 237 "t_conv.f" } else { -/*< IER = IER + 8 >*/ -#line 238 "t_conv.f" *ier += 8; -/*< GOTO 999 >*/ -#line 239 "t_conv.f" goto L999; -/*< ENDIF >*/ -#line 240 "t_conv.f" } -/*< ENDIF >*/ -#line 241 "t_conv.f" } -/*< IF(LMOAN(2)) THEN >*/ -#line 242 "t_conv.f" if (lmoan[1]) { -/*< DEF = EDEF(3-IFX) >*/ -#line 243 "t_conv.f" def = edef[3 - *ifx - 1]; -/*< DAKF = AKDEF(3-IFX) >*/ -#line 244 "t_conv.f" dakf = akdef[3 - *ifx - 1]; -/*< CALL EX_CASE(DDA,ISA,DAKF,A5,A6,RA,ALA,1,IER) >*/ -#line 245 "t_conv.f" ex_case__(&dda, isa, &dakf, &a5, &a6, &ra, &ala, &c__1, ier); -/*< IF (IER .EQ. 0) THEN >*/ -#line 246 "t_conv.f" if (*ier == 0) { -/*< AKF = DAKF >*/ -#line 247 "t_conv.f" *akf = dakf; -/*< EF = DEF >*/ -#line 248 "t_conv.f" *ef = def; -/*< T_A(5) = A5 >*/ -#line 249 "t_conv.f" t_a__[5] = a5; -/*< T_A(6) = A6 >*/ -#line 250 "t_conv.f" t_a__[6] = a6; -/*< LDRA(5) = .TRUE. >*/ -#line 251 "t_conv.f" ldra[5] = TRUE_; -/*< LDRA(6) = .TRUE. >*/ -#line 252 "t_conv.f" ldra[6] = TRUE_; -/*< if (icra .ne. 0) then >*/ -#line 253 "t_conv.f" if (curve_1.icra != 0) { -/*< T_RA = RA >*/ -#line 254 "t_conv.f" *t_ra__ = ra; -/*< LDR_RA = .TRUE. >*/ -#line 255 "t_conv.f" *ldr_ra__ = TRUE_; -/*< endif >*/ -#line 256 "t_conv.f" } -/*< ELSE >*/ -#line 257 "t_conv.f" } else { -/*< IER = IER + 8 >*/ -#line 258 "t_conv.f" *ier += 8; -/*< GOTO 999 >*/ -#line 259 "t_conv.f" goto L999; -/*< ENDIF >*/ -#line 260 "t_conv.f" } -/*< ENDIF >*/ -#line 261 "t_conv.f" } /* ----------------------------------------------------------------------- */ /* USE (QH,QK,QL) TO CALCULATE A3 AND A4 */ /* CALCULATE Q1 AND Q2 IN SCATTERING PLANE */ -/*< IMOD = 2 >*/ -#line 266 "t_conv.f" imod = 2; -/*< IF (LQHKLE) THEN >*/ -#line 267 "t_conv.f" if (lqhkle) { -/*< DO ID = 1,3 >*/ -#line 268 "t_conv.f" for (id = 1; id <= 3; ++id) { -/*< DQHKL(ID) = QHKL(ID) >*/ -#line 269 "t_conv.f" dqhkl[id - 1] = qhkl[id]; -/*< ENDDO >*/ -#line 270 "t_conv.f" } -/*< CALL RL2SPV(DQHKL,DQT,DQM,DQS,IER) >*/ -#line 271 "t_conv.f" rl2spv_(dqhkl, dqt, &dqm, &dqs, ier); -/*< IF (IER .NE. 0) GOTO 999 >*/ -#line 272 "t_conv.f" if (*ier != 0) { -#line 272 "t_conv.f" goto L999; -#line 272 "t_conv.f" } -/*< CALL SAM_CASE(DQT,DQM,DQS,DAKI,DAKF,A3,A4,ISS,IER) >*/ -#line 273 "t_conv.f" sam_case__(dqt, &dqm, &dqs, &daki, &dakf, &a3, &a4, iss, ier); -/*< IF (IER .EQ. 0) THEN >*/ -#line 274 "t_conv.f" if (*ier == 0) { -/*< T_A(3) = A3 >*/ -#line 275 "t_conv.f" t_a__[3] = a3; -/*< T_A(4) = A4 >*/ -#line 276 "t_conv.f" t_a__[4] = a4; -/*< LDRA(3) = .TRUE. >*/ -#line 277 "t_conv.f" ldra[3] = TRUE_; -/*< LDRA(4) = .TRUE. >*/ -#line 278 "t_conv.f" ldra[4] = TRUE_; -/*< QM = DQM >*/ -#line 279 "t_conv.f" *qm = dqm; -/*< ELSE >*/ -#line 280 "t_conv.f" } else { -/*< IER = IER + 4 >*/ -#line 281 "t_conv.f" *ier += 4; -/*< GOTO 999 >*/ -#line 282 "t_conv.f" goto L999; -/*< ENDIF >*/ -#line 283 "t_conv.f" } -/*< ENDIF >*/ -#line 284 "t_conv.f" } /* ----------------------------------------------------------------------- */ /* DEAL WITH FLIPPERS AND HELMOTZ COILS IF LPA */ -/*< IF (LPA .AND. (LMOAN(1) .OR. LMOAN(2))) THEN >*/ -#line 288 "t_conv.f" - if (*lpa && (lmoan[0] || lmoan[1])) { -/*< IF >*/ -#line 289 "t_conv.f" + if (*lpa) { if (*ldf) { -#line 289 "t_conv.f" flip_case__(if1, if2, &p_ih__[1], f1v, f1h, f2v, f2h, aki, akf, ier); -#line 289 "t_conv.f" } -/*< IF >*/ -#line 291 "t_conv.f" if (*ldh) { -#line 291 "t_conv.f" helm_case__(hx, hy, hz, &p_ih__[1], &c_ih__[1], aki, akf, &a4, qm, helm, ier); -#line 291 "t_conv.f" } -/*< endif >*/ -#line 293 "t_conv.f" } /* ----------------------------------------------------------------------- */ -/*< 999 CONTINUE >*/ -#line 295 "t_conv.f" L999: -/*< IF (IER .NE. 0) CALL ERRESO(IMOD,IER) >*/ -#line 296 "t_conv.f" if (*ier != 0) { -#line 296 "t_conv.f" erreso_(&imod, ier); -#line 296 "t_conv.f" } -/*< RETURN >*/ -#line 297 "t_conv.f" return 0; -/*< END >*/ } /* t_conv__ */ -/*< SUBRO >*/ /* Subroutine */ int ex_case__(doublereal *dx, integer *isx, doublereal *akx, doublereal *ax1, doublereal *ax2, doublereal *rx, doublereal *alx, integer *mon_or_anal__, integer *ier) @@ -761,128 +400,61 @@ L999: /* 2 'KI OR KF TOO SMALL', */ /* 3 'KI OR KF TOO BIG', */ /* ----------------------------------------------------------------------- */ -/*< implicit none >*/ +/* Part of T_CONV.FOR */ -/*< double precision PI, RD, EPS1 >*/ -/*< PARAMETER (PI = 3.14159265358979323846264338327950D0) >*/ -/*< PARAMETER (RD = 57.29577951308232087679815481410517D0) >*/ -/*< PARAMETER (EPS1 = 1.D-1) >*/ /* ----------------------------------------------------------------------- */ /* Define the dummy arguments */ -/*< double precision dx >*/ -/*< integer*4 isx >*/ -/*< double precision akx, ax1, ax2, rx, alx >*/ -/*< integer*4 mon_or_anal, ier >*/ /* ----------------------------------------------------------------------- */ /* include 'curve.inc' */ /* include 'motdef.inc' */ /* include 'iolsddef.inc' */ -/*< INTEGER ICRM, ICRA, ICLM, INX >*/ -/*< LOGICAL AT_SINQ >*/ -/*< REAL*4 CM1RX, CM2RX, CA1RX, CA2RX, RMMIN, RMMAX >*/ -/*< REAL*4 RAMIN, RAMAX >*/ -/*< >*/ /* real*4 tbut(5,NBMOT) */ /* equivalence (rbut, tbut) */ /* ----------------------------------------------------------------------- */ /* LOCAL VAR */ -/*< double precision arg, dc1rx, dc2rx, drmin, drmax, dcl1r, my_rx >*/ -/*< integer*4 ios, indx >*/ /* ----------------------------------------------------------------------- */ /* INIT AND TEST */ -/*< ier = 0 >*/ -#line 363 "t_conv.f" *ier = 0; -/*< ax1 = 0.0 >*/ -#line 364 "t_conv.f" *ax1 = 0.f; -/*< ax2 = 0.0 >*/ -#line 365 "t_conv.f" *ax2 = 0.f; -/*< rx = 0.0 >*/ -#line 366 "t_conv.f" *rx = 0.f; -/*< alx = 0.0 >*/ -#line 367 "t_conv.f" *alx = 0.f; /* ---------------------------------------------------------------------- */ /* Check validity of inputs. */ -/*< if (dx .lt. EPS1) ier = 1 >*/ -#line 370 "t_conv.f" if (*dx < .1) { -#line 370 "t_conv.f" *ier = 1; -#line 370 "t_conv.f" } -/*< if (akx .lt. EPS1) ier = 2 >*/ -#line 371 "t_conv.f" if (*akx < .1) { -#line 371 "t_conv.f" *ier = 2; -#line 371 "t_conv.f" } -/*< arg = PI/(dx * akx) >*/ -#line 372 "t_conv.f" arg = 3.1415926535897932384626433832795 / (*dx * *akx); -/*< if (abs(arg) .gt. 1.0) ier = 3 >*/ -#line 373 "t_conv.f" if (abs(arg) > 1.f) { -#line 373 "t_conv.f" *ier = 3; -#line 373 "t_conv.f" } -/*< if (ier .ne. 0) goto 999 >*/ -#line 374 "t_conv.f" if (*ier != 0) { -#line 374 "t_conv.f" goto L999; -#line 374 "t_conv.f" } /* ---------------------------------------------------------------------- */ -/*< if (mon_or_anal .eq. 0) then ! Use monochr or anal params? >*/ -#line 376 "t_conv.f" if (*mon_or_anal__ == 0) { -/*< indx = icrm ! Monochr, so set up params. >*/ -#line 377 "t_conv.f" +/* Use monochr or anal params? */ indx = curve_1.icrm; -/*< dc1rx = cm1rx >*/ -#line 378 "t_conv.f" +/* Monochr, so set up params. */ dc1rx = curve_1.cm1rx; -/*< dc2rx = cm2rx >*/ -#line 379 "t_conv.f" dc2rx = curve_1.cm2rx; -/*< dcl1r = ICLM >*/ -#line 380 "t_conv.f" dcl1r = (doublereal) curve_1.iclm; -/*< drmin = rmmin >*/ -#line 381 "t_conv.f" drmin = curve_1.rmmin; -/*< drmax = rmmax >*/ -#line 382 "t_conv.f" drmax = curve_1.rmmax; -/*< else >*/ -#line 383 "t_conv.f" } else { -/*< indx = icra ! Analyser, so set up params. >*/ -#line 384 "t_conv.f" indx = curve_1.icra; -/*< dc1rx = ca1rx ! There is no ALX in this case. >*/ -#line 385 "t_conv.f" +/* Analyser, so set up params. */ dc1rx = curve_1.ca1rx; -/*< dc2rx = ca2rx >*/ -#line 386 "t_conv.f" +/* There is no ALX in this case. */ dc2rx = curve_1.ca2rx; -/*< drmin = ramin >*/ -#line 387 "t_conv.f" drmin = curve_1.ramin; -/*< drmax = ramax >*/ -#line 388 "t_conv.f" drmax = curve_1.ramax; -/*< endif >*/ -#line 389 "t_conv.f" } /* if (indx .ne. 0) then ! Include zero-offset in min/max */ @@ -894,33 +466,17 @@ L999: /* ----------------------------------------------------------------------- */ /* Calculation of the two angles */ -/*< if (isx .eq. 0) then ! "Straight-through" mode? >*/ -#line 400 "t_conv.f" if (*isx == 0) { -/*< ax1 = 0.0 ! Yes. >*/ -#line 401 "t_conv.f" +/* "Straight-through" mode? */ *ax1 = 0.f; -/*< ax2 = 0.0 >*/ -#line 402 "t_conv.f" +/* Yes. */ *ax2 = 0.f; -/*< rx = drmin >*/ -#line 403 "t_conv.f" *rx = drmin; -/*< alx = 0.0 >*/ -#line 404 "t_conv.f" *alx = 0.f; -/*< return >*/ -#line 405 "t_conv.f" return 0; -/*< endif >*/ -#line 406 "t_conv.f" } -/*< ax1 = asin (arg) * isx * rd >*/ -#line 408 "t_conv.f" *ax1 = asin(arg) * *isx * 57.29577951308232087679815481410517; -/*< ax2 = 2.0d0 * ax1 >*/ -#line 409 "t_conv.f" *ax2 = *ax1 * 2.; /* ----------------------------------------------------------------------- */ /* Calculation of mono curvature RM or analyser curvature RA */ @@ -939,64 +495,40 @@ L999: /* rmmin = 0. */ /* rmmax = 20. */ /* ----------------------------------------------------------------------- */ -/*< if (mon_or_anal .eq. 0) then ! Monochr or analyser? >*/ -#line 427 "t_conv.f" if (*mon_or_anal__ == 0) { -/*< if (inx .ne. 0) then ! Monochr. Is there a translation? >*/ -#line 428 "t_conv.f" +/* Monochr or analyser? */ if (curve_1.inx != 0) { -/*< if (iclm .ne. 0) then ! Yes, IN8 case. If there's a .. >*/ -#line 429 "t_conv.f" +/* Monochr. Is there a translation? */ if (curve_1.iclm != 0) { -/*< alx = (dcl1r/sin(ax2/rd)) * cos(ax2/rd) ! .. motor, do the .. >*/ -#line 430 "t_conv.f" +/* Yes, IN8 case. If there's a .. */ *alx = dcl1r / sin(*ax2 / 57.29577951308232087679815481410517) * cos(*ax2 / 57.29577951308232087679815481410517); -/*< rx = dc2rx * sqrt(sin(abs(ax2)/rd)) - dc1rx ! .. calculation. >*/ -#line 431 "t_conv.f" +/* .. motor, do the .. */ *rx = dc2rx * sqrt(sin(abs(*ax2) / 57.29577951308232087679815481410517)) - dc1rx; -/*< rx = dmin1 (dmax1 (rx, drmin), drmax) >*/ +/* .. calculation. */ /* Computing MIN */ -#line 432 "t_conv.f" d__1 = max(*rx,drmin); -#line 432 "t_conv.f" *rx = min(d__1,drmax); -/*< return >*/ -#line 433 "t_conv.f" return 0; -/*< endif >*/ -#line 434 "t_conv.f" } -/*< else ! Not IN8 case so, .. >*/ -#line 435 "t_conv.f" } else { -/*< my_rx = dc1rx + dc2rx/sin(abs(ax1)/rd) ! .. simply calculate. >*/ -#line 436 "t_conv.f" +/* Not IN8 case so, .. */ my_rx__ = dc1rx + dc2rx / sin(abs(*ax1) / 57.29577951308232087679815481410517); -/*< endif >*/ -#line 437 "t_conv.f" +/* .. simply calculate. */ } -/*< else ! Analyser. >*/ -#line 438 "t_conv.f" } else { -/*< my_rx = dc1rx + dc2rx * sin(abs(ax1)/rd) ! Simply calculate. >*/ -#line 439 "t_conv.f" +/* Analyser. */ my_rx__ = dc1rx + dc2rx * sin(abs(*ax1) / 57.29577951308232087679815481410517); -/*< endif >*/ -#line 440 "t_conv.f" +/* Simply calculate. */ } -/*< if (indx .ne. 0) then ! If there's a motor, return the curvature. >*/ -#line 442 "t_conv.f" if (indx != 0) { -/*< rx = dmin1 (dmax1 (my_rx, drmin), drmax) >*/ +/* If there's a motor, return the curvature. */ /* Computing MIN */ -#line 443 "t_conv.f" d__1 = max(my_rx__,drmin); -#line 443 "t_conv.f" *rx = min(d__1,drmax); /* if (rx .ne. my_rx) then */ /* write (iolun, 101, iostat=ios) motnam(indx), my_rx */ @@ -1004,21 +536,13 @@ L999: /* + 'or high limits!'/ */ /* + ' Calculated curvature was', f9.2) */ /* endif */ -/*< endif >*/ -#line 450 "t_conv.f" } /* ----------------------------------------------------------------------- */ -/*< 999 continue >*/ -#line 452 "t_conv.f" L999: -/*< return >*/ -#line 453 "t_conv.f" return 0; -/*< end >*/ } /* ex_case__ */ -/*< SUBRO >*/ /* Subroutine */ int sam_case__(doublereal *qt, doublereal *qm, doublereal * qs, doublereal *aki, doublereal *akf, doublereal *ax3, doublereal * ax4, integer *iss, integer *ier) @@ -1052,94 +576,47 @@ L999: /* 3 'Q MODULUS TOO SMALL', */ /* 4 'Q MODULUS TOO BIG', */ /* ----------------------------------------------------------------------- */ -/*< implicit none >*/ +/* Part of T_CONV.FOR */ -/*< double precision RD, EPS3, EPS6 >*/ -/*< PARAMETER (RD = 57.29577951308232087679815481410517D0) >*/ -/*< PARAMETER (EPS3 = 1.D-3) >*/ -/*< PARAMETER (EPS6 = 1.D-6) >*/ /* ----------------------------------------------------------------------- */ /* Define the dummy arguments */ -/*< double precision qt(3) >*/ -/*< double precision qm, qs, aki, akf, ax3, ax4 >*/ -/*< integer*4 iss, ier >*/ /* ----------------------------------------------------------------------- */ /* Local variables */ -/*< double precision arg, sax3 >*/ /* ----------------------------------------------------------------------- */ /* INIT AND TEST */ -/*< IER = 0 >*/ -#line 494 "t_conv.f" /* Parameter adjustments */ -#line 494 "t_conv.f" --qt; -#line 494 "t_conv.f" -#line 494 "t_conv.f" /* Function Body */ -#line 494 "t_conv.f" *ier = 0; -/*< IF ((ABS(QS) .LT. EPS6) .OR. (ABS(QM) .LT. EPS3)) THEN >*/ -#line 495 "t_conv.f" if (abs(*qs) < 1e-6 || abs(*qm) < .001) { -/*< IER = 3 >*/ -#line 496 "t_conv.f" *ier = 3; -/*< GOTO 999 >*/ -#line 497 "t_conv.f" goto L999; -/*< ENDIF >*/ -#line 498 "t_conv.f" } /* ----------------------------------------------------------------------- */ /* CALCULATE A3 AND MOVE IT INTHE -180 ,+180 INTERVAL */ -/*< ARG = (AKI**2 + AKF**2 - QS)/(2.D0*AKI*AKF) >*/ /* Computing 2nd power */ -#line 502 "t_conv.f" d__1 = *aki; /* Computing 2nd power */ -#line 502 "t_conv.f" d__2 = *akf; -#line 502 "t_conv.f" arg = (d__1 * d__1 + d__2 * d__2 - *qs) / (*aki * 2. * *akf); -/*< IF(ABS(ARG) .GT. 1.D0)THEN >*/ -#line 503 "t_conv.f" if (abs(arg) > 1.) { -/*< IER = 4 >*/ -#line 504 "t_conv.f" *ier = 4; -/*< GOTO 999 >*/ -#line 505 "t_conv.f" goto L999; -/*< ELSE >*/ -#line 506 "t_conv.f" } else { -/*< AX4 = ACOS(ARG)*ISS*RD >*/ -#line 507 "t_conv.f" *ax4 = acos(arg) * *iss * 57.29577951308232087679815481410517; -/*< ENDIF >*/ -#line 508 "t_conv.f" } -/*< >*/ /* Computing 2nd power */ -#line 509 "t_conv.f" d__1 = *akf; /* Computing 2nd power */ -#line 509 "t_conv.f" d__2 = *aki; -#line 509 "t_conv.f" *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 = Dsign(1.D0,ax3) >*/ -#line 511 "t_conv.f" sax3 = d_sign(&c_b10, ax3); -/*< AX3 = DMOD(AX3+sax3*180.D0,360.D0)-sax3*180.D0 >*/ -#line 512 "t_conv.f" d__1 = *ax3 + sax3 * 180.; -#line 512 "t_conv.f" *ax3 = d_mod(&d__1, &c_b12) - sax3 * 180.; /* IF(LPLATE) AX3 = -ATAN(SIN(AX4/RD)/(LSA*TAN(AX5/RD)/(ALMS*C */ @@ -1148,17 +625,11 @@ L999: /* IF( A3 .LT. -180.D0) AX3 = AX3+360.D0 */ /* IF(LPLATE .AND. (A3 .GT. 0.0)) AX3 = AX3-180 */ /* C----------------------------------------------------------------------- */ -/*< 999 CONTINUE >*/ -#line 520 "t_conv.f" L999: -/*< RETURN >*/ -#line 521 "t_conv.f" return 0; -/*< END >*/ } /* sam_case__ */ -/*< SUBRO >*/ /* 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) @@ -1196,90 +667,41 @@ L999: /* There is a 3rd coil for Hz. */ /* ----------------------------------------------------------------------- */ -/*< implicit none >*/ +/* Part of T_CONV.FOR */ /* include 'common_sinq.inc' */ -/*< double precision PI, RD, EPS3, EPS4 >*/ -/*< PARAMETER (PI = 3.14159265358979323846264338327950D0) >*/ -/*< PARAMETER (RD = 57.29577951308232087679815481410517D0) >*/ -/*< PARAMETER (EPS3 = 1.0D-3) >*/ -/*< PARAMETER (EPS4 = 1.0D-4) >*/ /* ----------------------------------------------------------------------- */ /* 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 >*/ /* ----------------------------------------------------------------------- */ /* Local variables */ -/*< integer*4 ic, ncoef >*/ -/*< double precision hdir, hdir2, hrad, phi, qpar, qperp >*/ /* ----------------------------------------------------------------------- */ /* INIT AND TEST */ -/*< AT_SINQ = .TRUE. >*/ -#line 569 "t_conv.f" /* Parameter adjustments */ -#line 569 "t_conv.f" --c_ih__; -#line 569 "t_conv.f" --t_ih__; -#line 569 "t_conv.f" -#line 569 "t_conv.f" /* Function Body */ -#line 569 "t_conv.f" at_sinq__ = TRUE_; -/*< ncoef = 4 >*/ -#line 570 "t_conv.f" ncoef = 4; -/*< if (at_sinq) ncoef = 3 >*/ -#line 571 "t_conv.f" if (at_sinq__) { -#line 571 "t_conv.f" ncoef = 3; -#line 571 "t_conv.f" } -/*< IER = 1 >*/ -#line 573 "t_conv.f" *ier = 1; -/*< IF (ABS(QM) .LT. EPS4) goto 999 >*/ -#line 574 "t_conv.f" if (dabs(*qm) < 1e-4) { -#line 574 "t_conv.f" goto L999; -#line 574 "t_conv.f" } -/*< IER = 0 >*/ -#line 575 "t_conv.f" *ier = 0; -/*< DO IC = 1,ncoef >*/ -#line 576 "t_conv.f" i__1 = ncoef; -#line 576 "t_conv.f" for (ic = 1; ic <= i__1; ++ic) { -/*< IF (C_IH(IC) .LT. EPS4) IER = 2 >*/ -#line 577 "t_conv.f" if (c_ih__[ic] < 1e-4) { -#line 577 "t_conv.f" *ier = 2; -#line 577 "t_conv.f" } -/*< ENDDO >*/ -#line 578 "t_conv.f" } -/*< IF (IER .NE. 0) GOTO 999 >*/ -#line 579 "t_conv.f" if (*ier != 0) { -#line 579 "t_conv.f" goto L999; -#line 579 "t_conv.f" } /* ----------------------------------------------------------------------- */ /* CALCULATE MODULE AND ANGLES OF IN PLANE FIELD H */ @@ -1288,217 +710,92 @@ L999: /* 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/RD) >*/ -#line 587 "t_conv.f" qpar = *aki - *akf * cos(*a4 / 57.29577951308232087679815481410517); -/*< qperp = -akf * sin(a4/RD) >*/ -#line 588 "t_conv.f" qperp = -(*akf) * sin(*a4 / 57.29577951308232087679815481410517); -/*< if (abs(qpar) .gt. EPS3 .and. abs(qperp) .gt. EPS3) then >*/ -#line 589 "t_conv.f" if (abs(qpar) > .001 && abs(qperp) > .001) { -/*< phi = atan2 (abs(qperp), abs(qpar)) >*/ -#line 590 "t_conv.f" phi = atan2((abs(qperp)), (abs(qpar))); -/*< if (qpar .gt. 0 .and. qperp .lt. 0) then >*/ -#line 591 "t_conv.f" if (qpar > 0. && qperp < 0.) { -/*< phi = -phi >*/ -#line 592 "t_conv.f" phi = -phi; -/*< elseif (qpar .lt. 0 .and. qperp .gt. 0) then >*/ -#line 593 "t_conv.f" } else if (qpar < 0. && qperp > 0.) { -/*< phi = PI - phi >*/ -#line 594 "t_conv.f" phi = 3.1415926535897932384626433832795 - phi; -/*< elseif (qpar .lt. 0 .and. qperp .lt. 0) then >*/ -#line 595 "t_conv.f" } else if (qpar < 0. && qperp < 0.) { -/*< phi = phi - PI >*/ -#line 596 "t_conv.f" phi += -3.1415926535897932384626433832795; -/*< endif >*/ -#line 597 "t_conv.f" } -/*< elseif (abs(qpar) .gt. EPS3) then >*/ -#line 598 "t_conv.f" } else if (abs(qpar) > .001) { -/*< if (qpar .ge. 0.0) phi = 0.0 >*/ -#line 599 "t_conv.f" if (qpar >= 0.f) { -#line 599 "t_conv.f" phi = 0.f; -#line 599 "t_conv.f" } -/*< if (qpar .lt. 0.0) phi = PI >*/ -#line 600 "t_conv.f" if (qpar < 0.f) { -#line 600 "t_conv.f" phi = 3.1415926535897932384626433832795; -#line 600 "t_conv.f" } -/*< elseif (abs(qperp) .gt. EPS3) then >*/ -#line 601 "t_conv.f" } else if (abs(qperp) > .001) { -/*< if (qperp .ge. 0.0) phi = 0.5 * PI >*/ -#line 602 "t_conv.f" if (qperp >= 0.f) { -#line 602 "t_conv.f" phi = 1.5707963267948966; -#line 602 "t_conv.f" } -/*< if (qperp .lt. 0.0) phi = -0.5 * PI >*/ -#line 603 "t_conv.f" if (qperp < 0.f) { -#line 603 "t_conv.f" phi = -1.5707963267948966; -#line 603 "t_conv.f" } -/*< else >*/ -#line 604 "t_conv.f" } else { -/*< phi = 0.0 >*/ -#line 605 "t_conv.f" phi = 0.f; -/*< endif >*/ -#line 606 "t_conv.f" } -/*< hrad = sqrt (hx**2 + hy**2) >*/ /* Computing 2nd power */ -#line 608 "t_conv.f" r__1 = *hx; /* Computing 2nd power */ -#line 608 "t_conv.f" r__2 = *hy; -#line 608 "t_conv.f" hrad = sqrt(r__1 * r__1 + r__2 * r__2); -/*< if (abs(hx) .gt. EPS3 .and. abs(hy) .gt. EPS3) then >*/ -#line 609 "t_conv.f" if (dabs(*hx) > .001 && dabs(*hy) > .001) { -/*< hdir = atan2 (abs(hy), abs(hx)) >*/ -#line 610 "t_conv.f" hdir = atan2((dabs(*hy)), (dabs(*hx))); -/*< if (hx .gt. 0 .and. hy .lt. 0) then >*/ -#line 611 "t_conv.f" if (*hx > 0.f && *hy < 0.f) { -/*< hdir = -hdir >*/ -#line 612 "t_conv.f" hdir = -hdir; -/*< elseif (hx .lt. 0 .and. hy .gt. 0) then >*/ -#line 613 "t_conv.f" } else if (*hx < 0.f && *hy > 0.f) { -/*< hdir = PI - hdir >*/ -#line 614 "t_conv.f" hdir = 3.1415926535897932384626433832795 - hdir; -/*< elseif (hx .lt. 0 .and. hy .lt. 0) then >*/ -#line 615 "t_conv.f" } else if (*hx < 0.f && *hy < 0.f) { -/*< hdir = hdir - PI >*/ -#line 616 "t_conv.f" hdir += -3.1415926535897932384626433832795; -/*< endif >*/ -#line 617 "t_conv.f" } -/*< elseif (abs(hx) .gt. EPS3) then >*/ -#line 618 "t_conv.f" } else if (dabs(*hx) > .001) { -/*< if (hx .ge. 0.0) hdir = 0.0 >*/ -#line 619 "t_conv.f" if (*hx >= 0.f) { -#line 619 "t_conv.f" hdir = 0.f; -#line 619 "t_conv.f" } -/*< if (hx .lt. 0.0) hdir = PI >*/ -#line 620 "t_conv.f" if (*hx < 0.f) { -#line 620 "t_conv.f" hdir = 3.1415926535897932384626433832795; -#line 620 "t_conv.f" } -/*< elseif (abs(hy) .gt. EPS3) then >*/ -#line 621 "t_conv.f" } else if (dabs(*hy) > .001) { -/*< if (hy .ge. 0.0) hdir = 0.5 * PI >*/ -#line 622 "t_conv.f" if (*hy >= 0.f) { -#line 622 "t_conv.f" hdir = 1.5707963267948966; -#line 622 "t_conv.f" } -/*< if (hy .lt. 0.0) hdir = -0.5 * PI >*/ -#line 623 "t_conv.f" if (*hy < 0.f) { -#line 623 "t_conv.f" hdir = -1.5707963267948966; -#line 623 "t_conv.f" } -/*< else >*/ -#line 624 "t_conv.f" } else { -/*< hdir = 0.0 >*/ -#line 625 "t_conv.f" hdir = 0.f; -/*< endif >*/ -#line 626 "t_conv.f" } -/*< hdir2 = hdir + phi - (helm/RD) >*/ -#line 628 "t_conv.f" hdir2 = hdir + phi - *helm / 57.29577951308232087679815481410517; /* ----------------------------------------------------------------------- */ /* !CALC CURRENTS */ /* !POSITION OF PSP FOR COIL I */ -/*< if (.not. at_sinq) then >*/ -#line 633 "t_conv.f" if (! at_sinq__) { -/*< hdir2 = hdir2 + 0.5 * PI ! ??? >*/ -#line 634 "t_conv.f" hdir2 += 1.5707963267948966; -/*< do ic = 1,3 >*/ -#line 635 "t_conv.f" +/* ??? */ for (ic = 1; ic <= 3; ++ic) { -/*< t_ih(ic+4) = cos(hdir2+(ic-1)*2.*PI/3.)*hrad/c_ih(ic)/1.5 >*/ -#line 636 "t_conv.f" t_ih__[ic + 4] = cos(hdir2 + (ic - 1) * 2.f * 3.1415926535897932384626433832795 / 3.f) * hrad / c_ih__[ ic] / 1.5f; -/*< enddo >*/ -#line 637 "t_conv.f" } -/*< t_ih(8) = hz/c_ih(4) >*/ -#line 638 "t_conv.f" t_ih__[8] = *hz / c_ih__[4]; -/*< else >*/ -#line 639 "t_conv.f" } else { -/*< t_ih(5) = cos(hdir2) * hrad/c_ih(1) >*/ -#line 640 "t_conv.f" t_ih__[5] = cos(hdir2) * hrad / c_ih__[1]; -/*< t_ih(6) = sin(hdir2) * hrad/c_ih(2) >*/ -#line 641 "t_conv.f" t_ih__[6] = sin(hdir2) * hrad / c_ih__[2]; -/*< t_ih(7) = hz/c_ih(3) >*/ -#line 642 "t_conv.f" t_ih__[7] = *hz / c_ih__[3]; -/*< endif >*/ -#line 643 "t_conv.f" } /* ----------------------------------------------------------------------- */ -/*< 999 CONTINUE >*/ -#line 645 "t_conv.f" L999: -/*< RETURN >*/ -#line 646 "t_conv.f" return 0; -/*< END >*/ } /* helm_case__ */ -/*< SUBRO >*/ /* 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) @@ -1509,76 +806,33 @@ L999: /* CALCULATE P_IF CURRENTS FOR THE TWO FLIPPERS */ /* ----------------------------------------------------------------------- */ /* 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 >*/ +/* Part of T_CONV.FOR */ /* ----------------------------------------------------------------------- */ /* INIT AND TEST */ -/*< IER = 0 >*/ -#line 665 "t_conv.f" /* Parameter adjustments */ -#line 665 "t_conv.f" --t_ih__; -#line 665 "t_conv.f" -#line 665 "t_conv.f" /* Function Body */ -#line 665 "t_conv.f" *ier = 0; /* ----------------------------------------------------------------------- */ -/*< IF (IF1 .EQ. 1) THEN >*/ -#line 668 "t_conv.f" if (*if1 == 1) { -/*< T_IH(1) = F1V >*/ -#line 669 "t_conv.f" t_ih__[1] = *f1v; -/*< T_IH(2) = AKI*F1H >*/ -#line 670 "t_conv.f" t_ih__[2] = *aki * *f1h; -/*< ELSE >*/ -#line 671 "t_conv.f" } else { -/*< T_IH(1) = 0. >*/ -#line 672 "t_conv.f" t_ih__[1] = 0.f; -/*< T_IH(2) = 0. >*/ -#line 673 "t_conv.f" t_ih__[2] = 0.f; -/*< ENDIF >*/ -#line 674 "t_conv.f" } -/*< IF (IF2 .EQ. 1) THEN >*/ -#line 675 "t_conv.f" if (*if2 == 1) { -/*< T_IH(3) = F2V >*/ -#line 676 "t_conv.f" t_ih__[3] = *f2v; -/*< T_IH(4) = AKF*F2H >*/ -#line 677 "t_conv.f" t_ih__[4] = *akf * *f2h; -/*< ELSE >*/ -#line 678 "t_conv.f" } else { -/*< T_IH(3) = 0. >*/ -#line 679 "t_conv.f" t_ih__[3] = 0.f; -/*< T_IH(4) = 0. >*/ -#line 680 "t_conv.f" t_ih__[4] = 0.f; -/*< ENDIF >*/ -#line 681 "t_conv.f" } /* ----------------------------------------------------------------------- */ -/*< 999 CONTINUE >*/ -#line 683 "t_conv.f" /* L999: */ -/*< RETURN >*/ -#line 684 "t_conv.f" return 0; -/*< END >*/ } /* flip_case__ */ diff --git a/t_conv.f b/t_conv.f index cd0e0287..6109842e 100755 --- a/t_conv.f +++ b/t_conv.f @@ -290,7 +290,7 @@ C C----------------------------------------------------------------------- C DEAL WITH FLIPPERS AND HELMOTZ COILS IF LPA C - IF (LPA .AND. (LMOAN(1) .OR. LMOAN(2))) THEN + IF (LPA) 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, diff --git a/t_update.c b/t_update.c index 7aef7fc1..99b96553 100644 --- a/t_update.c +++ b/t_update.c @@ -5,30 +5,31 @@ #include "f2c.h" -/* Subroutine */ int t_update__(real *p_a__, real *p_ih__, real *c_ih__, - logical *lpa, real *dm, real *da, integer *isa, real *helm, real *f1h, - real *f1v, real *f2h, real *f2v, real *f, real *ei, real *aki, real * - ef, real *akf, real *qhkl, real *en, real *hx, real *hy, real *hz, - integer *if1, integer *if2, real *qm, integer *ier) +/* Subroutine */ int t_update__(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) +real *p_a__, *p_ih__, *c_ih__; +logical *lpa; +real *dm, *da; +integer *isa; +real *helm, *f1h, *f1v, *f2h, *f2v, *f, *ei, *aki, *ef, *akf, *qhkl, *en, *hx, + *hy, *hz; +integer *if1, *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 *); + extern /* Subroutine */ int ex_up__(); 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 *); + extern /* Subroutine */ int sam_up__(); static doublereal da2, da3, da4, da6; - extern /* Subroutine */ int erreso_(integer *, integer *); + extern /* Subroutine */ int erreso_(); 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 *); + extern /* Subroutine */ int helm_up__(), flip_up__(); /* =================== */ @@ -193,14 +194,15 @@ } /* t_update__ */ -/* Subroutine */ int ex_up__(doublereal *dx, doublereal *ex, doublereal *akx, - doublereal *ax2, doublereal *f, integer *ier) +/* Subroutine */ int ex_up__(dx, ex, akx, ax2, f, ier) +doublereal *dx, *ex, *akx, *ax2, *f; +integer *ier; { /* System generated locals */ doublereal d__1; /* Builtin functions */ - double sin(doublereal); + double sin(); /* Local variables */ static doublereal arg; @@ -227,10 +229,7 @@ /* !!!!!!!!!! This has to be fixed manually after conversion by f2c. */ /* !!!!!!!!!! The reason is a different definition of the abs function. */ /* !!!!!!!!!! MK, May 2001 */ - arg = *dx * sin(*ax2 / 114.59155902616465); - if(arg < .0) - arg = -arg; - + arg = (d__1 = *dx * sin(*ax2 / 114.59155902616465), abs(d__1)); if (arg <= 1e-4) { *ier = 1; } else { @@ -245,17 +244,16 @@ } /* ex_up__ */ -/* Subroutine */ int sam_up__(doublereal *qhkl, doublereal *qm, doublereal * - qs, doublereal *phi, doublereal *aki, doublereal *akf, doublereal *a3, - doublereal *a4, integer *ier) +/* Subroutine */ int sam_up__(qhkl, qm, qs, phi, aki, akf, a3, a4, ier) +doublereal *qhkl, *qm, *qs, *phi, *aki, *akf, *a3, *a4; +integer *ier; { /* Builtin functions */ - double cos(doublereal), sin(doublereal), atan2(doublereal, doublereal); + double cos(), sin(), atan2(); /* Local variables */ static doublereal qpar, qperp; - extern /* Subroutine */ int sp2rlv_(doublereal *, doublereal *, - doublereal *, doublereal *, integer *); + extern /* Subroutine */ int sp2rlv_(); static doublereal qt[3]; /* ================= */ @@ -302,7 +300,7 @@ if (abs(qperp) > .001 && abs(qpar) > .001) { *phi = atan2(qperp, qpar); } else if (abs(qpar) < .001) { - if (*a4 > 0.f) { + if (*a4 > (float)0.) { *phi = -1.5707963267948966; } else { *phi = 1.5707963267948966; @@ -313,17 +311,18 @@ } /* sam_up__ */ -/* Subroutine */ int helm_up__(doublereal *phi, real *helm, real *p_ih__, - real *c_ih__, doublereal *dhx, doublereal *dhy, doublereal *dhz, - integer *ier) +/* Subroutine */ int helm_up__(phi, helm, p_ih__, c_ih__, dhx, dhy, dhz, ier) +doublereal *phi; +real *helm, *p_ih__, *c_ih__; +doublereal *dhx, *dhy, *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); + double sqrt(), atan2(), cos(), sin(); /* Local variables */ static doublereal hdir, hmod, hpar, hdir2, h__[4], hperp; @@ -421,21 +420,21 @@ hdir2 += -3.1415926535897932384626433832795; } } else if (abs(hpar) > .001) { - if (hpar >= 0.f) { - hdir2 = 0.f; + if (hpar >= (float)0.) { + hdir2 = (float)0.; } - if (hpar < 0.f) { + if (hpar < (float)0.) { hdir2 = 3.1415926535897932384626433832795; } } else if (abs(hperp) > .001) { - if (hperp >= 0.f) { + if (hperp >= (float)0.) { hdir2 = 1.5707963267948966; } - if (hperp < 0.f) { + if (hperp < (float)0.) { hdir2 = -1.5707963267948966; } } else { - hdir2 = 0.f; + hdir2 = (float)0.; } hdir = hdir2 + *helm / 57.29577951308232087679815481410517 - *phi; *dhx = hmod * cos(hdir); @@ -445,9 +444,11 @@ } /* 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) +/* Subroutine */ int flip_up__(if1, if2, p_ih__, f1v, f1h, f2v, f2h, aki, akf, + ier) +integer *if1, *if2; +real *p_ih__, *f1v, *f1h, *f2v, *f2h, *aki, *akf; +integer *ier; { /* System generated locals */ real r__1, r__2; @@ -480,12 +481,12 @@ *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) { + if ((r__1 = p_ih__[1] - *f1v, dabs(r__1)) < (float).05 && (r__2 = p_ih__[ + 2] - *aki * *f1h, dabs(r__2)) < (float).05) { *if1 = 1; } - if ((r__1 = p_ih__[3] - *f2v, dabs(r__1)) < .05f && (r__2 = p_ih__[4] - * - akf * *f2h, dabs(r__2)) < .05f) { + if ((r__1 = p_ih__[3] - *f2v, dabs(r__1)) < (float).05 && (r__2 = p_ih__[ + 4] - *akf * *f2h, dabs(r__2)) < (float).05) { *if2 = 1; } /* ----------------------------------------------------------------------- */ diff --git a/tas.h b/tas.h index 58cd95b6..5551cbd1 100644 --- a/tas.h +++ b/tas.h @@ -148,7 +148,7 @@ #define MAXPAR 130 #define MAXADD 20 -#define MAXEVAR 10 +#define MAXEVAR 12 /* --------------------- data structure -------------------------------*/ diff --git a/tascom.tcl b/tascom.tcl index e4ade56f..b30ee0dc 100644 --- a/tascom.tcl +++ b/tascom.tcl @@ -61,7 +61,11 @@ set tasmap(ss) "scatSense ss " set tasmap(sa) "scatSense sa " set tasmap(sm) "scatSense sm " set tasmap(fx) "fxi " - +for {set i 0} { $i < 8} { incr i} { + set cur [format "i%1.1d" $i] + set tasmap(l$cur) [format "%s lowerlimit " $cur] + set tasmap(u$cur) [format "%s upperlimit " $cur] +} #---------------------------------------------------------------------- # mapping array output for debugging #set l [array names tasmap] @@ -195,11 +199,11 @@ proc scatSense {par {val -1000} } { set newupper [expr $oldupper - 90.] } elseif { $val == 1 && $oldsa == -1} { set newzero [expr $oldzero + 180. ] - set newlower [expr $oldlower + 180. ] + set newlower [expr -($oldlower - 180.) ] set newupper [expr $oldupper + 180. ] } elseif {$val == -1 && $oldsa == 1} { set newzero [expr $oldzero - 180. ] - set newlower [expr $oldlower - 180. ] + set newlower [expr -($oldlower - 180.) ] set newupper [expr $oldupper - 180. ] } else { error "Unknown SA setting combination" diff --git a/tasinit.c b/tasinit.c index 1962b7d4..c9731dad 100644 --- a/tasinit.c +++ b/tasinit.c @@ -53,6 +53,9 @@ extern char *tasMotorOrder[] = { "a1", "i2", "i3", "i4", + "hxx", + "hyy", + "hzz", "i5", "i6", "i7", diff --git a/tasscan.c b/tasscan.c index 71cf2dc3..cdf24fa6 100644 --- a/tasscan.c +++ b/tasscan.c @@ -566,7 +566,7 @@ static int TASScanDrive(pScanData self, int iPoint) int i, status, iPtr; int iTAS = 0; pMotor pMot; - unsigned char tasTargetMask[20], tasMask[10]; + unsigned char tasTargetMask[20], tasMask[MAXEVAR]; float tasTargets[20]; /* diff --git a/tastest.tcl b/tastest.tcl index a7013d51..bbcf6018 100644 --- a/tastest.tcl +++ b/tastest.tcl @@ -313,7 +313,7 @@ MakeTAS iscan #-------------------------------------------------------------------------- # I N S T A L L T A S S C R I P T E D C O M M A N D S - +MakeDrive source $root/tascom.tcl diff --git a/tasu.h b/tasu.h index bc95ce99..0a35b7c5 100644 --- a/tasu.h +++ b/tasu.h @@ -15,9 +15,9 @@ extern char *tasMotorOrder[]; extern char *tasVariableOrder[]; /* maximum number of motors in the list */ -#define MAXMOT 27 +#define MAXMOT 31 /* offset to the currents, if available */ -#define CURMOT (MAXMOT - 8) +#define CURMOT (MAXMOT - 11) /* diff --git a/tasutil.c b/tasutil.c index 8e7e00fa..9ad9dac0 100644 --- a/tasutil.c +++ b/tasutil.c @@ -250,7 +250,7 @@ extern int inicurve_(integer *midx, real *mrx1, real *mrx2, integer /*-------------------------------------------------------------------*/ int TASCalc(pTASdata self, SConnection *pCon, - unsigned char tasMask[10], + unsigned char tasMask[MAXEVAR], float motorTargets[20], unsigned char motorMask[20]) { @@ -453,7 +453,7 @@ int TASCalc(pTASdata self, SConnection *pCon, } if(ldh){ /* currents must be driven */ - for( i = 0; i < 4; i++){ + for( i = 0; i < 3; i++){ motorMask[13+i] = 1; } } diff --git a/test.tcl b/test.tcl index 10c1270b..b1c37a2e 100644 --- a/test.tcl +++ b/test.tcl @@ -219,8 +219,8 @@ VarMake email Text User VarMake sample_mur Float User MakeDataNumber SicsDataNumber "$shome/sics/danu.dat" -InitSANS $shome/sics/sansdict.dic -#InitDMC +#InitSANS $shome/sics/sansdict.dic +InitDMC MakeScanCommand xxxscan counter topsi.hdd recover.bin MakePeakCenter xxxscan