c/* %W%      latest revision %G% %U% */
      subroutine ffhe3 (q2mev,rp,rn,rpsp,rnsp,nfcn,ache,amhe,ach)
************************************************************************

c *** see R.H. Landau's program LPOTT, 1981

c     ffhe3 calculates the four form factors needed to describe he3with
c     (fsd is only calc as a cpmparison, it should be small and is
c     the apptox, or effectove, sd contib to the magnetic ff
c     the ff*s are calc by using
c             1 fche3- expt of 7ccarthy et al for all q2,have fitted
c               2 ff*s calc by m mcmillan,for fcn=0 these fit h3 data
c                of collard and for laegrer q2( gt 6 f-2) they rep a
c               reasonable extrapltn which has a correct zero as he3
c     3 fmhe3 use the form of 7ccarthy et al but vary this since the exh
c     chage contib is included in e scatter, but presmbly not in our pi
c     scatt (nb we use mu he3 = un)
c     these ff include s,s* + d states exactly in f1c,f2c,
c     the d stae is only put in approximatly in f1m,f2m as gibson has
c     shown this to be small (ignore too the dd terms too)
c     nfcn=1 , include neytron form factor in escat data, =0 , don*t
c     data seems best interpeerted woth no neutron ?charge? form factor
c     possibly this is due to polarization or meson exch efects &&
c
c     q2mev2 is in mev**2 not fermi-2
c ***

      implicit real*8 (a-h, o-z)

      data up, un, uhe3  /2.79278d+0, -1.91315d+0, -1.91315d+0/

c >>> FIRST EXECUTABLE STATEMENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

       up = 2.79278d0
       un = -1.91315d0
      q2f2 = q2mev / ( 197.329 ** 2 )
      qf = sqrt( q2f2 )

c *** nucleon ff

      fn = 0.
      fp = 1.
      if ( nfcn .eq. 0 ) call ffpn( q2f2 , fp , fn )
      if ( ( nfcn .ne. 1 ) .AND. ( nfcn .ne. 0 ) ) then
c        write (6 , 40) nfcn
      endif

c *** He3 and H3 charge ff

      fche3 = ffche3( qf )

c *** Use MMM wf*s for H3, this fits Collard (if fn = 0) and is reasnb, e
c *** sp = s* prob, pd = d state prob, these a can be varied

      psp = 0.02
      pd = 0.09
      call FFMMM( q2f2 , f1c , f2c , psp , pd )
      fch3 = ( 2. * fn + fp ) * f1c + ( fp - fn ) * f2c

c *** He3 mag ff

      fmhe3 = ffmhe3( qf )
      go to 30

      ENTRY fhe3gs( q2mev, rp, rn, rpsp, rnsp, nfcn, ache, amhe, ach )
         q2f2 = q2mev / ( 197.32 ** 2 )
         fn = 0.
         fp = 1.

c *** Gaussian form factors

      fche3 = 0.
      rhl = ache * ache * q2f2
      if ( rhl .gt. 150. ) go to 10
      fche3 = exp( -rhl )
 10   fch3 = 0.
      rhl = ach * ach * q2f2
      if ( rhl .ge. 150. ) go to 20
      fch3 = exp( -rhl )
 20   fmhe3 = 0.
      rhl = amhe * amhe * q2f2
      if ( rhl .ge. 150.) go to 30
      fmhe3 = exp( -rhl )
c      write(8,*) 'gaussian'

 30   continue

c ***
c *** direct calc of ff for fcn=0

      rp = fche3 / fp
      rn = fch3 / fp
      rhl = un / ( up + 2. * un ) / fp
      rhl1 = ( fch3 - 4. * fche3 ) / 3.
      rpsp = rhl * ( fmhe3 + rhl1 ) / 2.
      rnsp = rhl * ( 2. * fmhe3 - rhl1 * ( up / un ) )
      return

c ***

 40   format (' ********** neutron form factor switch is strange,nfcn='
     $         , i3 , ' **********',/ )

      end