SUBROUTINE NH3$DB
C
C     VINIT/VSTAR/VSTAR1/VSTAR2 ROUTINE FOR
C       NH3-HE POTL OF DAVIS & BOGGS -- COUNTERPOISE SCF, BASIS 1.
C     LINEAR INTERPOLATION ON LOG(V(R))
C       WITH EXTRAPOLATION TO LEFT AND RIGHT.
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      SAVE A,B
      CHARACTER*4 LM
      DIMENSION S(12),A(12,5),B(12,5),V(6,12),LM(12)
      DATA RMIN/3.D0/, DR/1.D0/
      DATA V/ 94199.5, 15307.8, 2221.7, 278.5, 27.1, 0.9,
     A        12316.1,  2270.8,  392.4,  62.8, 11.5, 2.2,
     B        13659.0,  1531.8,  133.8,  12.3,  4.7, 1.5,
     C        16572.8,  2446.2,  377.6,  53.7,  6.2, 0.3,
     D        18296.9,  2815.3,  422.2,  56.3,  6.7, 0.7,
     E            1.0,    11.5,  15.4,    2.7,  0.4, 0.04,
     F        8168.8,   1174.8, 173.2,   23.2,  2.6, 0.3,
     G        4190.4,    398.8,  55.7,    7.1,  0.8, 0.1,
     H         397.0,     73.4,   7.9,    0.7,  0.1, 0.01,
     I        1930.0,    150.7,  20.3,    2.6,  0.4, 0.04,
     J        2961.1,    258.9,  31.9,    3.7,  0.3, 0.03,
     K        2454.3,    206.1,  26.9,    3.4,  0.3, 0.1 /
C     N.B. V(40,R=3.)  IS SET TO A SMALL NUMBER TO AVOID SIGN CHANGE.
C          ALSO, R=8. VALUES GIVEN AS 0.0 SET TO 0.1*R=7. VALUE.
      DATA S/1., -1., -1., 1., 1., -1., -1., -1., -1., 1., 1., 1./
      DATA LM/' 00 ',' 10 ',' 20 ',' 30',' 33 ',' 40 ',' 43 ',' 50 ',
     1        ' 53 ',' 60 ',' 63 ',' 66 '/
C
      DATA   RM/0.529177D0/, EPSIL/1.D0/
C
C     *************************************************************
C
      ENTRY VINIT(I,RMX,EPSILX)
C
      IF (I.GT.0 .AND. I.LE.12)  GO TO 1000
      WRITE(6,699) I
  699 FORMAT('0 * * * ERROR.  NH3$DB NOT IMPLEMENTED FOR SYMMETRY',I4)
      RETURN
C
 1000 WRITE(6,601) I,LM(I),S(I),(V(IR,I),IR=1,6)
  601 FORMAT('0 INITIALIZATION FOR SYMMETRY',I3,' L,M =',A4,10X,
     & 'SIGN =',F4.1/ '0 V(IR) =',6F12.2)
      DO 1001 IN=1,5
      A(I,IN)=DLOG(V(IN+1,I)/V(IN,I))/DR
      B(I,IN)=DLOG(V(IN+1,I))-A(I,IN)*(RMIN+DFLOAT(IN)*DR)
 1001 WRITE(6,602) IN,A(I,IN),B(I,IN)
  602 FORMAT(' FOR INTERVAL',I4,'    A,  B  =',2D16.6)
C
      RMX=RM
      EPSILX=EPSIL
      RETURN
C     ***************************************************************
C
      ENTRY VSTAR(I,R,VV)
C
C     DETERMINE INTERVAL
      IN=(R-RMIN+1.D0)/DR
      IN=MIN0(5,MAX0(1,IN))
      VV=S(I)*DEXP(A(I,IN)*R+B(I,IN))
      RETURN
C     ***************************************************************
C
      ENTRY VSTAR1(I,R,VV)
C
      IN=(R-RMIN+1.D0)/DR
      IN=MIN0(5,MAX0(1,IN))
      VV=S(I)*A(I,IN)*DEXP(A(I,IN)*R+B(I,IN))
      RETURN
C     ***************************************************************
C
      ENTRY VSTAR2(I,R,VV)
C
      IN=(R-RMIN+1.D0)/DR
      IN=MIN0(5,MAX0(1,IN))
      VV=S(I)*A(I,IN)*A(I,IN)*DEXP(A(I,IN)*R+B(I,IN))
      RETURN
      END