COMMON	a, b, c, beta, th1, ths
	REAL	crys(3), frod(3), ten(3), frac(3), orth(3), sear(3), nat(3)
	CHARACTER*3	flag
	
	conv = 45./atan(1.)

	a = 197.17
	b = 127.03
	c = 134.18
	beta = 97.64
	th1 = 20.94
	th2 = 45.

	beta = beta/conv
	th1 = th1/conv
	th2 = th2/conv

	th_orth = beta-2*th2
	th_nat = beta-th1-2*th2
	th_sear = beta-th1-3*th2

	READ (5, 900) flag
900	FORMAT (a)

	DO WHILE (.TRUE.)

1000	  FORMAT (3f10.5, 5x, a)

	  IF (flag .EQ. 'FRA' .or. flag .EQ. 'fra') THEN

	    READ (5, 1000, end=9) frac
	    CALL frac_to_crys (frac, crys)
	    CALL crys_to_frod (crys, frod)
	    CALL frod_to_ten (frod, ten)
	    CALL rotate (frod, orth, th_orth)
	    CALL rotate (frod, nat, th_nat)
	    CALL rotate (frod, sear, th_sear)

	  ELSE IF (flag .EQ. 'CRY' .or. flag .EQ. 'cry') THEN

	    READ (5, 1000, end=9) crys
	    CALL crys_to_frac (crys, frac)
	    CALL crys_to_frod (crys, frod)
	    CALL frod_to_ten (frod, ten)
	    CALL rotate (frod, orth, th_orth)
	    CALL rotate (frod, nat, th_nat)
	    CALL rotate (frod, sear, th_sear)

	  ELSE IF (flag .EQ. 'FRO' .or. flag .EQ. 'fro') THEN

	    READ (5, 1000, end=9) frod
	    CALL frod_to_crys (frod, crys)
	    CALL crys_to_frac (crys, frac)
	    CALL frod_to_ten (frod, ten)
	    CALL rotate (frod, orth, th_orth)
	    CALL rotate (frod, nat, th_nat)
	    CALL rotate (frod, sear, th_sear)

	  ELSE IF (flag .EQ. 'TEN' .or. flag .EQ. 'ten') THEN

	    READ (5, 1000, end=9) ten
	    CALL ten_to_frod (ten, frod)
	    CALL frod_to_crys (frod, crys)
	    CALL crys_to_frac (crys, frac)
	    CALL rotate (frod, orth, th_orth)
	    CALL rotate (frod, nat, th_nat)
	    CALL rotate (frod, sear, th_sear)

	  ELSE IF (flag .EQ. 'ORT' .or. flag .EQ. 'ort') THEN

	    READ (5, 1000, end=9) orth
	    CALL rotate (orth, frod, -th_orth)
	    CALL frod_to_crys (frod, crys)
	    CALL crys_to_frac (crys, frac)
	    CALL frod_to_ten (frod, ten)
	    CALL rotate (frod, nat, th_nat)
	    CALL rotate (frod, sear, th_sear)

	  ELSE IF (flag .EQ. 'NAT' .or. flag .EQ. 'nat') THEN

	    READ (5, 1000, end=9) nat
	    CALL rotate (nat, frod, -th_nat)
	    CALL frod_to_crys (frod, crys)
	    CALL crys_to_frac (crys, frac)
	    CALL frod_to_ten (frod, ten)
	    CALL rotate (frod, orth, th_orth)
	    CALL rotate (frod, sear, th_sear)

	  ELSE IF (flag .EQ. 'SEA' .or. flag .EQ. 'sea') THEN

	    READ (5, 1000, end=9) sear
	    CALL rotate (sear, frod, -th_sear)
	    CALL frod_to_crys (frod, crys)
	    CALL crys_to_frac (crys, frac)
	    CALL frod_to_ten (frod, ten)
	    CALL rotate (frod, orth, th_orth)
	    CALL rotate (frod, nat, th_nat)

	  ELSE
	    stop
	  endIF

	  WRITE (6, 1000) frac, 'FRAC'
	  WRITE (6, 1000) crys, 'CRYS'
	  WRITE (6, 1000) frod, 'FROD'
	  WRITE (6, 1000) ten, 'TEN'
	  WRITE (6, 1000) orth, 'ORTH'
	  WRITE (6, 1000) nat, 'NAT'
	  WRITE (6, 1000) sear, 'SEAR'

	endDO

9	stop
	end

	SUBROUTINE crys_to_frod (crys, frod)

	COMMON	a, b, c, beta, th1, ths
	REAL	matrix(3,3), crys(3), frod(3)

	matrix(1,1) = 1.0
	matrix(1,2) = 0.0
	matrix(1,3) = cos(beta)
	matrix(2,1) = 0.0
	matrix(2,2) = 1.0
	matrix(2,3) = 0.0
	matrix(3,1) = 0.0
	matrix(3,2) = 0.0
	matrix(3,3) = sin(beta)

	DO i=1,3
	  frod(i) = 0.0
	  DO j = 1,3
	    frod(i) = frod(i) + matrix(i,j)*crys(j)
	  endDO
	endDO

	RETURN
	end

	SUBROUTINE frod_to_crys (frod, crys)

	COMMON	a, b, c, beta, th1, ths
	REAL	matrix(3,3), frod(3), crys(3)

	matrix(1,1) = 1.0
	matrix(1,2) = 0.0
	matrix(1,3) = -cos(beta)/sin(beta)
	matrix(2,1) = 0.0
	matrix(2,2) = 1.0
	matrix(2,3) = 0.0
	matrix(3,1) = 0.0
	matrix(3,2) = 0.0
	matrix(3,3) = 1./sin(beta)

	DO i=1,3
	  crys(i) = 0.0
	  DO j = 1,3
	    crys(i) = crys(i) + matrix(i,j)*frod(j)
	  endDO
	endDO

	RETURN
	end

	SUBROUTINE frod_to_ten (frod, ten)

	REAL	frod(3), ten(3)

	ten(1) = frod(3)
	ten(2) = frod(1)
	ten(3) = frod(2)

	RETURN
	end

	SUBROUTINE ten_to_frod (ten, frod)

	REAL	ten(3), frod(3)

	frod(1) = ten(2)
	frod(2) = ten(3)
	frod(3) = ten(1)

	RETURN
	end

	SUBROUTINE rotate (x, rx, ang)

	REAL	matrix(3,3), x(3), rx(3)

	matrix(1,1) = cos(ang)
	matrix(1,2) = 0.0
	matrix(1,3) = sin(ang)
	matrix(2,1) = 0.0
	matrix(2,2) = 1.0
	matrix(2,3) = 0.0
	matrix(3,1) = -sin(ang)
	matrix(3,2) = 0.0
	matrix(3,3) = cos(ang)

	DO i=1,3
	  rx(i) = 0.0
	  DO j = 1,3
	    rx(i) = rx(i) + matrix(i,j)*x(j)
	  endDO
	endDO

	RETURN
	end

	SUBROUTINE frac_to_crys (frac, crys)

	COMMON	a, b, c, beta, th1, ths
	REAL	frac(3), crys(3)

	crys(1) = frac(1)*a
	crys(2) = frac(2)*b
	crys(3) = frac(3)*c

	RETURN
	end

	SUBROUTINE crys_to_frac (crys, frac)

	COMMON	a, b, c, beta, th1, ths
	REAL	crys(3), frac(3)

	frac(1) = crys(1)/a
	frac(2) = crys(2)/b
	frac(3) = crys(3)/c

	RETURN
	end