      Subroutine fmmm (qf2,f1c,f2c,psp,pd)
      Implicit Real*8(a-h,o-z)
c *** see RH Landau, Program lpott, 1981; mods by m sagen
c     fmmm interpolates malcolm mcmillan form factors and forms f1c and
c     f2f from them (based on approx triton wave functns)
c     psp = s prime prob     pd= dstate prob     qf2= q2 in ferm-2
      Dimension q2(18), f3456(4,18), y(4), q20(27), f0(1,27), y0(1)
      Dimension a1(18),a2(18),a3(18),a4(18)
      Common /mmm/ f3456
c     n.b. we must have f3456 same Dimension in block data as here for t
c
      data q2/0.0,0.1,1.1,2.1,3.1,4.1,5.1,6.1,7.1,8.1,9.1,10.1,11.1,12.
     11 ,13.1,14.1,15.1,16.1/
      data q20
     1     /0.,0.3,0.9,1.5,2.1,2.7,3.3,3.9,4.5,5.1,5.7,6.3,6.9,7.5,8.0,
     2  9.0,10.0,11.,12.,13.,14.,15.,16.,17.,18.,19.,20./,f0/
     31.0,0.88124,0.69363,0.55333,0.44569,0.36153,0.29475,0.24114,
     40.19770,0.16221,0.13305,0.10896,0.08897,0.07232,0.605673d-1,
     50.417046d-1,0.276478d-1,0.171613d-1,0.935277d-2,0.35677d-2,
     6-0.679445d-3,-0.375343d-2,-0.592979d-2,-.741903d-2,-0.838265d-2,
     7-0.894523d-2,-0.920333d-2/
c****************************************************************************
c****************************************************************************
c                                                                           *
c  the following data statements were added by m.s. to accomidate the vax's *
c  supposed inability to 'Read' block data.                                 *
c                                                                           *
c****************************************************************************
c****************************************************************************
c
      data a1/
     1  0.0,           0.294322d-01,   0.208823,       0.274661,
     2  0.291498,      0.285677,       0.269357,       0.248563,
     3  0.226397,      0.204474,       0.183614,       0.164207,
     4  0.146402,      0.130215,       0.115587,       0.102426,
     5  0.906173d-01,  0.800462d-01/
      data a2/
     1  2.0,           0.191074e01,    0.127537e01,    0.894039,
     2  0.647425,      0.480273,       0.363230,       0.279278,
     3  0.217938,      0.172452,       0.138314,       0.112430,
     4  0.926325d-01,  0.773725d-01,   0.655261d-01,   0.562674d-01,
     5  0.489832d-01,  0.432135d-01/
      data a3/
     1  0.526184d-01,  0.505840d-01,   0.341021d-01,   0.236391d-01,
     2  0.166030d-01,  0.116959d-01,   0.818813d-02,   0.563686d-02,
     3  0.375893d-02,  0.236579d-02,   0.132789d-02,   0.553974d-03,
     4 -0.215559d-04, -0.446686d-03,  -0.757024d-03,  -0.979299d-03,
     5 -0.113380d-02, -0.123603d-02/
      data a4/
     1  0.0,          -0.256572d-03,  -0.182162d-02,  -0.232969d-02,
     2 -0.237360d-02, -0.221288d-02,  -0.196895d-02,  -0.170076d-02,
     3 -0.143704d-02, -0.119130d-02,  -0.969153d-03,  -0.772119d-03,
     4 -0.599600d-03, -0.449968d-03,  -0.321150d-03,  -0.210971d-03,
     5 -0.117277d-03, -0.380834d-04/
c
c
c************************************************************************
c************************************************************************
c                                                                       *
c  the following statements were added by m.s. to make the above data   *
c  equivalent to the previous block data                                *
c                                                                       *
c************************************************************************
c************************************************************************
c
      Do 900 j=1,18
      f3456(1,j) = a1(j)
      f3456(2,j) = a2(j)
      f3456(3,j) = a3(j)
      f3456(4,j) = a4(j)
 900  Continue
c
c************************************************************************
c
      If (qf2.le.16.1) GoTo 20
      q = Sqrt(qf2)
      If ((0.4111*qf2.lt.150.).and.(1.91*(q-4.4721)**2.lt.150.))
     1 GoTo 10
c     q2 too large for exp, set=0
      f1c = 0.
      f2c = 0.
      Return
c     q2 outside of table, use annaltic forms fitted to last oints
 10   y0(1) = exp(-0.4111*qf2)-0.94722d-2*exp(-1.906*(q-4.4721)**2)
      y0(1) = y0(1)*1.23469
      y(1) = 0.589748*exp(-0.124043*qf2)
      y(2) = 0.325014*exp(-0.125324*qf2)
      y(3) = (1./19.0048)*(exp(-0.4667*qf2)-0.25369d-01*exp(-1.94305*(q-
     14.1833)**2))
      y(4) = -0.831500*exp(-0.587182*qf2)
      GoTo 30
 20   Continue
      If(qf2.lt.0.01)GoTo 40
c     interpolate on form factors,,n.b. may have to cahge this for more
c     accuracy and interpolate on logs of ff and the expeonentiate
      Call lagrng (qf2,q2,y,f3456,18,4,2,18,4)
      Call lagrng (qf2,q20,y0,f0,27,1,2,27,1)
 30   ps = 1.-psp-pd
      f1c = ps*y0(1)+0.5*psp*y(2)+19.0048*pd*y(3)
      f2c = Sqrt(psp*ps)*y(1)+19.0048*pd*y(4)
c     Write(6,900) qf2,y0(1),y(1),y(2),y(3),y(4),f1c,f2c
c     900 format(" ", f10.3,7e15.5)
      Return
c     q2 lt 1st point, set f= 1,0
 40   f1c=1.
      f2c=0.
      Return
c**  this Program valid on ftn4 and ftn5 **
      End
