c/* %W% latest revision %G% %U% */ subroutine ffmec(q2f2,ff1,ff2,ff3,ff4,n) *************************************************************************** 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 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 *** 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) data q2hadj / 0.00d+0, 0.25d+0, 1.0d+0, 2.25d+0, 4.00d+0, $ 6.25d+0, 9.00d+0, 12.25d+0, 16.00d+0, 20.25d+0, $ 25.00d+0, 30.25d+0, 36.00d+0, 42.25d+0, 49.00d+0, $ 56.25d+0, 64.00d+0, 72.25d+0, 81.00d+0, 90.25d+0 / data a2 /39.474d+0, 3.012d+0, 16.667d+0, 18.204d+0/ data a2tot /28.667d+0, 21.928d+0, 26.864d+0, 83.324d+0/ data form1 / 1.000d+0, 0.865d+00, 0.571d+00, 0.308d+00, $ 0.141d+0, 0.552d-01, 0.174d-01, 0.332d-02, $ -0.919d-03, -0.150d-02, -0.112d-02, -0.673d-03, $ -0.349d-03, -0.162d-03, -0.659d-04, -0.233d-04, $ -0.445d-05, 0.133d-05, 0.251d-05, 0.203d-05 / data form2 / 1.000d+00, 0.868d+00, 0.604d+00, 0.347d+00, $ 0.170d+00, 0.719d-01, 0.252d-01, 0.612d-02, $ -0.294d-03, -0.171d-02, -0.152d-02, -0.102d-02, $ -0.595d-03, -0.316d-03, -0.154d-03, -0.696d-04, $ -0.285d-04, -0.101d-04, -0.261d-05, -0.691d-06 / data form3 / 1.000d+00, 0.843d+00, 0.522d+00, 0.246d+00, $ 0.873d-01, 0.163d-01, -0.719d-02, -0.107d-01, $ -0.818d-02, -0.494d-02, -0.257d-02, -0.116d-02, $ -0.419d-03, -0.826d-04, 0.480d-04, 0.798d-04, $ 0.735d-04, 0.554d-04, 0.379d-04, 0.241d-04 / data form4 / 1.000d+00, 0.861d+00, 0.566d+00, 0.298d+00, $ 0.130d+00, 0.462d-01, 0.113d-01, -0.313d-03, $ -0.274d-02, -0.232d-02, -0.143d-02, -0.740d-03, $ -0.321d-03, -0.107d-03, -0.104d-04, 0.233d-04, $ 0.296d-04, 0.253d-04, 0.188d-04, 0.125d-04 / data ftot1 / 1.000d+00, 0.849d+00, 0.556d+00, 0.294d+00, $ 0.129d+00, 0.445d-01, 0.890d-02, -0.276d-02, $ -0.480d-02, -0.376d-02, -0.232d-02, -0.123d-02, $ -0.549d-03, -0.185d-03, -0.124d-04, 0.532d-04, $ 0.679d-04, 0.608d-04, 0.475d-04, 0.344d-04 / data ftot2 / 1.000d+00, 0.868d+00, 0.604d+00, 0.347d+00, $ 0.169d+00, 0.705d-01, 0.236d-01, 0.462d-02, $ -0.162d-02, -0.279d-02, -0.235d-02, -0.163d-02, $ -0.102d-02, -0.611d-03, -0.355d-03, -0.206d-03, $ -0.121d-03, -0.735d-04, -0.462d-04, -0.303d-04 / data ftot3 / 1.000d+00, 0.863d+00, 0.576d+00, 0.317d+00, $ 0.151d+00, 0.625d-01, 0.221d-01, 0.587d-02, $ 0.358d-03, -0.990d-03, -0.975d-03, -0.665d-03, $ -0.376d-03, -0.183d-03, -0.711d-04, -0.153d-04, $ 0.840d-05, 0.148d-04, 0.138d-04, 0.978d-05 / data ftot4 / 1.000d+00, 0.874d+00, 0.599d+00, 0.345d+00, $ 0.172d+00, 0.770d-01, 0.307d-01, 0.108d-01, $ 0.301d-02, 0.349d-03, -0.343d-03, -0.401d-03, $ -0.287d-03, -0.171d-03, -0.882d-04, -0.390d-04, $ -0.132d-04, -0.160d-05, 0.247d-05, 0.276d-05 / c >>> FIRST EXECUTABLE STATEMENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 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 c *** (ie. q02=90.25 or q = 9.5) 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