subroutine ffmec(q2f2,ff1,ff2,ff3,ff4,n) c************************************************************************** c * c this subroutine calculates the charge and magnetic form factors of * c he-3 and h-3 using the impulse approximation of hadjimichael et. al. * c (phys rev c vol 27, no.2, p831, feb 1983). * c * c************************************************************************** c****************************************************************************** c * c up dated on sept 9, 1984 to enable the calculation of the form factors * c from hadjimicheal et al. using the total charge, and magnetic form factors * c * c****************************************************************************** implicit real*8 (a-h,o-z) real*8 lpt dimension formfs(4,20),y(4),q2hadj(20) dimension form1(20),form2(20),form3(20),form4(20) dimension ftot1(20),ftot2(20),ftot3(20),ftot4(20) dimension fhadj(4),a2(4) dimension a2tot(4) c c data q2hadj/ 0.0, 0.25, 1.0, 2.25, 4.0, 6.25, 9.0, 12.25, 16.0, 1 20.25, 25.0, 30.25, 36.0, 42.25, 49.0, 56.25, 2 64.0, 72.25, 81.0, 90.25/ c data a2/ 39.474, 3.012, 16.667, 18.204/ c data a2tot/28.667, 21.928, 26.864, 83.324/ c data form1/1.0,0.865,0.571,0.308,0.141,0.552d-01,0.174d-01, 10.332d-02,-0.919d-03,-0.150d-02,-0.112d-02,-0.673d-03,-0.349d-03, 2-0.162d-03,-0.659d-04,-0.233d-4,-0.445d-05,0.133d-05,0.251d-05, 30.203d-5/ c data form2/1.0,0.868,0.604,0.347,0.170,0.719d-1,0.252d-01, a 0.612d-02, 1-0.294d-03,-0.171d-02,-0.152d-02,-0.102d-02,-0.595d-03, 2-0.316d-03,-0.154d-03,-0.696d-04,-0.285d-04,-0.101d-04,-0.261d-05, 3-0.691d-06/ c data form3/1.0,0.843,0.522,0.246,0.873d-01,0.163d-01,-0.719d-02, 1-0.107d-01,-0.818d-02,-0.494d-02,-0.257d-02,-0.116d-02,-0.419d-03, 2-0.826d-04,0.480d-04,0.798d-04,0.735d-04,0.554d-04,0.379d-04, 30.241d-04/ c data form4/1.0,0.861,0.566,0.298,0.130,0.462d-01,0.113d-01, a-0.313d-03, 1-0.274d-02,-0.232d-02,-0.143d-02,-0.740d-03,-0.321d-03,-0.107d-03, 2-0.104d-04,0.233d-04,0.296d-04,0.253d-04,0.188d-04,0.125d-04/ c data ftot1/1.0,0.849,0.556,0.294,0.129,0.445d-01,0.890d-02, a-0.276d-02,-0.480d-02,-0.376d-02,-0.232d-02,-0.123d-02, b-0.549d-03,-0.185d-03,-0.124d-04,0.532d-04,0.679d-04, c0.608d-04,0.475d-04,0.344d-04/ c data ftot2/1.0,0.868,0.604,0.347,0.169,0.705d-01,0.236d-01, a0.462d-02,-0.162d-02,-0.279d-02,-0.235d-02,-0.163d-02, b-0.102d-02,-0.611d-03,-0.355d-03,-0.206d-03,-0.121d-03, c-0.735d-04,-0.462d-04,-0.303d-04/ c data ftot3/1.0,0.863,0.576,0.317,0.151,0.625d-01, a0.221d-01,0.587d-02,0.358d-03,-0.990d-03,-0.975d-03, b-0.665d-03,-0.376d-03,-0.183d-03,-0.711d-04,-0.153d-04, c0.840d-05,0.148d-04,0.138d-04,0.978d-05/ c data ftot4/1.0,0.874,0.599,0.345,0.172,0.770d-01, a0.307d-01,0.108d-01,0.301d-02,0.349d-03,-0.343d-03, b-0.401d-03,-0.287d-03,-0.171d-03,-0.882d-04,-0.390d-04, c-0.132d-04,-0.160d-05,0.247d-05,0.276d-05/ c c c************************************************************************** c * c if q2f2 outside of table then extrapolate with * c * c f(q2) = f(q02)exp -(q2-q02)/a2 * c * c where f(q02) = last point in hadjimichaels table (ie. q02=90.25 or * c q = 9.5) * c * c************************************************************************** c c if (n .eq. 2) go to 10 do 70 j=1,20 formfs(1,j) = form1(j) formfs(2,j) = form2(j) formfs(3,j) = form3(j) formfs(4,j) = form4(j) 70 continue go to 15 10 continue do 75 j=1,20 formfs(1,j) = ftot1(j) formfs(2,j) = ftot2(j) formfs(3,j) = ftot3(j) formfs(4,j) = ftot4(j) 75 continue 15 continue if (q2f2 .lt. 90.25) go to 40 lpt = 90.25 if (n .eq.2) go to 25 do 20 i=1,4 q2a2 = (q2f2-lpt)/a2(i) if (q2a2 .gt. 150.) q2a2 = 150. fhadj(i) = formfs(i,20)*exp(-q2a2) 20 continue go to 30 25 continue do 26 i=1,4 q2a2 =(q2f2-lpt)/a2tot(i) if (q2a2 .gt. 150.) q2a2 = 150. fhadj(i) = formfs(i,20)*exp(-q2a2) 26 continue 30 continue ff1 = fhadj(1) ff2 = fhadj(2) ff3 = fhadj(3) ff4 = fhadj(4) return 40 continue if ((q2f2 .gt. 81.0) .or. (q2f2 .lt. 0.25)) go to 50 c c c************************************************************************* c * c for q2f2 less than 81.0 use four point lagrangian interpolation. * c * c************************************************************************* c c call lagrng(q2f2,q2hadj,y,formfs,20,4,4,20,4) ff1 = y(1) ff2 = y(2) ff3 = y(3) ff4 = y(4) return c c 50 continue c c c************************************************************************** c * c for q2f2 less than 90.25 but greater than 81.0 must use 2-point * c lagrangian interpolation since in between the last two data points * c of table. * c * c************************************************************************** c c call lagrng(q2f2,q2hadj,y,formfs,20,4,2,20,4) ff1 = y(1) ff2 = y(2) ff3 = y(3) ff4 = y(4) return end