C-----------------------------------------------------------------------
C       FILE T_CONV
C       SUBROUTINE T_CONV(EI,AKI,EF,AKF,QHKL,EN,HX,HY,HZ,IF1,IF2,LDK,LDH,LDF
C       1       LPA,DM,DA,HELM,F1H,F1V,F2H,F2V,F,IFX,ISS,ISM,ISA,
C       2       T_A,T_RM,T_ALM,LDRA,LDR_RM,LDR_ALM,P_IH,C_IH,IER)
C       SUBROUTINE EX_CASE(DX,ISX,AKX,AX1,AX2,RX,ALX,IER)
C       SUBROUTINE SAM_CASE(QT,QM,QS,AKI,AKF,AX3,AX4,ISS,IER)
C       SUBROUTINE HELM_CASE(HX,HY,HZ,P_IH,AKI,AKF,A4,QM,HELM,IER)
C       SUBROUTINE FLIP_CASE(IF1,IF2,P_IH,F1V,F1H,F2V,F2H,AKI,AKF,IER)
C-----------------------------------------------------------------------
        SUBROUTINE T_CONV(EI,AKI,EF,AKF,QHKL,EN,HX,HY,HZ,IF1,IF2,
     1   LDK,LDH,LDF,LPA,DM,DA,HELM,F1H,F1V,F2H,F2V,F,IFX,ISS,
     2   ISM,ISA,T_A,T_RM,T_ALM,QM,LDRA,LDR_RM,LDR_ALM,P_IH,C_IH,IER)
C-----------------------------------------------------------------------
C
C       INPUT
C       EI,AKI,EF,AKF,QHKL,EN,HX,HY,HZ : POTENTIAL TARGETS
C	IF1,IF2 Status of flippers On (1) Off (0)
C       LDK(8)          LOGICAL INDICATING IF (ENERGY,K OR Q) ARE DRIVEN
C       LDH,LDF         LOGICAL INDICATING IF (HX,HY,HZ) OR (F1,F2) ARE DRIVEN
C
C       configuration of the machine
C       LPA             LOGICAL  TRUE IF MACHINE IN POLARIZATION MODE
C       DM,DA,HELM,F1H,F1V,F2H,F2V,F,IFX,ISS,ISM,ISA,QM (F ENERGY UNIT)
C
C       OUTPUT
C       T_A             TARGETS OF ANGLES A1-A6
C       T_RM,T_ALM      TARGETS OF RM ,LM
C       QM                      TARGETS OF QM
C       LDRA                    LOGICAL INDICATING WHICH ANGLES ARE TO BE DRIVEN
C       LDR_RM,LDR_ALM  LOGICAL INDICATING IF RM OR ALM ARE TO BE DRIVEN
C       P_IH    TARGETS OF CURRENTS FOR FLIPPERS AND HELMOTZ (8 CURRENTS)
C       C_IH    CONVERSION FACTORS FOR HELMOTZ (4 CURRENTS)
C
C       SPECIAL OUTPUTS
C       TARGET OF EI(EF) IS UPDATED IS KI(KF) IS DRIVEN
C       TARGET OF VARIABLE ENERGY IS UPDATED IF EN IS DRIVEN
C-----------------------------------------------------------------------
        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
        PARAMETER(EPS1=1.D-1,EPS4=1.D-4)
C-----------------------------------------------------------------------
C       PASSED PARAMETERS
	REAL EI,AKI,EF,AKF,QHKL(3),EN,HX,HY,HZ
        LOGICAL LDK(8),LDH,LDF,LPA
        REAL DM,DA,HELM,F1H,F1V,F2H,F2V,F
	REAL T_A(6),T_RM,T_ALM,QM
	LOGICAL LDRA(6),LDR_RM,LDR_ALM
	REAL P_IH(8),C_IH(4)
C-----------------------------------------------------------------------
C        LOCAL VARIABLES
C
        DIMENSION EDEF(2),AKDEF(2),DQHKL(3),DQT(3)
	double precision ddm,dda
        LOGICAL LMOAN(2),LQHKLE
C-----------------------------------------------------------------------
C       SET UP
C       IMOD  INDEX FOR ERROR TREATMENAT BY ERRESO
C       LDQHKLE : LOGICAL INDICATING THAT WE ARE DEALING WITH A MOVE
C       IN RECIPROCICAL SPACE
C       WE REMAP THE ENERGY PB AS FIXED ENERGY IN EDEF(1)
C       AND VARIABLE ENERGY IN EDEF(2)
C       IF ISA IS NUL  SET IFX TO 1 AND PUT EF,KF, EQUAL TO EI,KI
C
        IMOD=3
	DDM=DM
	DDA=DA
        DO  I=1,2
                LMOAN(I)=.FALSE.
        ENDDO
        LQHKLE=.FALSE.
        DO IQ=5,8
                LQHKLE=(LQHKLE.OR.LDK(IQ))
        ENDDO
	DAKI=AKI
	DAKF=AKF
        IF (ISA.EQ.0) IFX=1
        EDEF(IFX)=EI
        AKDEF(IFX)=AKI
        EDEF(3-IFX)=EF
        AKDEF(3-IFX)=AKF
        IF( ISA.EQ.0) THEN
                EDEF(2)=EDEF(1)
                AKDEF(2)=AKDEF(1)
                LDK(3)=.TRUE.
                LDK(4)=.TRUE.
                T_A(5)=0.
                T_A(6)=0.
                LDRA(5)=.TRUE.
                LDRA(6)=.TRUE.
        ENDIF
C-----------------------------------------------------------------------
C       FIRST TAKE IN ACCOUNT THE FIXED ENERGY PB
C
        IF (LDK(2*IFX-1).OR.LDK(2*IFX)) THEN
                LMOAN(IFX)=.TRUE.
                IF (LDK(2*IFX-1)) THEN
                        IER=1
                        IF(EDEF(1).LT.EPS1) GOTO 999
                        IER=0
                        AKDEF(1)=SQRT(EDEF(1)/F)
                ELSE
                        IER=1
                        IF(AKDEF(1).LT.EPS1) GOTO 999
                        IER=0
                        EDEF(1)=F*AKDEF(1)**2
                ENDIF
        ENDIF
C-----------------------------------------------------------------------
C       NOW TAKE IN ACCOUNT THE VARIABLE ENERGY PB
C       VARIABLE ENERGUY IS DRIVEN EITHER EXPLICITLY
C       E.G. BY DRIVING EI OR KI WITH IFX=2
C        ( AND WE MUST CALCULATE EN FROM EVAR)
C       THE RULE IS : EI=EF+EN : EN IS THE ENERGY LOSS OF NEUTRONS
C       OR ENERGY GAIN OF SAMPLE
C       OR IMPLICITLY  BY DRIVING THE TRANSFERED ENERGY EN
C        ( AND WE MUST CALCULATE EVAR FROM EN)
C       IF KI IS CONSTANT USE THE CURRENT VALUE CONTAINED IN POSN ARRAY
C       TO CALCULATE THE NON-"CONSTANT" K.
C       IF KF IS CONSTANT USE ALWAYS THE VALUE IN TARGET AND
C        DO A DRIVE OF KF TO KEEP A5/A6 IN RIGHT POSITION
C
        IF (LDK(5-2*IFX).OR.LDK(6-2*IFX)) THEN
                LMOAN(3-IFX)=.TRUE.
                IF (LDK(5-2*IFX)) THEN
                        IER=1
                        IF(EDEF(2).LT.EPS4) GOTO 999
                        IER=0
                        AKDEF(2)=SQRT(EDEF(2)/F)
                ELSE
                        IER=1
                        IF(AKDEF(2).LT.EPS4) GOTO 999
                        IER=0
                        EDEF(2)=F*AKDEF(2)**2
                ENDIF
                EN=(3-2*IFX)*(EDEF(1)-EDEF(2))
                ELSE IF (LQHKLE) THEN
                        LMOAN(3-IFX)=.TRUE.
                        EDEF(2)=EDEF(1)+(2*IFX-3)*EN
                        IER=1
                        IF(EDEF(2).LT.EPS4) GOTO 999
                        IER=0
                        AKDEF(2)=SQRT(EDEF(2)/F)
        ENDIF
C-----------------------------------------------------------------------
C       CALCULATE MONOCHROMATOR AND ANALYSER ANGLES
C
        IF(LMOAN(1)) THEN
	        DEI=EDEF(IFX)
	        DAKI=AKDEF(IFX)
                CALL EX_CASE(DDM,ISM,DAKI,A1,A2,RM,ALM,IER)
                IF (IER.EQ.0) THEN
			AKI=DAKI
			EI=DEI
                        T_A(1)=A1
                        T_A(2)=A2
                        T_RM=RM
                        T_ALM=ALM
                        LDRA(1)=.TRUE.
                        LDRA(2)=.TRUE.
                        LDR_RM=.TRUE.
                        LDR_ALM=.TRUE.
                ELSE
                        GOTO 999
                ENDIF
        ENDIF
        IF(LMOAN(2)) THEN
	        DEF=EDEF(3-IFX)
	        DAKF=AKDEF(3-IFX)
                CALL EX_CASE(DDA,ISA,DAKF,A5,A6,RA,ALA,IER)
                IF (IER.EQ.0) THEN
                	AKF=DAKF
			EF=DEF
                        T_A(5)=A5
                        T_A(6)=A6
                        LDRA(5)=.TRUE.
                        LDRA(6)=.TRUE.
                ELSE
                        GOTO 999
                ENDIF
        ENDIF
C-----------------------------------------------------------------------
C       USE (QH,QK,QL) TO CALCULATE A3 AND A4
C       CALCULATE Q1 AND Q2 IN SCATTERING PLANE
C
        IMOD=2
        IF (LQHKLE) THEN
			DO ID=1,3
				DQHKL(ID)=QHKL(ID)
			ENDDO
                CALL RL2SPV(DQHKL,DQT,DQM,DQS,IER)
                IF (IER.NE.0) GOTO 999
                CALL SAM_CASE(DQT,DQM,DQS,DAKI,DAKF,A3,A4,ISS,IER)
                IF (IER.EQ.0) THEN
                        T_A(3)=A3
                        T_A(4)=A4
                        LDRA(3)=.TRUE.
                        LDRA(4)=.TRUE.
                        QM=DQM
                ELSE
                        GOTO 999
                ENDIF
        ENDIF
C-----------------------------------------------------------------------
C        DEAL WITH FLIPPERS AND HELMOTZ COILS IF LPA
C
	IF (LPA.AND.(LMOAN(1).OR.LMOAN(2))) THEN
	IF (LDF) CALL FLIP_CASE(IF1,IF2,P_IH,F1V,F1H,F2V,F2H,AKI,AKF,IER)
	IF (LDH) CALL HELM_CASE(HX,HY,HZ,P_IH,C_IH,AKI,AKF,
     1                          A4,QM,HELM,IER)
	endif
C-----------------------------------------------------------------------
999     CONTINUE
        IF (IER.NE.0) CALL ERRESO(IMOD,IER)
        RETURN
        END
        SUBROUTINE EX_CASE(DX,ISX,AKX,AX1,AX2,RX,ALX,IER)
C-----------------------------------------------------------------------
C        CALCULATE  ANGLES ON MONO/ANALYSER
C       CALCULATE AX1  AX2
C       CALCULATE RX LX MONO CURVATURE AND LM FOR IN8
C
C       INPUT
C       DX      D-SPACINGS
C       ISX     SENS OF SCATTERING ON CRYSTAL
C       AKX     TARGET OF MOMENTUM
C       OUTPUT
C       AX1 AX2  THETA 2*THETA ANGLES
C       RX      MONO OR ANALYSER CURVATURE
C       ALX     SPECIAL TRANSLATION FOR IN8
C       IER
C        1       ' KI OR KF CANNOT BE OBTAINED CHECK D-SPACINGS',
C        2       ' KI OR KF TOO SMALL',
C        3       ' KI OR KF TOO BIG',
C
C-----------------------------------------------------------------------
c	Values of parameters
	COMMON /CURVE/INX,C1RX,C2RX,RMIN,RMAX,CL1R
c
c	INX=1 IN8 , INX=0 others instruments
C	C1RX C2RX constants values to calculate RM on all instruments
C	RMIN, RMAX min max on RNM 
C	CL1R constant value to calculate LM for IN8
c
C-----------------------------------------------------------------------
        PARAMETER (PI=3.14159265358979323846264338327950E0)
        PARAMETER(RD=57.29577951308232087679815481410517E0)
        PARAMETER (EPS1=1.D-1)
C-----------------------------------------------------------------------
C       PASSED PARAMETERS
	DOUBLE PRECISION DX,AKX,AX1,AX2,ALX,RX
C-----------------------------------------------------------------------
C       LOCAL VAR
	DOUBLE PRECISION ARG,DC1RX,DC2RX,DRMIN,DRMAX,DCL1R
C-----------------------------------------------------------------------
C       INIT AND TEST
C
	IER=0
	DC1RX=C1RX
	DC2RX=C2RX
	DRMIN=RMIN
	DRMAX=RMAX
	DCL1R=CL1R
        IF(DX.LT.EPS1) IER=1
        IF(AKX.LT.EPS1) IER=2
        ARG=PI/(DX*AKX)
        IF(ABS(ARG).GT.1.0) IER=3
        IF (IER.NE.0) GOTO 999
C-----------------------------------------------------------------------
C       CALCULATION OF THE TWO ANGLES
C
        AX1=ASIN(ARG)*ISX*RD
        AX2=2.0D0*AX1
C-----------------------------------------------------------------------
C        CALCULATION OF MONO CURVATURE RM OR ANALYSER CURVATURE RA
C       STANDARD LAW IS  C1RX+C2RX/SIN(A1/RD)
C       C1RX AND C2RX ARE CONSTANTS DEPENDING ON MONO AND MACHINES
C
C        C1RX=.47
C        C2RX=.244
C        RMIN=0.
C       RMAX=20.
C	IN1/IN3/IN12/IN14/IN20 CASE
	if (inx.EQ.0) then
		RX=DMIN1(DMAX1(DC1RX+DC2RX/SIN(ABS(AX1)/RD),DRMIN),DRMAX)
	else
C	IN8 CASE 
		ALX=(DCL1R/SIN(AX2/RD))*COS(AX2/RD)
		RX=DC2RX*SQRT(SIN(AX2/RD))-DC1RX
	ENDIF
C-----------------------------------------------------------------------
999     CONTINUE
        RETURN
        END
C=========================================================================
        SUBROUTINE SAM_CASE(QT,QM,QS,AKI,AKF,AX3,AX4,ISS,IER)
C-----------------------------------------------------------------------
C               DEAL WITH SAMPLE ANGLES CALCULATION FROM Q VERTOR IN C-N PLANE
C       CALCULATE A3 AND A4
C       INPUT
C       QT      Q-VECTOR IN SCATTERING PLANE
C       QM,QS   Q MODULUS AND QMODULUS SQUARED
C       AKI,AKF MOMEMTA ON MONO AND ANYLSER
C       ISS             SENS OF SCATTERING ON SAMPLE
C
C       OUTPUT
C       AX3 AX4         ANGLES ON SAMPLES
C       IER SAME ERROR AS RL2SPV
C       IER
C        1       ' MATRIX S NOT OK',
C        2       ' Q NOT IN SCATTERING PLANE',
C        3       ' Q MODULUS TOO SMALL',
C        4       ' Q MODULUS TOO BIG',
C-----------------------------------------------------------------------
        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
        PARAMETER(RD=57.29577951308232087679815481410517E0)
        PARAMETER (EPS3=1.D-3,EPS6=1.D-6)
C-----------------------------------------------------------------------
C       PASSED PARAMETERS
        DIMENSION QT(3)
C-----------------------------------------------------------------------
C       INIT AND TEST
C
        IER=0
        IF ((ABS(QS).LT.EPS6).OR.(ABS(QM).LT.EPS3)) THEN
                IER=3
                GOTO 999
        ENDIF
C-----------------------------------------------------------------------
C       CALCULATE A3 AND MOVE IT INTHE -180 ,+180 INTERVAL
C
        ARG = (AKI**2 + AKF**2 - QS)/(2.D0*AKI*AKF)
        IF(ABS(ARG).GT.1.D0)THEN
                IER=4
                GOTO 999
        ELSE
                AX4 = ACOS(ARG)*ISS*RD
        ENDIF
        AX3=(-ATAN2(QT(2),QT(1))-ACOS((AKF**2-QS-AKI**2)/
     1       (-2.D0*QM*AKI))*DSIGN(1.D0,AX4))*RD
        sax3=Dsign(1.D0,ax3)
        AX3=DMOD(AX3+sax3*180.D0,360.D0)-sax3*180.D0
C
C       IF(LPLATE) AX3=-ATAN(SIN(AX4/RD)/(LSA*TAN(AX5/RD)/(ALMS*C
C       1       TAN(AX1/RD))*(AKI/KF)**2-COS(AX4/RD)))*RD       !PLATE FOCALIZATION OPTION
C       IF(AXX3.GT.180.D0) AX3=AX3-360.D0
C       IF( A3.LT.-180.D0) AX3=AX3+360.D0
C       IF(LPLATE.AND.A3.GT.0.0) AX3=AX3-180
CC-----------------------------------------------------------------------
999     CONTINUE
        RETURN
        END
C============================================================================
        SUBROUTINE HELM_CASE(HX,HY,HZ,T_IH,C_IH,AKI,AKF,A4,QM,HELM,IER)
C-----------------------------------------------------------------------
C               DEAL WITH HELMOTZ COIL FIELD CALCULATIONS
C       CALCULATE HX HY HZ
C-----------------------------------------------------------------------
        PARAMETER (PI=3.14159265358979323846264338327950E0)
        PARAMETER(RD=57.29577951308232087679815481410517E0)
        PARAMETER (EPS4=1.D-4)
C-----------------------------------------------------------------------
C       PASSED PARAMETERS
        DIMENSION T_IH(8),C_IH(4)
	REAL*8 A4
C-----------------------------------------------------------------------
C       INIT AND TEST
C
        IER=1
        IF (ABS(QM).LT.EPS4) goto 999
	IER=0
        DO IC=1,4
                IF (C_IH(IC).LT.EPS4) IER=2
        ENDDO
        IF (IER.NE.0) GOTO 999
C-----------------------------------------------------------------------
C       CALCULATE MODULE AND ANGLES OF IN PLANE FIELD H
C       PHI                     !ANGLE BETWEEN Q AND KI
C       HRAD            !RADIAL COMP. OF H
C       HDIR            !DIRECTION OF H (IN RADIANS)
C       HDIR2           !ANGLE BETWEEN FIELD AND AXE OF COIL 1
C
        QPAR=AKI-AKF*COS(A4/RD)
        QPERP=AKF*SIN(A4/RD)
        PHI=ATAN2(QPAR,QPERP)
        HRAD=SQRT(HX**2+HY**2)
        IF(HRAD.GT.EPS4) HDIR=ATAN2(HY,HX)
        HDIR2=PHI+HDIR+HELM/RD+0.5*PI
C-----------------------------------------------------------------------
C               !CALC CURRENTS
C               !POSITION OF PSP FOR COIL I
C
        DO IC=1,3
	        T_IH(IC+4)=COS(HDIR2+(IC-1)*2.*PI/3.)*HRAD/C_IH(IC)/1.5
        ENDDO
        T_IH(8)=HZ/C_IH(4)
C-----------------------------------------------------------------------
999     CONTINUE
        RETURN
        END
        SUBROUTINE FLIP_CASE(IF1,IF2,T_IH,F1V,F1H,F2V,F2H,AKI,AKF,IER)
C-----------------------------------------------------------------------
C               DEAL WITH FLIPPER COIL  CALCULATIONS
C       CALCULATE P_IF CURRENTS FOR THE TWO FLIPPERS
C-----------------------------------------------------------------------
C       PASSED PARAMETERS
        DIMENSION T_IH(8)
C-----------------------------------------------------------------------
C       INIT AND TEST
C
        IER=0
C-----------------------------------------------------------------------
C
        IF (IF1.EQ.1) THEN
                T_IH(1)=F1V
                T_IH(2)=AKI*F1H
        ELSE
                T_IH(1)=0.
                T_IH(2)=0.
        ENDIF
        IF (IF2.EQ.1) THEN
                T_IH(3)=F2V
                T_IH(4)=AKF*F2H
        ELSE
                T_IH(3)=0.
                T_IH(4)=0.
        ENDIF
C-----------------------------------------------------------------------
999     CONTINUE
        RETURN
        END
		
