      subroutine rthcvt (rth$,isys,a,b,c,al)                            RTHC001
c ----------------------------------------------------------------------RTHC002
c     converts rhombohedral cell constants to tripled hexagonal         RTHC003
c     and vice versa                                                    RTHC004
c ----------------------------------------------------------------------RTHC005
c     This program module is part of the PhysiSoft X-ray Library        RTHC006
c     and may not be sold or reproduced for commercial purposes.        RTHC007
c     Although it has been tested carefully, there is no warranty       RTHC008
c     regarding accuracy or freedom from side-effects.                  RTHC009
c                   (C) 1986-1990 Bernhard Rupp                         RTHC010
c ----------------------------------------------------------------------RTHC011
                                                                        RTHC012
      character rth$,answ                                               RTHC013
      pi=3.14159265                                                     RTHC014
      degtor=pi/180.0                                                   RTHC015
                                                                        RTHC016
      if (rth$.eq.'R') then                                             RTHC017
c --     rho to hex ---                                                 RTHC018
 7001    write (*,'(/a$)') ' A(rhomb) = '                               RTHC019
         read (*,'(f9.5)',err=7001) ar                                  RTHC020
         write (*,'(/a$)') ' Alpha(rhomb) = '                           RTHC021
         read (*,'(f9.5)',err=7001) alpha                               RTHC022
         sinalh=sin(0.5*degtor*alpha)                                   RTHC023
         ah=2*sinalh*ar                                                 RTHC024
         if (ah.le.0) then                                              RTHC025
            print*,' Crash - your input delivers negative C'            RTHC026
            call inkey (answ)                                           RTHC027
            goto 7001                                                   RTHC028
         end if                                                         RTHC029
         argmnt=(ar**2 - (ah**2)/3.0)                                   RTHC030
         if (argmnt.le.0) then                                          RTHC031
            print*,' Crash - your input delivers MATH SQRT error '      RTHC032
            call inkey (answ)                                           RTHC033
            goto 7001                                                   RTHC034
         end if                                                         RTHC035
         ch=3*sqrt(argmnt)                                              RTHC036
         write(*,'(/,a,f9.5,a,f9.5)') ' A(hex) = ',ah ,', C(hex) = ',ch RTHC037
         a=ah                                                           RTHC038
         b=ah                                                           RTHC039
         c=ch                                                           RTHC040
         al=120.0                                                       RTHC041
         isys=3                                                         RTHC042
         return                                                         RTHC043
      elseif (rth$.eq.'H') then                                         RTHC044
c ---    hex to rho ---                                                 RTHC045
 7002    write (*,'(/a$)') ' A(hex) = '                                 RTHC046
         read (*,'(f9.5)',err=7002) ah                                  RTHC047
         write (*,'(/a$)') ' C(hex) = '                                 RTHC048
         read (*,'(f9.5)',err=7002) ch                                  RTHC049
         argmnt=(ah**2)/3 + (ch**2)/9                                   RTHC050
         if (argmnt.le.0) then                                          RTHC051
            print*,' Crash - your input delivers MATH SQRT error'       RTHC052
            call inkey (answ)                                           RTHC053
            goto 7002                                                   RTHC054
         end if                                                         RTHC055
         ar=sqrt(argmnt)                                                RTHC056
         sinalh=ah/(2*ar)                                               RTHC057
         if (sinalh.le.0.or.sinalh.gt.1.0) then                         RTHC058
            print*,' Crash - your input delivers MATH ASIN error'       RTHC059
            call inkey (answ)                                           RTHC060
            goto 7002                                                   RTHC061
         end if                                                         RTHC062
         alpha=2*asin(sinalh)/degtor                                    RTHC063
         write (*,'(/,a,f9.5,a,f9.5)') 'A(rhomb) = ',ar,                RTHC064
     &              ', Alpha(rhomb) = ',alpha                           RTHC065
         a=ar                                                           RTHC066
         b=ar                                                           RTHC067
         c=ar                                                           RTHC068
         al=alpha                                                       RTHC069
         isys=5                                                         RTHC070
         return                                                         RTHC071
      elseif (rth$.eq.'I') then                                         RTHC072
         sinalh=sin(0.5*degtor*al)                                      RTHC073
         ah=2*sinalh*a                                                  RTHC074
         if (ah.le.0) then                                              RTHC075
            print*,' Crash - your input delivers negative C'            RTHC076
            call inkey (answ)                                           RTHC077
            return                                                      RTHC078
         end if                                                         RTHC079
         argmnt=(a**2 - (ah**2)/3.0)                                    RTHC080
         if (argmnt.le.0) then                                          RTHC081
            print*,' Crash - your input delivers MATH SQRT error '      RTHC082
            call inkey (answ)                                           RTHC083
            return                                                      RTHC084
         end if                                                         RTHC085
         ch=3*sqrt(argmnt)                                              RTHC086
         a=ah                                                           RTHC087
         b=a                                                            RTHC088
         c=ch                                                           RTHC089
         al=120.0                                                       RTHC090
         return                                                         RTHC091
      else                                                              RTHC092
         print*,' Internal error - Task undefined in RTHCVT -- '        RTHC093
         call inkey (answ)                                              RTHC094
      endif                                                             RTHC095
                                                                        RTHC096
      return                                                            RTHC097
      end                                                               RTHC098
                                                                        RTHC099
