51 lines
1.9 KiB
Fortran
51 lines
1.9 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Convert Euler angles to Kappa (IEK = 0) or vice-versa (IEK = 1)
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE EULKAP (IEK,OME,CHE,PHE,OMK,RKA,PHK,ISTTUS)
|
|
COMMON /CADCON/ ALPHA,APMIN,APMAX,MAXVAR,MINVAR,
|
|
$ IHOLE,IVSLIT,IHSLIT,INEG45,IPOS45,IUPHAF,ILOHAF,
|
|
$ VUTHT,VUOME,VUCHI,VUPHI,IPORT,IBAUD
|
|
PARAMETER (RA = 57.2958)
|
|
C ALPHA = 49.98907
|
|
C ALPHA = ALPHA/RA
|
|
SALPHA = SIN(ALPHA/RA)
|
|
CALPHA = COS(ALPHA/RA)
|
|
ISTTUS = 0
|
|
C-----------------------------------------------------------------------
|
|
C IEK = 0 Euler to Kappa
|
|
C-----------------------------------------------------------------------
|
|
IF (IEK .EQ. 0) THEN
|
|
SCO2 = SIN(ONE80(CHE)/(2.0*RA))
|
|
BOT = SALPHA*SALPHA - SCO2*SCO2
|
|
IF (BOT .LE. 0.0) THEN
|
|
ISTTUS = 1
|
|
RETURN
|
|
ENDIF
|
|
RKAO2 = ATAN(SCO2/SQRT(BOT))
|
|
RKA = ONE80(2.0*RA*RKAO2)
|
|
DELTA = RA*ATAN(CALPHA*SIN(RKAO2)/COS(RKAO2))
|
|
OMK = ONE80(OME - DELTA)
|
|
PHK = ONE80(PHE - DELTA)
|
|
C-----------------------------------------------------------------------
|
|
C IEK = 1 Kappa to Euler
|
|
C-----------------------------------------------------------------------
|
|
ELSE
|
|
RKAO2 = RKA/(2.0*RA)
|
|
CHE = ONE80(2.0*RA*ASIN(SALPHA*SIN(RKAO2)))
|
|
DELTA = RA*ATAN(CALPHA*SIN(RKAO2)/COS(RKAO2))
|
|
OME = ONE80(OMK + DELTA)
|
|
PHE = ONE80(PHK + DELTA)
|
|
ENDIF
|
|
RETURN
|
|
END
|
|
C-----------------------------------------------------------------------
|
|
C Function to put angles in the range -180 to 180
|
|
C-----------------------------------------------------------------------
|
|
REAL FUNCTION ONE80 (X)
|
|
XX = X
|
|
IF (X .LT. -180.00) XX = X + 360.00
|
|
IF (X .GT. 180.00) XX = X - 360.00
|
|
ONE80 = XX
|
|
RETURN
|
|
END
|