      SUBROUTINE DIPD(DIPC,R1,R2,XCOS,NU)
C
C     THIS SUBROUTINE USES THE ANALYTICAL FORM OF THE DIPOLE SURFACE GIVEN BY
C     ROESHE ET AL (J. CHEM. PHYS. (1994)) TO
C     CALCULATE THE COMPONENTS OF THE H3+ DIPOLE.
C
C     sd = 0.005

      IMPLICIT real*8 (A-H,O-Y), LOGICAL (Z)
      parameter(ncf=11)
      parameter(nfmax=4)
      DIMENSION D(ncf), DZ(ncf), DX(ncf), R(3), B(3)
      COMMON /LOGIC/ ZEMBED
      COMMON/MASS/ XMASS(3), G1, G2
      DATA BETA/1.3000/, RE/1.6500/
      DATA D/-0.48507, -0.25502, -0.01046, -0.15038, -0.06762, -0.04071,
     *0.00462,  0.00000,  0.00000,  0.00000,  0.00000/

C 
      DATA ONE/1.0D0/, TWO/2.0D0/, THREE/3.0D0/, X0/0.0D0/
C
      SR2= SQRT(TWO)
      SR3= SQRT(THREE)
      SR6= SR2*SR3
      XMASS(1) =  1.007825d0
      XMASS(2) =  XMASS(1)
      XMASS(3) =  XMASS(1)
      G1 = XMASS(2) / (XMASS(2) + XMASS(3))
      G2 = 0.d0
      ZEMBED = .false.
c
      R22= R2*R2
      R1C= R1*G1
      RC2= R1 - R1C
      R1C2= R1C*R1C
      RC22= RC2*RC2
      T2= TWO*R1C*R2*XCOS
      T3= TWO*RC2*R2*XCOS
      R(1)= R1
      R(2)= SQRT(R22 + R1C2 - T2)
      R(3)= SQRT(R22 + RC22 + T3)
      BTOT= X0
      XSIN= SQRT(ONE- XCOS*XCOS)
      XMTOT= X0
      DO 1 M=1,3
      XMTOT= XMTOT + XMASS(M)
      X= R(M)/RE - ONE
      Y= EXP(-BETA*X)
      B(M)= (ONE - Y)/BETA
      BTOT= BTOT + B(M)
1     CONTINUE
      RCM= R2*XMASS(1)/XMTOT
      RCC= R2/THREE
      RDEL= RCM - RCC
      SA= BTOT/SR3
      SZ= (TWO*B(1) - B(2) - B(3))/SR6
      SX= (B(3) - B(2))/SR2
      SZ2= SZ*SZ
      SX2= SX*SX
      SE2= SZ2 + SX2
      SE= SQRT(SE2)
c     
      phi = atan2(SX, SZ)
c     
      npot = X0
      do 100 norder = 1,nfmax
      do 100 n = norder,0,-1
      do 100 k=1,norder-n,1
      if (mod(k,3) .eq. 0) goto 100
      m = norder - k - n
      if (mod(m,2) .ne. 0) goto 100
      npot = npot + 1
      DZ(npot) = SA**n * SE**(m+k) * cos(dble(k) * phi)
      DX(npot) = SA**n * SE**(m+k) * sin(dble(k) * phi)
c      write(7,*)n,m,k
c
100   continue
c
      DIPZ= X0
      DIPX= X0
      DO 3 I=1,ncf
      DIPZ= DIPZ + D(I)*DZ(I)
      DIPX= DIPX + D(I)*DX(I)
3     CONTINUE
C
      DIPZ= DIPZ*R2*SR2/SR3  - RDEL
      DIPX= DIPX*R1/SR2
c
      IF(.NOT.ZEMBED) GOTO 4
      IF(NU.EQ.0) THEN
         DIPC= DIPZ + XCOS*DIPX
      ELSE
         DIPC= DIPX*XSIN
      ENDIF
      GOTO 5
4     CONTINUE
      IF(NU.EQ.0) THEN
         DIPC= -(DIPX + XCOS*DIPZ)
      ELSE
         DIPC= DIPZ*XSIN
      ENDIF
5     CONTINUE
C
      RETURN
      END
