#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)
*/

#include "f2c.h"

#line 1 "t_conv.f"
/* Common Block Declarations */

struct {
    integer icrm, icra, iclm;
    real cm1rx, cm2rx, ca1rx, ca2rx, rmmin, rmmax, ramin, ramax;
    integer inx;
    logical at_sinq__;
} curve_;

#define curve_1 curve_

/* Table of constant values */

static integer c__0 = 0;
static integer c__1 = 1;
static doublereal c_b10 = 1.;
static doublereal c_b12 = 360.;

/* ------------------------------------------------------------------------ */
/* slightly edited version for inclusion into SICS */

/* Mark Koennecke, November 2000 */
/* ------------------------------------------------------------------------- */
/*<        >*/
/* Subroutine */ int inicurve_(integer *midx, real *mrx1, real *mrx2, integer 
	*aidx, real *arx1, real *arx2, real *mmin, real *mmax, real *amin, 
	real *amax)
{

/* Initializes a common with the curvature parameters. */
/* In: monochrmoator curvatuure motor index and parameters */
/* In: analyzer curvature motor index + parameters */
/*<       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,
	 real *da, real *helm, real *f1h, real *f1v, real *f2h, real *f2v, 
	real *f, integer *ifx, integer *iss, integer *ism, integer *isa, real 
	*t_a__, real *t_rm__, real *t_alm__, real *t_ra__, real *qm, logical *
	ldra, logical *ldr_rm__, logical *ldr_alm__, logical *ldr_ra__, real *
	p_ih__, real *c_ih__, integer *ier)
{
    /* System generated locals */
    doublereal d__1;

    /* Builtin functions */
    double sqrt(doublereal);

    /* Local variables */
    static doublereal edef[2], dakf, daki;
    static integer imod;
    extern /* Subroutine */ int sam_case__(doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, integer *, integer *);
    static integer i__;
    static doublereal akdef[2];
    extern /* Subroutine */ int helm_case__(real *, real *, real *, real *, 
	    real *, real *, real *, doublereal *, real *, real *, integer *);
    static doublereal dqhkl[3];
    extern /* Subroutine */ int flip_case__(integer *, integer *, real *, 
	    real *, real *, real *, real *, real *, real *, integer *);
    static logical lmoan[2];
    static doublereal a1, a2, a3, a4, a5, a6;
    static integer id;
    static doublereal ra;
    extern /* Subroutine */ int rl2spv_(doublereal *, doublereal *, 
	    doublereal *, doublereal *, integer *);
    static integer iq;
    static doublereal rm;
    static logical lqhkle;
    extern /* Subroutine */ int erreso_(integer *, integer *);
    static doublereal dda, ala, def, dei, ddm, alm, dqm, dqs, dqt[3];
    extern /* Subroutine */ int ex_case__(doublereal *, integer *, doublereal 
	    *, doublereal *, doublereal *, doublereal *, doublereal *, 
	    integer *, integer *);

/* 	================= */

/* dec$	  ident	    'V01D' */
/* ----------------------------------------------------------------------- */
/*  Other routines in this file: */

/*       SUBROUTINE EX_CASE (DX,ISX,AKX,AX1,AX2,RX,ALX,IER) */
/*       SUBROUTINE SAM_CASE (QT,QM,QS,AKI,AKF,AX3,AX4,ISS,IER) */
/*       SUBROUTINE HELM_CASE (HX,HY,HZ,P_IH,AKI,AKF,A4,QM,HELM,IER) */
/*       SUBROUTINE FLIP_CASE (IF1,IF2,P_IH,F1V,F1H,F2V,F2H,AKI,AKF,IER) */
/* ----------------------------------------------------------------------- */
/*  INPUTS */
/*       EI,AKI,EF,AKF,QHKL,EN,HX,HY,HZ : POTENTIAL TARGETS */
/* 	IF1,IF2 Status of flippers On (1) Off (0) */
/*       LDK(8)          LOGICAL INDICATING IF (ENERGY,K OR Q) ARE DRIVEN */
/*       LDH,LDF         LOGICAL INDICATING IF (HX,HY,HZ) OR (F1,F2) ARE DRIVEN */

/*     	  configuration of the machine */

/*       LPA             LOGICAL  TRUE IF MACHINE IN POLARIZATION MODE */
/*       DM,DA,HELM,F1H,F1V,F2H,F2V,F,IFX,ISS,ISM,ISA,QM (F ENERGY UNIT) */

/*  OUTPUTs */
/*       T_A            TARGETS OF ANGLES A1-A6 */
/*       T_RM,T_ALM     TARGETS OF RM ,LM */
/*       T_RA	       TARGET  OF RA */
/*       QM             TARGETS OF QM */
/*       LDRA           LOGICAL INDICATING WHICH ANGLES ARE TO BE DRIVEN */
/*       LDR_RM	       LOGICAL INDICATING IF RM  (mono curve)  IS TO BE DRIVEN */
/* 	LDR_ALM	       LOGICAL INDICATING IF ALM (mono transl) IS TO BE DRIVEN */
/*       LDR_RA	       LOGICAL INDICATING IF RA  (anal curve)  IS TO BE DRIVEN */
/*       P_IH	       TARGETS OF CURRENTS FOR FLIPPERS AND HELMOTZ (8 CURRENTS) */
/*       C_IH	       CONVERSION FACTORS FOR HELMOTZ (4 CURRENTS) */

/*  SPECIAL OUTPUTS */
/*       TARGET OF EI(EF) IS UPDATED IS KI(KF) IS DRIVEN */
/*       TARGET OF VARIABLE ENERGY IS UPDATED IF EN IS DRIVEN */
/* ----------------------------------------------------------------------- */
/*< 	implicit      none >*/

/*< 	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 */
/*       LDQHKLE : LOGICAL INDICATING THAT WE ARE DEALING WITH A MOVE */
/*       IN RECIPROCICAL SPACE */
/*       WE REMAP THE ENERGY PB AS FIXED ENERGY IN EDEF(1) */
/*       AND VARIABLE ENERGY IN EDEF(2) */
/*       IF ISA IS NUL  SET IFX TO 1 AND PUT EF,KF, EQUAL TO EI,KI */

/*<         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 */
/*       VARIABLE ENERGUY IS DRIVEN EITHER EXPLICITLY */
/*       E.G. BY DRIVING EI OR KI WITH IFX=2 */
/*        ( AND WE MUST CALCULATE EN FROM EVAR) */
/*       THE RULE IS : EI=EF+EN : EN IS THE ENERGY LOSS OF NEUTRONS */
/*       OR ENERGY GAIN OF SAMPLE */
/*       OR IMPLICITLY  BY DRIVING THE TRANSFERED ENERGY EN */
/*        ( AND WE MUST CALCULATE EVAR FROM EN) */
/*       IF KI IS CONSTANT USE THE CURRENT VALUE CONTAINED IN POSN ARRAY */
/*       TO CALCULATE THE NON-"CONSTANT" K. */
/*       IF KF IS CONSTANT USE ALWAYS THE VALUE IN TARGET AND */
/*        DO A DRIVE OF KF TO KEEP A5/A6 IN RIGHT POSITION */

/*<         IF (LDK(5-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 (*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)
{
    /* System generated locals */
    doublereal d__1;

    /* Builtin functions */
    double asin(doublereal), sin(doublereal), cos(doublereal), sqrt(
	    doublereal);

    /* Local variables */
    static integer indx;
    static doublereal dcl1r, dc1rx, dc2rx, drmin, drmax, my_rx__, arg;

/* 	================== */

/*     	      CALCULATE  ANGLES ON MONO/ANALYSER */
/*     	      CALCULATE AX1  AX2 */
/*     	      CALCULATE RX = MONO OR ANAL CURVATURE AND LM = MONO POSIT FOR IN8 */

/*  INPUTS */
/*       DX	      D-SPACINGS */
/*       ISX	      SENS OF SCATTERING ON CRYSTAL. If =0, this is probably */
/* 			a 3-axis instr. in simulated 2-axis mode and the */
/* 			calculation is for the scattering at the analyser. */
/* 			In this case, we set AX1 = AX2 = 0 which gives a */
/* 			"straight-through" setting of A5 & A6 (because of */
/* 			a simultaneous 90 degree zero offset for A5 -- this */
/* 			is a bit of a hack, if you ask me!). */
/*       AKX	      TARGET OF MOMENTUM */
/* 	MON_OR_ANAL   =0 if calculation is for mono. */
/* 		      =1 if calculation is for anal. */
/*  OUTPUTS */
/*       AX1 AX2	  THETA 2*THETA ANGLES */
/*       RX	  MONO OR ANALYSER CURVATURE */
/*       ALX	  SPECIAL TRANSLATION FOR IN8 */
/*       IER */
/*        1       'KI OR KF CANNOT BE OBTAINED CHECK D-SPACINGS', */
/*        2       'KI OR KF TOO SMALL', */
/*        3       'KI OR KF TOO BIG', */
/* ----------------------------------------------------------------------- */
/*<         implicit      none >*/

/*< 	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"
	indx = curve_1.icrm;
/*< 	  dc1rx = cm1rx >*/
#line 378 "t_conv.f"
	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"
	dc1rx = curve_1.ca1rx;
/*< 	  dc2rx = ca2rx >*/
#line 386 "t_conv.f"
	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 */
/* 	  drmin = drmin + tbut(3,indx) */
/* 	  drmax = drmax + tbut(3,indx) */
/* 	  if (drmin .lt. tbut(1,indx)) drmin = tbut(1,indx) */
/* 	  if (drmax .gt. tbut(2,indx)) drmax = tbut(2,indx) */
/* 	endif */
/* ----------------------------------------------------------------------- */
/*       Calculation of the two angles */

/*< 	if (isx .eq. 0) then	    ! "Straight-through" mode? >*/
#line 400 "t_conv.f"
    if (*isx == 0) {
/*< 	  ax1 = 0.0		    ! Yes. >*/
#line 401 "t_conv.f"
	*ax1 = 0.f;
/*< 	  ax2 = 0.0 >*/
#line 402 "t_conv.f"
	*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 */
/*  Standard law is: */

/* 	For monochr: */
/* 	    CM1RX + CM2RX/SIN(abs(A1)/RD) */

/* 	For analyser: */
/* 	    CA1RX + CA2RX*SIN(abs(A5)/RD) */

/*  CM1RX/CM2RX/CA1RX/CA2RX are parameters depending on monochr/analyser and */
/*  instrument. They are read from CURVE.INI in routine SETUP_MOT_CURVE. */
/*  e.g.  cm1rx = .47 */
/*        cm2rx = .244 */
/*        rmmin = 0. */
/*        rmmax = 20. */
/* ----------------------------------------------------------------------- */
/*< 	if (mon_or_anal .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"
	if (curve_1.inx != 0) {
/*< 	    if (iclm .ne. 0) then	    ! Yes, IN8 case. If there's a .. >*/
#line 429 "t_conv.f"
	    if (curve_1.iclm != 0) {
/*< 	      alx = (dcl1r/sin(ax2/rd)) * cos(ax2/rd)	   ! .. motor, do the .. >*/
#line 430 "t_conv.f"
		*alx = dcl1r / sin(*ax2 / 57.29577951308232087679815481410517)
			 * cos(*ax2 / 57.29577951308232087679815481410517);
/*< 	      rx  = dc2rx * sqrt(sin(abs(ax2)/rd)) - dc1rx ! .. calculation. >*/
#line 431 "t_conv.f"
		*rx = dc2rx * sqrt(sin(abs(*ax2) / 
			57.29577951308232087679815481410517)) - dc1rx;
/*< 	      rx = dmin1 (dmax1 (rx, drmin), drmax) >*/
/* 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"
	    my_rx__ = dc1rx + dc2rx / sin(abs(*ax1) / 
		    57.29577951308232087679815481410517);
/*< 	  endif >*/
#line 437 "t_conv.f"
	}
/*< 	else					    ! Analyser. >*/
#line 438 "t_conv.f"
    } else {
/*< 	  my_rx = dc1rx + dc2rx * sin(abs(ax1)/rd)  ! Simply calculate. >*/
#line 439 "t_conv.f"
	my_rx__ = dc1rx + dc2rx * sin(abs(*ax1) / 
		57.29577951308232087679815481410517);
/*< 	endif >*/
#line 440 "t_conv.f"
    }

/*< 	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) >*/
/* 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 */
/*  101	    format (' Warning -- ', a8, 'curvature restricted by low ', */
/*     +		      '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)
{
    /* System generated locals */
    doublereal d__1, d__2;

    /* Builtin functions */
    double acos(doublereal), atan2(doublereal, doublereal), d_sign(doublereal 
	    *, doublereal *), d_mod(doublereal *, doublereal *);

    /* Local variables */
    static doublereal arg, sax3;

/* 	=================== */

/*               DEAL WITH SAMPLE ANGLES CALCULATION FROM Q VECTOR IN C-N PLANE */
/*     		CALCULATE A3 AND A4 */
/*  INPUTS */
/*       QT	  Q-VECTOR IN SCATTERING PLANE */
/*       QM,QS	  Q MODULUS AND QMODULUS SQUARED */
/*       AKI,AKF	  MOMEMTA ON MONO AND ANYLSER */
/*       ISS       SENS OF SCATTERING ON SAMPLE */

/*  OUTPUTS */
/*       AX3 AX4   ANGLES ON SAMPLES */
/*       IER	  SAME ERROR AS RL2SPV */
/*       IER */
/*        1       'MATRIX S NOT OK', */
/*        2       'Q NOT IN SCATTERING PLANE', */
/*        3       'Q MODULUS TOO SMALL', */
/*        4       'Q MODULUS TOO BIG', */
/* ----------------------------------------------------------------------- */
/*<         implicit      none >*/

/*< 	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 */
/*       1       TAN(AX1/RD))*(AKI/KF)**2-COS(AX4/RD)))*RD       !PLATE FOCALIZATION OPTION */
/*       IF(AXX3 .GT. 180.D0) AX3 = AX3-360.D0 */
/*       IF( A3 .LT. -180.D0) AX3 = AX3+360.D0 */
/*       IF(LPLATE .AND. (A3 .GT. 0.0)) AX3 = AX3-180 */
/* C----------------------------------------------------------------------- */
/*< 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)
{
    /* System generated locals */
    integer i__1;
    real r__1, r__2;

    /* Builtin functions */
    double cos(doublereal), sin(doublereal), atan2(doublereal, doublereal), 
	    sqrt(doublereal);

    /* Local variables */
    static doublereal hrad, hdir, qpar, hdir2;
    static integer ncoef;
    static doublereal qperp;
    static integer ic;
    static doublereal phi;
    static logical at_sinq__;

/* 	==================== */

/*               DEAL WITH HELMOTZ COIL FIELD CALCULATIONS */
/*     	        CALCULATE HX HY HZ */
/* ----------------------------------------------------------------------- */
/*  At ILL: */
/* 	There are 3 coils for Hx/Hy at 120 degrees to each other. */

/* 	There is a 4th coil for Hz. */

/*  At SINQ: */
/* 	There is an Hx coil and an Hy coil (actually each is 4 coils powered */
/* 	in series). They are mounted on a ring (SRO). The value of HELM is */
/* 	the angle between the Hx coil and ki. */

/* 	There is a 3rd coil for Hz. */
/* ----------------------------------------------------------------------- */
/*<         implicit      none >*/

/* 	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 */
/*       PHI	      ! Angle between Q and KI (in radians) */
/*       HRAD	      ! Radial comp. of H */
/*       HDIR	      ! Direction of H relative to PHI (in radians) */
/*       HDIR2	      ! Angle between field and axis of Coil 1 (in radians) */

/*<         qpar  =  aki - akf * cos(a4/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)
{
/* 	==================== */

/*               DEAL WITH FLIPPER COIL  CALCULATIONS */
/*     		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 >*/
/* ----------------------------------------------------------------------- */
/*       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__ */

