SUBROUTINE POTV(V,R1,R2,XCOS)
C
C     TRANSFORM GENERALISED COORDINATES TO THOSE FOR PARTICULAR
C     SYSTEM. THIS VERSION TRANSFORMS TO AB2 BONDLENGTH-BONDANGLE
C     COORDINATES. ALLOWANCE MUST BE MADE FOR THE NUMBERING OF THE ATOMS
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON /MASS/ XMASS(3),G1,G2
C
C     (R = r . S = r'. T = theta)
C
      DATA X1/1.0D0/,X0/0.0D0/,TINY/9.0D-15/,X2/2.0D0/
C
      IF (G1 .EQ. X0) THEN
C        BONDLENGTH BONDANGLE COORDINATES: ATOM 1 = ATOM 2
         Q1 = R1
         Q2 = R2
         Q3= SQRT(R1*R1 + R2*R2 - X2*R1*R2*XCOS)
      ELSE IF (G2 .EQ. X0) THEN
C        SCATTERING COORDINATES: ATOM 2 = ATOM 3
         XX = R1 * G1
         YY = R1 * (X1 - G1)
         IF (R2 .EQ. X0 .OR. XCOS .GE. (X1 - TINY)) THEN
            Q1 = ABS(XX - R2)
            Q2 = (YY + R2)
         ELSE IF (XCOS .LE. (TINY - X1)) THEN
            Q1 = (XX + R2)
            Q2 = ABS(YY + R2)
         ELSE
            Q1 = SQRT(XX*XX + R2*R2 - X2*XX*R2*XCOS)
            Q2 = SQRT(YY*YY + R2*R2 + X2*YY*R2*XCOS)
         ENDIF
         Q3 = R1
      ELSE
C        GENERAL COORDINATES (INCLUDING RADAU): ATOM 1 = ATOM 2
         F1= X1/G1
         F2= X1/G2
         F12= X1 - F1*F2
         P1= R1*(X1-F1)/(G2*F12)
         P2= R2*(X1-F2)/(G1*F12)
         S1= R1-P1
         S2= R2-P2
         Q1= SQRT(P1*P1 + S2*S2 + X2*P1*S2*XCOS)/(X1-G1)
         Q2= SQRT(P2*P2 + S1*S1 + X2*P2*S1*XCOS)/(X1-G2)
         Q3= SQRT(P1*P1 + P2*P2 - X2*P1*P2*XCOS)
      ENDIF
C
      CALL POTS(V,Q1,Q2,Q3)
C
      RETURN
      END
      SUBROUTINE POTS(V,P1,P2,P3)
C
C
C     H3+ POTENTIAL IN 7TH ORDER Morse fit to experimental data
C     based on the ab initio potential of:
C     R.Rohse, W.Kutzelnig,R. Jaquet, W.Klopper, in press 1994
C     UNITS: HARTREE & BOHR
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION CV(31),FT(31)
C
      DATA C0/-0.3437932/,RE/1.64990/,BET/1.375D0/,SCALE/1.0D-6/
      DATA CV/470.515270000,-184.029899427,204460.885577941, 
     +        266613.522768892,-48917.741505716,-237964.965221738, 
     +       -5568.202031852,25296.302990000,129419.978315132,
     +        90817.794942890,45401.420236543,-3016.433010000, 
     +       -69658.533482092,-31135.913430000,-30625.569006908, 
     +       -5956.093821706,3898.684790000,62970.706376426, 
     +        56410.934570000,173468.996421390,72815.378480000,  
     +        14948.149880973,-2302.142239145,261.518610000, 
     +        8684.377250000,18148.616200000,42218.523370000, 
     +        117188.562420000,46713.634810000,-2919.820460000,
     +        11942.119720000/ 
      DATA nv/31/
      DATA ZERO/0.0D0/,ONE/1.0D0/,TWO/2.0D0/,THREE/3.0D0/
C     CHECK THAT THE POTENTIAL IS NOT IN A DEEPLY REPULSIVE REGION
c     IF (MIN(P1,P2,P3) .LT. 0.7D0) GOTO 10
C
      SQ3=SQRT(THREE)
      SQ2=SQRT(TWO)
      FACTOR=BET/RE
      DR1 = (P1-RE)
      DR2 = (P2-RE)
      DR3 = (P3-RE)
      Y1=(ONE-EXP(-FACTOR*DR1))/BET
      Y2=(ONE-EXP(-FACTOR*DR2))/BET
      Y3=(ONE-EXP(-FACTOR*DR3))/BET
      S=(Y1+Y2+Y3)/SQ3
      X=(Y3+Y3-Y1-Y2)/(SQ2*SQ3)
      Y=(Y2-Y1)/SQ2
      QUAD=X**2+Y**2
      R=SQRT(QUAD)
      FT(1)=ONE
      FT(2)=S
      FT(4)=QUAD
      FT(7)=X*(X**2-THREE*Y**2)
      FT(11)=FT(4)**2
      FT(16)=FT(4)*FT(7)
      FT(22)=FT(4)**3
      FT(23)=FT(7)**2 - y**2*(y**2-three*x**2)**2
      FT(31)=FT(11)*FT(7)
      FT(30)=S*FT(23)
      M=2
      M1=0
      DO 20 I=1,6
      IF (I .EQ. 6) M1=1
      DO 30 J=1,I
      M=M+1
      FT(M+M1)=FT(M-I)*S
   30 CONTINUE
   20 M=M+1
      V=ZERO
      DO 40 I=1,NV
   40 V=V+CV(I)*FT(I)
C     SCALE AND SHIFT THE ZERO
      V=C0+SCALE*V
      RETURN
C     DUMMY OPTION TO COPE WITH EXPANSION INSTABILITY
   10 V = ZERO
      RETURN
      END