*//////////////////////////////////////////////////////////////////*
      SUBROUTINE Dms30(NSH,IOS,Ipc,Lin,NA,NB,MMA,NL,NP,Mr,
     *            MLN,LK,MI,Z1,Z2,RZ,
     *           P0,DP,ZF,EPS, RP,AHF,BHF,AA,BB,UU,VV,WW,WC,CX,CN,
     *           RR,X,XC,PP,PQV,QQ,Z,XT,PT,QX,Wep,Wrk)
*  -  -------------------------------------------------------------*
      IMPLICIT    REAL*8 (A-H,O-Z)
      DIMENSION   MLN(3,*),LK(*),MI(*),
     *   RP(*),AHF(NSH),BHF(NSH), AA(NA,MMA),BB(NA,MMA),UU(NA,*),
     *   VV(NA,MMA),WW(NA,NA),WC(NA,NA),CX(NA,3),CN(*), RR(NB,*),
     *  X(NB,*),XC(NB,*),PP(*),PQV(NB,*),QQ(*),Z(*),XT(NB,*),PT(*),
     *   CX1(50),B(4),G(50),DD(425), BZ(5),
     *   LC(10),AMC(150),AMS(150),AMP(150),PHA(150),
     *    QX(NB,*), Wep(*),Wrk(*)
* === =============================================================*

      NA1=NA+1
c      IF(MI(2).EQ.1)
c     *  CALL HAFE1(NA1,NB,HB,RP,RR)
      IF(MI(2).EQ.0)
     *  CALL Cotr0(NA1,NB,HB,RP,RR)
      CALL HAFA0(NA,NB,MMA,RP(1),HA,RR,AA,BB,UU,VV,G,BZ)
       HMA=RR(NA+2,1)-RR(NA+1,1)
       HMI=RR(NB,1)-RR(NB-1,1)
       WRITE(10,*) ' W. Parameter Mr = ',Mr
      WRITE(10,500) Z1,Z2,RZ,NSH
      DO 10 I=1,NSH
   10    WRITE(10,505) I,(MLN(J,I),J=1,3)
      WRITE(10,510)
         WRITE(10,515) (AHF(J),J=1,NSH)
         WRITE(10,520) (BHF(J),J=1,NSH)
      WRITE(10,525) RP(2),NB,RP(1),NA,HMA,HMI,EPS
      CALL VEVR(NA*NA,UU,WW)
      CALL INVM(NA,DET,WW)
      KD=2
      IF(DABS(Z1-Z2).GT.1.D-05) KD=1
      RZ2=RZ*RZ/2.D 00
      RZ3=RZ2*RZ/4.D 00
      AS=RZ*(Z1+Z2)
      AD=RZ*(Z2-Z1)
      IF(DABS(AD).GT.1.D-05) KD=1
       WRITE(10,530) MLN(1,NSH)
       WRITE(11,535) NP,(MLN(I,NSH),I=1,3)
  535  FORMAT( I5/3I4)
      DO 20 IP=1,NP
         IF(MI(1).EQ.0) THEN
           PI=P0+DP*(IP-1)
           EI=PI**2/2.D 00
         ELSE
           EI=P0+DP*(IP-1)
           PI=DSQRT(2.D 00*EI)
         END IF
         LC(1)=LK(NSH)
        Lm=NL
        IF(Mi(3).NE.0) Lm=Mi(3)
         DO 25 IL=2,Lm
   25       LC(IL)=LC(IL-1)+MLN(3,NSH)
         NX=MLN(3,NSH)

         NX0=MLN(3,NSH)*NB*Lm
         CALL VEQC(NX0,0.D 00,X(1,LC(1)))
         NT=47
         NLi=0
         IF(Lin.NE.0) THEN
           IF(Mi(3).EQ.0) THEN
             CALL REWFC(NB,NLi,NXi,Eii,AMC,AMS, X(1,Lc(1)),12)
               ELSE
               Ia=1+Nx*(Lin-1)
               CALL REWFC(NB,NLi,NXi,Eii,
     *                    AMC(Ia),AMS(Ia), X(1,Lc(Lin)),12)
               END IF
           IF(DABS(Ei-Eii).GT.1.D-06) STOP
           END IF
c         write(10,*) ' mi3 0',Mi(3)
       CALL Dhfci3(NSH,IOS,Ipc,NA,NB,NX,KD,NL,NLi,
     *       Mi(3),Mr,NT,MLN,LK,LC,
     *       ZF,EI,HA,HB,AS,AD,RZ,RZ2,RZ3,
     *       AMC,AMS,AMP,PHA, AHF,BHF, AA,BB,VV,UU,WW, G,B,BZ,
     *       RR,X,XC,CN,CX,WC,DD,CX1, PQV,PP,QQ,Z,XT,PT,QX,Wep,Wrk)

      Li=1
      IF(Mi(3).NE.0) Li=Mi(3)-NL+1
      Ia=1
      IF(Mi(3).NE.0) Ia=1+Nx*(Li-1)
      Lii=MLN(2,NSH)+Kd*(Li-1)
      CALL Wrfc3(NB,NL,NX,Li,EI,AMC(Ia),AMS(Ia),X(1,LC(Li)),11)
      CALL Outc3(NX,NL,Lii,MLN(2,NSH),KD,PI,EI,
     *           AMS(Ia),AMC(Ia),AMP(Ia),PHA(Ia))
   20       CONTINUE
  500 FORMAT( 20X' DIATOMIC MOLECULE'/15X,
     *    ' HARTREE-FORK WAVE FUNCTIONS',/18X,
     *    '     FROZEN CORE      ',//
     *    ' NUCLEI CHARGES:       Z1 =',
     *      F6.3/23X,'Z2 =',F6.3//
     *    ' INTERNUCLEI DISTANCE: RZ  =',F7.4/
     *    ' NUMBER OF THE SHELLS: NSH =',I3//
     *    ' IDENTIFICATION OF THE SHELLS :'//
     *    5X,'N SHELL    M    L0   N OF P.W.'/)
  505 FORMAT(4X,I4,3X,3(I6))
  510 FORMAT(/' HARTREE-FOCK COEFFICIENTS:')
  515 FORMAT(/' A(*)',3E15.5/,2(10X,3E15.5/))
  520 FORMAT(/' B(*)',3E15.5/,2(10X,3E15.5/))
  525 FORMAT(//' INTEGRATION UP TO',10X,'RB =',F7.2/
     *    ' NO. INTEGRATION POINTS     NB =',I5//
     *    ' ANALITICAL APPROXIMATION :'/
     *    ' UP TO',20X,'  RA =',F9.3/
     *    ' WITH NUMBER OF POINTS      NA =',I5/
     *    '   H max = ', E10.2/'   H min = ', E10.2/
     *    '   ACCURACY   '10X'    EPS=',E10.2/60('=')/7X,
     *    ' R E S U L T S :'//)
  530 FORMAT( 3X,' CONTINUUM W.F.  M = ',I2//'    P      E,',
     *  'au   L   S.G.   A*COS(P)  A*SIN(P)     A      PHASE')
      END