*--------------------------------------------------------------------- program interactive_data_set_create *--------------------------------------------------------------------- * JAT Jan 2005 [Version zzzz] Incorporates JLM potential as option * and can read BAB HF matter densities or other external file. * MSU/Betty Tsang July 2004 visit - for above. *--------------------------------------------------------------------- * Revised March 2005 to include n and p densities in determining * alpha (isovector) rather than (N-Z)/A. * Modified: FSU (Kemper/Roeder) to (d,n) and (n,d) ('05) * Modified: MSU (Tsang) to include (3He,d) (June '05) * front5z.f is the front end - as per normal - but, if Vso=/0, * then this version requests input also for the bound state * potential's spin-orbit geometry (at the end). You thus * can produce data sets with a specified rso and and aso * that are different to the central r0 and a0 - as previous. * * Numbering of reactions has reverted to earlier conventions * for (p,d) and (d,p) to allow earlier data set usage - MSU 2005 *--------------------------------------------------------------------- * Version 6z - allows negative ireac values, for rotation * of amplitudes and then m-dependent cross sections - WNC 2006 *--------------------------------------------------------------------- * Version 7z - uses the Bauge JLM parameterisation - BT 2006 *--------------------------------------------------------------------- * Version 8z - has option to read the Sao Paulo potential for 3He * Helio Dias and Betty Tsang - got postponed until early 2008 * Requires no changes to twofnr itself so can use twofnr7.f * Also a number of additional input error traps - courtesy of * United Flight 929 - 15 March 2008 *--------------------------------------------------------------------- * Version 9z: Having found an old code for the Watanabe and finite * range adiabatic potentials from the Reid soft core potential * and deuteron - these options have been introduced - March 2008. *--------------------------------------------------------------------- * Version 10: Includes the triton global potential of Li et al. * For Jeff Thomas (Surrey) April/May 2009 and also corrections to * the Bauge JLM parameterisation (due to exchange with Pang and * he with Bauge, January 2011 - e-mail records these changes) *--------------------------------------------------------------------- * Version 11: James Benstead (Surrey/AWE)/JAT. Version includes * (p,t) and (t,p) reactions as di-neutron transfer - May 2011. *--------------------------------------------------------------------- * Version 12: Global A=3 potential GDP08 -- Pang et al. Jan 2012 *--------------------------------------------------------------------- * Version 13: Has (3He,alpha) option added. April 2012 * Includes a global apha-potential of Atzrott/Kumar (RIPL). *--------------------------------------------------------------------- * Version 14 just maintains counter with twofnr - no changes *--------------------------------------------------------------------- * Version 15: Has option to output the distorted waves - this uses * twofnr version 15 - and also outputs the partial wave S-matrices * This front has choice of deuteron wave functions for FR folding * and Johnson-Tandy adiabatic deuteron distorting potentials and * includes the smaller additional terms in the folding expressions * Potentials and wave functions output to folded and deutwf: 2014 *--------------------------------------------------------------------- * Koning-Delaroche global potential added as option for nucleon * potentials and adiabatic (from KD02 code, 2014) * Two different imaginary part shapes so potential is written. An * imaginary spin-orbit potential is included in the adiabatic * potential calculation for when needed - this very small in KD02. * * Liang et al. 3He Global potential added. Two different imaginary * part shapes so real and imaginary potentials are written (Pang) *--------------------------------------------------------------------- * Version 16: Changes for better structured reading wave functions * Version 17: Option to read deuteron partial waves with rank-2 * tensor structure included - June 2015 *--------------------------------------------------------------------- * Version 18: The D0 and LEA ranges for different deuteron wave * functions (RSC and AV18 wave function) choices are improved and * some tidying up is done, e.g. if negative separation energy is * encountered and the writing of files with jm-substatates sigma *--------------------------------------------------------------------- * Version 19: (3He,n) and (n,3He) options added - 9/2015 * and also (3He,p) and (p,3He) - for JJV-D - January 2016 * and also (t,alpha) - for JC - February 2017 *--------------------------------------------------------------------- * Version 20: allows a radial sensitivity analysis for all cases. * Sensitivity test choice is signalled by a value of ktout(10)=8. * The bound state formfactor is set to zero beyond a given r_max * (if r_max positive) or for r < r_max (if r_max is negative). * r_max read into twofnr from fort.82 - March 2017 at TIT. *--------------------------------------------------------------------- implicit real*8(a-h,o-z) character fname*12,titf*46,title*58,form*12,mix*3 character*30 ampnam(25) character*7 crea(15) integer ktout(10),ins real*8 a(8),b(5) *--------------------------------------------------------------------- * common blocks with the channel distorting potential parameters * uses the jlm array poti for imaginary part printout when KD02 *--------------------------------------------------------------------- common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd common/che3/pspr(900),pspi(900),psps(900),ihesp common/cjlm/potr(900),poti(900),ijlm,ijlmp,ikd common/deut/iadia,iwat,ideutwf,ii,imso common/djlm/rlr,rli common/file/fname data crea,mix/'(p,d) ','(d,p) ','(n,d) ','(d,n) ','(d,t) ', # '(d,3He)','(3He,d)','(p,t) ','(t,p) ','(n,3He)', # '(3He,n)','(p,3He)','(3He,p)','(3He,a)','(t,a) ','mix'/ *--------------------------------------------------------------------- print*,'====================================================== ' print*,' Front end for generating TWOFNR transfer data sets ' print*,' front version 20: J.A. Tostevin March 2017 ' print*,'====================================================== ' print*,' Data set identifier (xxx in tran.xxx: max 12 chars) ' read '(a)',fname open(17,file='tran.'//fname,status='unknown') open(18,file='in.'//fname,status='unknown') write(18,'(a)') fname print '(a,a)',' >>>> ',fname print '(a,a)',' Output is to file: ','tran.'//fname print '(a,a)',' Input saved to file: ','in.'//fname print*,'------------------------------------------------------ ' *--------------------------------------------------------------------- nil=0 unit=1.d0 *--------------------------------------------------------------------- * version date iday=15 imon=03 iyear=2017 *--------------------------------------------------------------------- iadia=0 iwat=0 ihesp=0 form='(5e14.7)' *--------------------------------------------------------------------- * the following are used for the ranges with jlm/bauge potentials * also switch ikd for when the KD global potential used for n, p * ids is used for spin of n+p cluster transfer *--------------------------------------------------------------------- ikd=0 ijlm=0 rlr=0.d0 rli=0.d0 ids=10 do i=1,10 ktout(i)=0 enddo *--------------------------------------------------------------------- * title line *--------------------------------------------------------------------- print*,' Enter title information (for info only, <= 46 chars) ' read '(a)',titf write(18,'(a)') titf print '(a,a)',' >>>> ',titf title=titf//fname *--------------------------------------------------------------------- * menu of the available (automated input) transfer reactions *--------------------------------------------------------------------- 932 print*,'------------------------------------------------------ ' print*,' Reaction type: [ 1] (p,d) ' print*,' [ 2] (d,p) ' print*,' [ 3] (n,d) ' print*,' [ 4] (d,n) ' print*,' [ 5] (d,t) ' print*,' [ 6] (d,3He) ' print*,' [ 7] (3He,d) ' print*,' [ 8] (p,t) ' print*,' [ 9] (t,p) ' print*,' [10] (n,3He) ' print*,' [11] (3He,n) ' print*,' [12] (p,3He) ' print*,' [13] (3He,p) ' print*,' [14] (3He,a) ' print*,' [15] (t,a) ' print*,'------------------------------------------------------ ' print* print*,' Note: to store reaction transition amplitude, choose the' print*,' negative of the above (e.g. -4 for (d,n)) and then input' print*,' Euler angles 0,0,0 when asked. For the cross sections ' print*,' in a rotated coordinate system use the negative reaction' print*,' type and input the appropriate three Euler angles ' print*,' ------ ' print*,' Also, 5-->105 or -5-->-105 etc. for radial sensitivites ' *--------------------------------------------------------------------- * read and check for a valid reaction option read*,ireaco ireac=abs(ireaco) irsign=ireaco/ireac if(ireac.gt.100) ireac=ireac-100 if(ireac.lt.1.or.ireac.gt.15) goto 932 * ireac now has the actual reaction choice (1-15) going forward *--------------------------------------------------------------------- write(18,*) ireaco print*,' >>>> ',ireaco print* print*,'---------------------------------------------------- ' print'(a,a,a)',' ',crea(ireac),' reaction has been selected ' print*,'---------------------------------------------------- ' print* *--------------------------------------------------------------------- * radial sensitivity analysis option - if abs(ireaco) > 100 if(abs(ireaco).gt.100) then print*,'------------------------------------------------------' print*,' ktout(10)=8 if radial sensitivity analysis selected ' print*,' (twofnr reads maximum bound state radius on fort.82) ' print*,' ----' print*,' cm angle for differential cross section sensitivity? ' print*,' (twofnr will output sigma for this angle on fort.83) ' print*,'------------------------------------------------------' read*,theta write(18,*) real(theta) print*,' >>>> ',real(theta),' degrees' ktout(10)=8 endif *--------------------------------------------------------------------- * change for reading back scattering amplitudes after using * the rotation option. Here ktout(1)=8 to write the transition * amplitude (from twofnr) to an external file amp.xxx *--------------------------------------------------------------------- if(irsign.lt.0) then print*,'---------------------------------------------------- ' print*,' You have requested to store the transition amplitude ' print*,' or calculate the tansfer cross sections in a rotated ' print*,' coordinate system. Now must specify the Euler angles ' print*,' (alfa,beta,gama) in units of pi. E.g. (-1/2,-1/2,0) ' print*,' if z-axis is normal to the k_in x k_out plane. Input ' print*,' 0, 0, 0 if no rotation is required ' print*,'---------------------------------------------------- ' read*,angal,angbe,angga print*,' Euler angles: ' print*,' >>>> ',real(angal),real(angbe),real(angga) write(18,*) real(angal),real(angbe),real(angga) open(19,file='rot.'//fname,status='unknown') write(19,*) angal,angbe,angga print '(a,a)',' Euler angles written to file: ','rot.'//fname print '(a,a)',' amplitude will be written to: ','amp.'//fname close(19) ktout(1)=8 print* endif *--------------------------------------------------------------------- * changes for reading/printing the partial wave radial functions *--------------------------------------------------------------------- 832 idut=0 if(ireac.eq.1.or.ireac.eq.8.or.ireac.eq.12) then print*,' Entrance channel (proton) distorted wave: ' else if(ireac.eq.3.or.ireac.eq.10) then print*,' Entrance channel (neutron) distorted wave: ' else if(ireac.eq.7.or.ireac.eq.11.or.ireac.eq.13 + .or.ireac.eq.14) then print*,' Entrance channel (3He) distorted wave: ' else if(ireac.eq.9.or.ireac.eq.15) then print*,' Entrance channel (triton) distorted wave: ' else print*,' Entrance channel (deuteron) distorted wave:' idut=1 endif print*,' Options: ' print*,'---------------------------------------------------- ' print*,' [0] Calculate - no print ' print*,' [1] Read - no print ' print*,' [2] Read - print ' print*,' [3] Calculate - print ' if(idut.eq.1) then print*,' [4] Read (with tensor) - no print ' print*,' [5] Read (with tensor) - print ' endif print*,'---------------------------------------------------- ' read*,ktout(3) if(ktout(3).lt.0.or.ktout(3).gt.5) goto 832 write(18,*) ktout(3) print*,' >>>> ',ktout(3) if(ktout(3).eq.1.or.ktout(3).eq.2.or.ktout(3).gt.3) then print*,' wave functions will be read from fort.16 ' endif print* 833 idut=0 if(ireac.eq.1.or.ireac.eq.3.or.ireac.eq.7) then idut=1 print*,' Exit channel (deuteron) distorted wave: ' else if(ireac.eq.2.or.ireac.eq.9.or.ireac.eq.13) then print*,' Exit channel (proton) distorted wave: ' else if(ireac.eq.4.or.ireac.eq.11) then print*,' Exit channel (neutron) distorted wave: ' else if(ireac.eq.5.or.ireac.eq.8) then print*,' Exit channel (triton) distorted wave: ' else if(ireac.eq.6.or.ireac.eq.10.or.ireac.eq.12) then print*,' Exit channel (3He) distorted wave: ' else if(ireac.eq.14.or.ireac.eq.15) then print*,' Exit channel (alpha) distorted wave: ' endif print*,' Options: ' print*,'---------------------------------------------------- ' print*,' [0] Calculate - no print ' print*,' [1] Read - no print ' print*,' [2] Read - print ' print*,' [3] Calculate - print ' if(idut.eq.1) then print*,' [4] Read (with tensor) - no print ' print*,' [5] Read (with tensor) - print ' endif print*,'---------------------------------------------------- ' read*,ktout(4) if(ktout(4).lt.0.or.ktout(4).gt.5) goto 833 write(18,*) ktout(4) print*,' >>>> ',ktout(4) if(ktout(4).eq.1.or.ktout(4).eq.2.or.ktout(4).gt.3) then print*,' wave functions will be read from fort.17 ' endif print* ins=1 *--------------------------------------------------------------------- * start writing the tran.xxx data set *--------------------------------------------------------------------- write(17,101) (ktout(i),i=1,10),ins,iday,imon,iyear,title 101 format(10i1,i2,i2,i2,i4,2x,a) 102 format(0p8f10.4) *--------------------------------------------------------------------- * separation energies for A=2, 3 and 4 body light-ions (MeV) *--------------------------------------------------------------------- * deuteron --> n+p separation energy edeut=2.224573d0 * triton binding energy etwo =8.481821d0 * triton --> deuteron+n separation energy etrit=etwo-edeut * 3He --> deuteron+p separation energy eheli=7.718058d0-edeut * 3He --> 2p+n separation energy etwop=7.718058d0 * alpha --> 3he+n separation energy ealpa=20.57762d0 * alpha --> t+p separation energy ealpb=19.81386d0 *--------------------------------------------------------------------- * incident and outgoing reaction energies and masses, etc. *--------------------------------------------------------------------- m1=1 if(ireac.gt.1) m1=2 if(ireac.eq.3.or.ireac.eq.8.or.ireac.eq.10.or.ireac.eq.12) m1=1 if(ireac.eq.7.or.ireac.eq.9.or.ireac.eq.11.or.ireac.gt.12) m1=3 print*,' Laboratory incident energy per nucleon (MeV) ' read*,energy write(18,*) real(energy) print*,' >>>> ',real(energy) energy=m1*energy print*, 'Total projectile energy =',real(energy) 933 print*,' Target mass (a1) and charge (z1) ' read*,a1,z1 if(z1.ge.a1.or.a1.le.0.d0.or.z1.lt.0.d0) go to 933 write(18,*) real(a1),real(z1) print*,' >>>> ',real(a1),real(z1) *--------------------------------------------------------------------- * spins and charges s1=1.0 zp1=1 s2=0.5 z2=z1 zp2=1 *----------------------------- if(ireac.eq.1) then s1=0.5 a2=a1-1.0 m2=2 s2=1.0 *----------------------------- else if(ireac.eq.2) then a2=a1+1.0 m2=1 *----------------------------- else if(ireac.eq.3) then zp1=0 s1=0.5 a2=a1-1.0 m2=2 s2=1.0 z2=z1-1.0 *----------------------------- else if(ireac.eq.4) then a2=a1+1.0 m2=1 zp2=0.0 z2=z1+1.0 *----------------------------- else if(ireac.eq.5) then a2=a1-1.0 m2=3 *----------------------------- else if(ireac.eq.6) then a2=a1-1.0 m2=3 z2=z1-1.0 zp2=2.0 *----------------------------- else if(ireac.eq.7) then zp1=2 s1=0.5 a2=a1+1.0 m2=2 s2=1.0 z2=z1+1.0 *----------------------------- else if(ireac.eq.8) then s1=0.5 a2=a1-2.0 m2=3 *----------------------------- else if(ireac.eq.9) then s1=0.5 a2=a1+2.0 m2=1 *----------------------------- else if(ireac.eq.10) then zp1=0 s1=0.5 a2=a1-2.0 z2=z1-2 m2=3 zp2=2 s2=0.5 *----------------------------- else if(ireac.eq.11) then zp1=2 s1=0.5 a2=a1+2.0 z2=z1+2 m2=1 zp2=0 s2=0.5 *----------------------------- else if(ireac.eq.12) then zp1=1 s1=0.5 a2=a1-2.0 z2=z1-1 m2=3 zp2=2 s2=0.5 *----------------------------- else if(ireac.eq.13) then zp1=2 s1=0.5 a2=a1+2.0 z2=z1+1 m2=1 zp2=1 s2=0.5 *----------------------------- else if(ireac.eq.14) then zp1=2 s1=0.5 a2=a1-1.0 z2=z1 m2=4 zp2=2 s2=0.0 *----------------------------- else if(ireac.eq.15) then zp1=1 s1=0.5 a2=a1-1.0 z2=z1-1.0 m2=4 zp2=2 s2=0.0 endif *----------------------------- ia1=nint(a1) ia2=nint(a2) iz1=nint(z1) iz2=nint(z2) *--------------------------------------------------------------------- * energy and integration ranges line - card 1.0 *--------------------------------------------------------------------- print*,'---------------------------------------------------- ' 873 print*,' Integration ranges: [1] use defaults ' print*,' (defaults: 0-30 fm in 0.10 fm steps) ' print*,' [2] specify values ' print*,'---------------------------------------------------- ' print*,' Note: by default these rmax and step apply to the ' print*,' entrance channel values. To specify that the values ' print*,' apply to the exit channel, input instead -1 or -2 ' read*,iiran irana=iiran iiran=abs(iiran) if(iiran.lt.1.or.iiran.gt.2) goto 873 write(18,*) irana print*,' >>>> ',irana 555 if(iiran.eq.1) then rmax=30.d0 step1=0.10d0 nrmax=nint(rmax/step1) else print*,' max integration radius and step ' read*,rmax,step1 nrmax=nint(rmax/step1) if(nrmax.le.900) then write(18,*) real(rmax),real(step1) print*,' >>>> ',real(rmax),real(step1) endif endif *--------------------------------------------------------------------- if(nrmax.gt.900) then print*,' Inputs require',nrmax,' radial steps but ' print*,' a maximum of 900 radial steps are allowed ' print*,' Revise your inputs accordingly: ' print* goto 555 endif step2=step1*(a1/a2) if(irana.lt.0) then step2=step1 step1=step2*(a2/a1) rmax=nrmax*step1 endif print*,' integrations from 0 to',real(rmax),' fm' print77,' in',nrmax,' radial steps of',real(step1),' fm' 77 format(a,i5,a,f8.5,a) print*,' step length in outgoing channel =',real(step2) print* a(1)=unit a(2)=nil a(3)=rmax a(4)=nil a(5)=nrmax a(6)=energy a(7)=nil a(8)=nil write(17,102) (a(i),i=1,7) nr3max=nrmax+3 *--------------------------------------------------------------------- 874 print*,' number of partial waves [1] default (=40) ' print*,' [2] specify (<90) ' read*,ipw if(ipw.lt.1.or.ipw.gt.2) goto 874 write(18,*) ipw print*,' >>>> ',ipw npw=40 if(ipw.eq.2) then 5503 print*,' input number of partial waves (<90) ' read*,npw if(npw.gt.90) goto 5503 write(18,*) npw print*,' >>>> ',npw endif *--------------------------------------------------------------------- 408 print*,' Input the required centre of mass angles info: ' print*,' number of angles: step (degrees): starting value ' print*,' (maximum number of angles is 181) ' print*,' (entering 0 0 0 will use 181 1.0 0.0 ) ' read*,b(2),b(3),b(4) if(b(2).gt.181) then print*,' maximum number of angles is 181: please reenter ' go to 408 endif write(18,*) real(b(2)),real(b(3)),real(b(4)) if (abs(b(2)).lt.0.01d0) then b(2)=181 b(3)=1.0 b(4)=0.0 endif b(5)=0.0 print*,' >>>> ',real(b(2)),real(b(3)),real(b(4)) if(ktout(10).eq.8) then theta=(theta-b(4))/b(3)+1 b(5)=theta endif *--------------------------------------------------------------------- * transferred angular momenta line - card 2.2 *--------------------------------------------------------------------- a(1)=2.2 print*,'---------------------------------------------------- ' 911 if(ireac.eq.8.or.ireac.eq.9.or.ireac.eq.10.or.ireac.eq.11) then a(2)=0.0 print*,' Enter quantum numbers L and J of transferred cluster' print*,' Uses simple di-nucleon model, so S = 0: enter L = J ' else if(ireac.eq.12.or.ireac.eq.13) then print*,' Enter spin S of transferred n+p cluster (= 0 or 1) ' read*,a(2) ids=nint(a(2)) if(ids.ne.0.and.ids.ne.1) then print*,' need S=0 or S=1 : reenter ' go to 911 endif write(18,*) real(a(2)) print*,' >>>> ',real(a(2)) print*,' Enter quantum numbers L and J of transferred cluster' else a(2)=0.5 print*,' sp quantum numbers L and J of transferred nucleon ' endif read*,ltr,rjtr if(abs(rjtr-ltr).gt.a(2)) then print*,' need |J-S| < L < J+S : reenter ' go to 911 endif write(18,*) ltr,real(rjtr) print*,' >>>> ',ltr,real(rjtr) 437 if(ireac.eq.8.or.ireac.eq.9.or.ireac.eq.10.or.ireac.eq.11 * .or.ireac.eq.12.or.ireac.eq.13)then print*,' number of nodes in cluster radial wave function ' else print*,' number of nodes in nucleon sp radial wave function ' print*,'---------------------------------------------------- ' print*,' convention used here: the lowest state has nodes=0 ' print*,' |+ 2|- 8|+ 20|- 40|+ 70|- 112|+ 168| ' print*,' | 0s| 0p|1s,0d|1p,0f|2s,1d,0g|2p,1f,0h|3s,2d,1g,0i| ' print*,'---------------------------------------------------- ' endif read*,nodes if(nodes.lt.0.or.nodes.gt.7) go to 437 write(18,*) nodes print*,' >>>> ',nodes a(3)=ltr a(4)=rjtr write(17,102) (a(i),i=1,4) print* *--------------------------------------------------------------------- * sort out separation energy and/or via the Q-value *--------------------------------------------------------------------- 935 if(ireac.eq.1.or.ireac.eq.2.or.ireac.eq.5.or.ireac.eq.14) then print*,' specify : [1] neutron separation energy (>0 MeV) ' else if(ireac.eq.8.or.ireac.eq.9) then print*,' specify : [1] two-neutron separation energy (>0 MeV)' else if(ireac.eq.10.or.ireac.eq.11) then print*,' specify : [1] two-proton separation energy (>0 MeV) ' else if(ireac.eq.12.or.ireac.eq.13) then print*,' specify : [1] (n+p) separation energy (>0 MeV) ' else print*,' specify : [1] proton separation energy (>0 MeV) ' endif print*, ' or [2] reaction Q-value (MeV) ' read*,ietyp if(ietyp.lt.1.or.ietyp.gt.2) go to 935 write(18,*) ietyp print*,' >>>> ',ietyp if(ietyp.eq.1) then print*,' transferred particle separation energy (MeV: >0) ' read*,sn if(sn.le.0.0) then print*,' separation energy must be positive - reenter ' goto 935 endif write(18,*) real(sn) print*,' >>>> ',real(sn) *--------------------------------------------------------------------- * compute Q-value given the separation energy *--------------------------------------------------------------------- if(ireac.eq.1.or.ireac.eq.3) then qval=-sn+edeut else if(ireac.eq.2.or.ireac.eq.4) then qval=sn-edeut else if(ireac.eq.5) then qval=-sn+etrit else if(ireac.eq.6) then qval=-sn+eheli else if(ireac.eq.7) then qval=sn-eheli else if(ireac.eq.8) then qval=-sn+etwo else if(ireac.eq.9) then qval=sn-etwo else if(ireac.eq.10) then qval=-sn+etwop else if(ireac.eq.11) then qval=sn-etwop else if(ireac.eq.12) then if(ids.eq.0) qval=-sn+etwop if(ids.eq.1) qval=-sn+eheli else if(ireac.eq.13) then if(ids.eq.0) qval=sn-etwop if(ids.eq.1) qval=sn-eheli else if(ireac.eq.14) then qval=-sn+ealpa else if(ireac.eq.15) then qval=-sn+ealpb endif print*,' Q-value is',real(qval),' MeV ' else if(ietyp.eq.2) then print*,' reaction Q-value (MeV) ' read*,qval write(18,*) real(qval) print*,' >>>> ',real(qval) *--------------------------------------------------------------------- * compute separation energy given the Q-value *--------------------------------------------------------------------- if(ireac.eq.1.or.ireac.eq.3) then sn=edeut-qval else if(ireac.eq.2.or.ireac.eq.4) then sn=edeut+qval else if(ireac.eq. 5) then sn=etrit-qval else if(ireac.eq. 6) then sn=eheli-qval else if(ireac.eq. 7) then sn=eheli+qval else if(ireac.eq. 8) then sn=etwo-qval else if(ireac.eq. 9) then sn=etwo+qval else if(ireac.eq.10) then sn=etwop-qval else if(ireac.eq.11) then sn=etwop+qval else if(ireac.eq.12) then if(ids.eq.0) sn=etwop-qval if(ids.eq.1) sn=eheli-qval else if(ireac.eq.13) then if(ids.eq.0) sn=etwop+qval if(ids.eq.1) sn=eheli+qval else if(ireac.eq.14) then sn=ealpa-qval else if(ireac.eq.15) then sn=ealpb-qval endif 476 print*,' Separation energy is',real(sn),' MeV' if(sn.le.0.d0) then print*,'---------------------------------------------------- ' print*,' with the input Q-value the state is particle unbound' print*,' [1] reenter Q-value or separation energy? ' print*,' [2] proceed and choose separation energy? ' print*,' [3] exit ' print*,'---------------------------------------------------- ' read*,ifix if(ifix.lt.1.or.ifix.gt.3) go to 476 write(18,*) ifix print*,' >>>> ',ifix if(ifix.eq.1) goto 935 if(ifix.eq.3) stop if(ifix.eq.2) then 474 print*,' input chosen separation energy (>0): ' print*,' (note the Q-value remains the enetered value ' print*,' i.e. Q-value is',real(qval),' MeV) ' read*,sn if(sn.le.0.0) then print*,' separation energy must be positive - reenter ' goto 474 endif write(18,*) real(sn) print*,' >>>> ',real(sn) endif endif endif *--------------------------------------------------------------------- * can now compute lab energy for final state potential (energy2) * print wavenumbers and look at likely ell mismatch of reaction *--------------------------------------------------------------------- print*,'====================================================== ' ecm1=energy*a1/(a1+m1) print*,' entrance channel cm energy ',real(ecm1) fmu1=a1*m1/(a1+m1) fkay1=0.2195376d0*sqrt(fmu1*ecm1) ecm2=ecm1+qval print*,' exit channel cm energy ',real(ecm2) if(ecm2.lt.0.d0) then print*,' reaction is below threshold - stopping' stop else if(ecm2.lt.2.d0) then print*,' reaction is near threshold ' endif fmu2=a2*m2/(a2+m2) fkay2=0.2195376d0*sqrt(fmu2*ecm2) rad=1.2d0*(a1**0.3333333333d0) rl1=fkay1*rad rl2=fkay2*rad print*,' asymptotic wavenumbers and grazing angular momenta ' print*,' kin = ',real(fkay1),' L(in ) = ',real(rl1) print*,' kout = ',real(fkay2),' L(out) = ',real(rl2) rlmis=abs(rl1-rl2) print*,' so L mismatch is of order ',real(rlmis),' hbar' print*,' from an estimated radius of ',real(rad),' fm' print*,' and a chosen L transfer of ',ltr,' hbar' energy2=ecm2*(a2+m2)/a2 *--------------------------------------------------------------------- * entrance channel partial waves/non-locality line - card 3.1 *--------------------------------------------------------------------- print*,'====================================================== ' if(ireac.eq.1.or.ireac.eq.8.or.ireac.eq.12) then print*,' incident (proton) channel information ' else if(ireac.eq.3.or.ireac.eq.10) then print*,' incident (neutron) channel information ' else if(ireac.eq.7.or.ireac.eq.11.or.ireac.eq.13 + .or.ireac.eq.14) then print*,' incident (3He) channel information ' else if(ireac.eq.9.or.ireac.eq.15) then print*,' incident (triton) channel information ' else print*,' incident (deuteron) channel information ' endif if(ktout(3).eq.1.or.ktout(3).eq.2.or.ktout(3).gt.3) then print*,'---------------------------------------------------- ' print*,' wave functions will be read: chosen potential will ' print*,' be used when LEA finite-range correction is chosen ' print*,' and with any specified non-locality correction ' print*,'---------------------------------------------------- ' endif 876 print*,' nonlocality in incident channel [1] no ' print*,' [2] yes ' if(ireac.eq.2.or.ireac.eq.4) then print*,' It is recommended you do NOT include a non-locality ' print*,' with an adiabatic description of the deuteron channel' endif read*,inonloc if(inonloc.lt.1.or.inonloc.gt.2) go to 876 write(18,*) inonloc print*,' >>>> ',inonloc a(5)=0.d0 if(inonloc.eq.2) then if(ireac.eq.1.or.ireac.eq.8.or.ireac.eq.12) then print*,' input proton nonlocality range (~0.85 fm) ' else if(ireac.eq.3.or.ireac.eq.10) then print*,' input neutron nonlocality range (~0.85 fm) ' else if(ireac.eq.7.or.ireac.eq.11.or.ireac.eq.13 + .or.ireac.eq.14) then print*,' input 3He nonlocality range (~0.20 fm) ' else if(ireac.eq.9.or.ireac.eq.15) then print*,' input triton nonlocality range (~0.20 fm) ' else print*,' input deuteron nonlocality range (~0.54 fm) ' endif read*,a(5) write(18,*) real(a(5)) print*,' >>>> ',real(a(5)) endif a(1)=3.1 a(2)=nil a(3)=npw a(4)=nil write(17,102) (a(i),i=1,5) *--------------------------------------------------------------------- * entrance channel masses/charges line - card 4.1 *--------------------------------------------------------------------- a(1)=4.1 a(2)=m1 a(3)=a1 a(4)=zp1 a(5)=z1 a(6)=s1 print*,' target spin in incident channel ' read*,spin1 write(18,*) real(spin1) print*,' >>>> ',real(spin1) a(7)=spin1 a(8)=0.0 write(17,102) (a(i),i=1,8) *--------------------------------------------------------------------- 877 if(ireac.eq.1.or.ireac.eq.8.or.ireac.eq.12) then print*,' incident (proton) channel potential ' else if(ireac.eq.3.or.ireac.eq.10) then print*,' incident (neutron) channel potential ' else if(ireac.eq.7.or.ireac.eq.11.or.ireac.eq.13 + .or.ireac.eq.14) then print*,' incident (3He) channel potential ' else if(ireac.eq.9.or.ireac.eq.15) then print*,' incident (triton) channel potential ' else print*,' incident (deuteron) channel potential ' endif print*,' [1] from those built in ' print*,' [2] specify potential parameters ' *--------------------------------------------------------------------- read*,iopti if(iopti.lt.1.or.iopti.gt.2) go to 877 write(18,*) iopti print*,' >>>> ',iopti print*,'----------------------------------------------------' print*,' initial potential at Elab=',real(energy),' MeV' if(iopti.eq.1) then if(ireac.eq.1.or.ireac.eq.8.or.ireac.eq.12) then call proton(energy,a1,z1,step1,nr3max) else if(ireac.eq.3.or.ireac.eq.10) then call neutron(energy,a1,z1,step1,nr3max) else if(ireac.eq.7.or.ireac.eq.11.or.ireac.eq.13 + .or.ireac.eq.14) then call helium(energy,a1,z1,step1,nr3max) else if(ireac.eq.9.or.ireac.eq.15) then call triton(energy,a1,z1,step1,nr3max) else call deuteron(energy,a1,z1,ireac,inonloc) endif else print*,' Central terms ' print*,' ------------- ' print*,' Coulomb radius parameter ' read*,rcd write(18,*) real(rcd) print*,' >>>> ',real(rcd) print*,' Real volume : depth(>0), radius, diffuseness ' read*,vd,rrd,ard write(18,*) real(vd),real(rrd),real(ard) print*,' >>>> ',real(vd),real(rrd),real(ard) print*,' Imag volume : depth(>0), radius, diffuseness ' read*,wd,rid,aid write(18,*) real(wd),real(rid),real(aid) print*,' >>>> ',real(wd),real(rid),real(aid) *--------------------------------------------------------------------- * print*,' Imag surface : depth(>0), radius, diffuseness ' * read*,wisd,risid,aisid *--------------------------------------------------------------------- print*,' Imag surface : depth(>0) ' read*,wisd write(18,*) real(wisd) print*,' >>>> ',real(wisd) print*,' Spin-orbit terms ' print*,' ---------------- ' if(ireac.eq.1.or.ireac.eq.8.or.ireac.eq.12) then print*,' proton: coefficients are of L.sigma (~6.0 MeV) ' else if(ireac.eq.3.or.ireac.eq.10) then print*,' neutron: coefficients are of L.sigma (~6.0 MeV) ' else if(ireac.eq.7.or.ireac.eq.11.or.ireac.eq.13 + .or.ireac.eq.14) then print*,' 3He: coefficients are of L.sigma (~6.0 MeV) ' else if(ireac.eq.9.or.ireac.eq.15) then print*,' triton: coefficients are of L.sigma (~6.0 MeV) ' else print*,' Careful of convention here: non-standard strength' print*,' deuteron: half coefficient of L.S (~3.0 MeV) ' endif print*,' Real s/orbit : depth(>0), radius, diffuseness ' read*,vsod,rsord,asord write(18,*) real(vsod),real(rsord),real(asord) print*,' >>>> ',real(vsod),real(rsord),real(asord) print*,' Imag s/orbit : depth(>0), radius, diffuseness ' read*,wsod,rsoid,asoid write(18,*) real(wsod),real(rsoid),real(asoid) print*,' >>>> ',real(wsod),real(rsoid),real(asoid) endif *--------------------------------------------------------------------- * potential line 1 - card 5.1 *--------------------------------------------------------------------- a(1)=5.1 a(2)=vd a(3)=(wd+wisd) a(4)=vsod a(5)=wsod a(6)=rrd a(7)=ard a(8)=rcd write(17,102) (a(i),i=1,8) *--------------------------------------------------------------------- * potential line 2 - card 6.1 *--------------------------------------------------------------------- a(1)=6.1 a(2)=rsord a(3)=asord a(4)=rsoid a(5)=asoid write(17,102) (a(i),i=1,5) *--------------------------------------------------------------------- * potential line 3 - card 7.1 *--------------------------------------------------------------------- a(1)=7.1 if(abs(wd+wisd).gt.1.d-10) then a(2)=wisd/(wd+wisd) else a(2)=1.d0 endif a(3)=rid a(4)=aid a(5)=nil a(6)=nil write(17,102) (a(i),i=1,6) *--------------------------------------------------------------------- * a(1)=8.1 * a(2)=2.0 * a(3)=nil * a(4)=nil * a(5)=nil * a(6)=wisd * a(7)=risid * a(8)=aisid * write(17,102) (a(i),i=1,8) *--------------------------------------------------------------------- * exit channel partial waves/nonlocality line *--------------------------------------------------------------------- print*,'====================================================' if(ireac.eq.1.or.ireac.eq.3.or.ireac.eq.7) then print*,' outgoing (deuteron) channel information ' else if(ireac.eq.2.or.ireac.eq.9.or.ireac.eq.13) then print*,' outgoing (proton) channel information ' else if(ireac.eq.4.or.ireac.eq.11) then print*,' outgoing (neutron) channel information ' else if(ireac.eq.5.or.ireac.eq.8) then print*,' outgoing (triton) channel information ' else if(ireac.eq.6.or.ireac.eq.10.or.ireac.eq.12) then print*,' outgoing (3He) channel information ' else if(ireac.eq.14.or.ireac.eq.15) then print*,' outgoing (alpha) channel information ' endif if(ktout(4).eq.1.or.ktout(4).eq.2.or.ktout(4).gt.3) then print*,'---------------------------------------------------- ' print*,' wave functions will be read: chosen potential will ' print*,' be used when LEA finite-range correction is chosen ' print*,' and with any specified non-locality correction ' print*,'---------------------------------------------------- ' endif 878 print*,' nonlocality in outgoing channel [1] no ' print*,' [2] yes ' if(ireac.eq.1.or.ireac.eq.3) then print*,' It is recommended you do NOT include a non-locality ' print*,' with an adiabatic description of the deuteron channel' endif read*,inonloc if(inonloc.lt.1.or.inonloc.gt.2) go to 878 write(18,*) inonloc print*,' >>>> ',inonloc a(5)=0.d0 if(inonloc.eq.2) then if(ireac.eq.1.or.ireac.eq.3.or.ireac.eq.7) then print*,' input deuteron nonlocality range (~0.54 fm) ' else if(ireac.eq.2.or.ireac.eq.9.or.ireac.eq.13) then print*,' input proton nonlocality range (~0.85 fm) ' else if(ireac.eq.4.or.ireac.eq.11) then print*,' input neutron nonlocality range (~0.85 fm) ' else if(ireac.eq.5.or.ireac.eq.8) then print*,' input triton nonlocality range (~0.20 fm) ' else if(ireac.eq.6.or.ireac.eq.10.or.ireac.eq.12) then print*,' input 3He nonlocality range (~0.20 fm) ' else if(ireac.eq.14.or.ireac.eq.15) then print*,' input alpha nonlocality range (~0.20 fm) ' endif read*,a(5) write(18,*) real(a(5)) print*,' >>>> ',real(a(5)) endif a(1)=3.2 a(2)=nil a(3)=npw a(4)=unit write(17,102) (a(i),i=1,5) *--------------------------------------------------------------------- * exit channel masses/charges line - card 4.2 *--------------------------------------------------------------------- a(1)=4.2 a(2)=m2 a(3)=a2 a(4)=zp2 a(5)=z2 a(6)=s2 879 print*,' target spin in outgoing channel ' read*,spin2 ispierr=0 *--------------------------------------------------------------------- * check consistency of target and transferred angular momenta *--------------------------------------------------------------------- if(ireac.eq.1.or.ireac.eq.3.or.ireac.eq.5.or.ireac.eq.6.or. 1 ireac.eq.8.or.ireac.eq.10.or.ireac.eq.12.or.ireac.eq.14 2 .or.ireac.eq.15) then big=spin2+rjtr+0.1 sma=abs(spin2-rjtr)-0.1 if(spin1.gt.big.or.spin1.lt.sma) then ispierr=1 print*,' ====================================================' print*,' input angular momenta are inconsistent: ' print*,real(spin2),' +',real(rjtr),' =',real(spin1),' ' print*,' one or more of the target and/or transferred ' print*,' nucleon angular momenta are wrong. ' print*,' ====================================================' endif else big=spin1+rjtr+0.1 sma=abs(spin1-rjtr)-0.1 if(spin2.gt.big.or.spin2.lt.sma) then ispierr=1 print*,' ====================================================' print*,' input angular momenta are inconsistent: ' print*,real(spin1),' +',real(rjtr),' =',real(spin2),' ' print*,' one or more of the target and/or transferred ' print*,' nucleon angular momenta are wrong. ' print*,' ====================================================' endif endif if(ispierr.gt.0) then print*,' problem with spins: [1] re-enter outgoing target spin' print*,' [2] abort and start again ' read*,ispierr if(ispierr.eq.1) go to 879 if(ispierr.eq.2) stop endif *--------------------------------------------------------------------- write(18,*) real(spin2) print*,' >>>> ',real(spin2) a(7)=spin2 a(8)=qval write(17,102) (a(i),i=1,8) *--------------------------------------------------------------------- 880 if(ireac.eq.1.or.ireac.eq.3.or.ireac.eq.7) then print*,' outgoing (deuteron) channel potential ' else if(ireac.eq.2.or.ireac.eq.9.or.ireac.eq.13) then print*,' outgoing (proton) channel potential ' else if(ireac.eq.4.or.ireac.eq.11) then print*,' outgoing (neutron) channel potential ' else if(ireac.eq.5.or.ireac.eq.8) then print*,' outgoing (triton) channel potential ' else if(ireac.eq.6.or.ireac.eq.10.or.ireac.eq.12) then print*,' outgoing (3He) channel potential ' else if(ireac.eq.14.or.ireac.eq.15) then print*,' outgoing (alpha) channel potential ' endif print*,' [1] from those built in ' print*,' [2] specify potential parameters ' *--------------------------------------------------------------------- read*,iopti if(iopti.lt.1.or.iopti.gt.2) go to 880 write(18,*) iopti print*,' >>>> ',iopti print*,'----------------------------------------------------' print*,' final potential at Elab=',real(energy2),' MeV' if(iopti.eq.1) then if(ireac.eq.1.or.ireac.eq.3.or.ireac.eq.7) then call deuteron(energy2,a2,z2,ireac,inonloc) else if(ireac.eq.2.or.ireac.eq.9.or.ireac.eq.13) then call proton(energy2,a2,z2,step2,nr3max) else if(ireac.eq.4.or.ireac.eq.11) then call neutron(energy2,a2,z2,step2,nr3max) else if(ireac.eq.5.or.ireac.eq.8) then call triton(energy2,a2,z2,step2,nr3max) else if(ireac.eq.6.or.ireac.eq.10.or.ireac.eq.12) then call helium(energy2,a2,z2,step2,nr3max) else if(ireac.eq.14.or.ireac.eq.15) then call alphap(energy2,a2,z2,step2,nr3max) endif else print*,' Central terms ' print*,' ------------- ' print*,' Coulomb radius parameter ' read*,rcd write(18,*) real(rcd) print*,' >>>> ',real(rcd) print*,' Real volume : depth(>0), radius, diffuseness ' read*,vd,rrd,ard write(18,*) real(vd),real(rrd),real(ard) print*,' >>>> ',real(vd),real(rrd),real(ard) print*,' Imag volume : depth(>0), radius, diffuseness ' read*,wd,rid,aid write(18,*) real(wd),real(rid),real(aid) print*,' >>>> ',real(wd),real(rid),real(aid) *--------------------------------------------------------------------- * print*,' Imag surface : depth(>0), radius, diffuseness ' * read*,wisd,risid,aisid *--------------------------------------------------------------------- print*,' Imag surface : depth(>0) ' read*,wisd write(18,*) real(wisd) print*,' >>>> ',real(wisd) if(ireac.ne.14.and.ireac.ne.15) then print*,' Spin-orbit terms ' print*,' ---------------- ' if(ireac.eq.2.or.ireac.eq.9.or.ireac.eq.13) then print*,' proton: coefficients are of L.sigma (~6.0 MeV) ' else if(ireac.eq.4.or.ireac.eq.11) then print*,' neutron: coefficients are of L.sigma (~6.0 MeV) ' else if(ireac.eq.6.or.ireac.eq.10.or.ireac.eq.12) then print*,' 3He: coefficients are of L.sigma (~6.0 MeV) ' else if(ireac.eq.5.or.ireac.eq.8) then print*,' triton: coefficients are of L.sigma (~6.0 MeV) ' else print*,' Careful of convention here: non-standard strength' print*,' deuteron: half coefficient of L.S (~3.0 MeV) ' endif print*,' Real s/orbit : depth(>0), radius, diffuseness ' read*,vsod,rsord,asord write(18,*) real(vsod),real(rsord),real(asord) print*,' >>>> ',real(vsod),real(rsord),real(asord) print*,' Imag s/orbit : depth(>0), radius, diffuseness ' read*,wsod,rsoid,asoid write(18,*) real(wsod),real(rsoid),real(asoid) print*,' >>>> ',real(wsod),real(rsoid),real(asoid) else vsod=0.d0 wsod=0.d0 rsord=1.d0 asord=1.d0 rsoid=1.d0 asoid=1.d0 endif endif *--------------------------------------------------------------------- * potential line 1 - card 5.2 *--------------------------------------------------------------------- a(1)=5.2 a(2)=vd a(3)=(wd+wisd) a(4)=vsod a(5)=wsod a(6)=rrd a(7)=ard a(8)=rcd write(17,102) (a(i),i=1,8) *--------------------------------------------------------------------- * potential line 2 - card 6.2 *--------------------------------------------------------------------- a(1)=6.2 a(2)=rsord a(3)=asord a(4)=rsoid a(5)=asoid write(17,102) (a(i),i=1,5) *--------------------------------------------------------------------- * potential line 3 - card 7.2 *--------------------------------------------------------------------- a(1)=7.2 if(abs(wd+wisd).gt.1.d-10) then a(2)=wisd/(wd+wisd) else a(2)=1.d0 endif a(3)=rid a(4)=aid a(5)=nil a(6)=nil write(17,102) (a(i),i=1,6) *--------------------------------------------------------------------- * a(1)=8.2 * a(2)=2.0 * a(3)=nil * a(4)=nil * a(5)=nil * a(6)=wisd * a(7)=risid * a(8)=aisid * write(17,102) (a(i),i=1,8) *--------------------------------------------------------------------- * angles line - card 9 *--------------------------------------------------------------------- b(1)=9.0 write(17,102) (b(i),i=1,5) write(17,102) *--------------------------------------------------------------------- * write entrance channel nucleon JLM potentials if required * or write imaginary part if KD02 nucleon potential is used * or write Sao Paulo potential in the 3He case * or write Li et al. triton potential in the triton case *--------------------------------------------------------------------- * nucleon cases * for jlm potential if(ijlmp.eq.1.and.(ireac.eq.1.or.ireac.eq.3.or.ireac.eq.8 # .or.ireac.eq.10.or.ireac.eq.12))then write(17,'(a)') form write(17,'(5e14.7)')(potr(ii),ii=1,nr3max) write(17,'(a)') form write(17,'(5e14.7)')(poti(ii),ii=1,nr3max) endif * for kd potential if(ikd.eq.1.and.(ireac.eq.1.or.ireac.eq.3.or.ireac.eq.8 # .or.ireac.eq.10.or.ireac.eq.12))then write(17,'(a)') form write(17,'(5e14.7)')(poti(ii),ii=1,nr3max) endif *--------------------------------------------------------------------- * he3 cases if(ihesp.eq.1.and.(ireac.eq.7.or.ireac.eq.11.or.ireac.eq.13 + .or.ireac.eq.14))then write(17,'(a)') form write(17,'(5e14.7)')(pspr(ii),ii=1,nr3max) write(17,'(a)') form write(17,'(5e14.7)')(pspi(ii),ii=1,nr3max) endif * triton cases if(ihesp.eq.1.and.(ireac.eq.9.or.ireac.eq.15))then write(17,'(a)') form write(17,'(5e14.7)')(pspr(ii),ii=1,nr3max) write(17,'(a)') form write(17,'(5e14.7)')(pspi(ii),ii=1,nr3max) write(17,'(a)') form write(17,'(5e14.7)')(psps(ii),ii=1,nr3max) endif *--------------------------------------------------------------------- * calculate/write adiabatic or watanabe deuteron potentials *--------------------------------------------------------------------- if(iadia.gt.0.or.iwat.gt.0) then print*,'---------------------------------------------------- ' if(iadia.gt.0) then print*,' Now construct the Johnson-Tandy adiabatic potential:' else if (iwat.gt.0) then print*,' Now construct the Watanabe (folding model)potential:' endif print*,' select the nucleon optical potentials for folding ' print*,' - usually these should be consistent with that used ' print*,' for the nucleon channel in (d,p), (n,d), ... etc. ' if(ireac.eq.1.or.ireac.eq.3.or.ireac.eq.7) then call adiab(energy2,a2,z2,step2,nr3max) elseif(ireac.eq.2.or.ireac.eq.4.or.ireac.eq.5.or.ireac.eq.6)then call adiab(energy ,a1,z1,step1,nr3max) endif endif *--------------------------------------------------------------------- * write exit channel nucleon JLM potentials if required * or write imaginary part if KD02 nucleon potential is used * or write Sao Paulo potential in the 3He case * or write Li et al. triton potential in the triton case *--------------------------------------------------------------------- * nucleon cases * fot jlm potential if(ijlmp.eq.1.and.(ireac.eq.2.or.ireac.eq.4.or.ireac.eq.9 # .or.ireac.eq.11.or.ireac.eq.13))then write(17,'(a)') form write(17,'(5e14.7)')(potr(ii),ii=1,nr3max) write(17,'(a)') form write(17,'(5e14.7)')(poti(ii),ii=1,nr3max) endif * for kd potential if(ikd.eq.1.and.(ireac.eq.2.or.ireac.eq.4.or.ireac.eq.9 # .or.ireac.eq.11.or.ireac.eq.13))then write(17,'(a)') form write(17,'(5e14.7)')(poti(ii),ii=1,nr3max) endif *--------------------------------------------------------------------- * for 3he cases if(ihesp.eq.1.and.(ireac.eq.6.or.ireac.eq.10.or.ireac.eq.12))then write(17,'(a)') form write(17,'(5e14.7)')(pspr(ii),ii=1,nr3max) write(17,'(a)') form write(17,'(5e14.7)')(pspi(ii),ii=1,nr3max) endif * for triton cases if(ihesp.eq.1.and.(ireac.eq.5.or.ireac.eq.8))then write(17,'(a)') form write(17,'(5e14.7)')(pspr(ii),ii=1,nr3max) write(17,'(a)') form write(17,'(5e14.7)')(pspi(ii),ii=1,nr3max) write(17,'(a)') form write(17,'(5e14.7)')(psps(ii),ii=1,nr3max) endif *--------------------------------------------------------------------- * this ends the distorting potential inputs and outputs *--------------------------------------------------------------------- * following for zero-range or LEA light particle vertex * first formfactor line, D0^2 value needed - card 10 *--------------------------------------------------------------------- print*,'----------------------------------------------------' a(1)=10.0 a(2)=1.0 a(3)=nil a(5)=nil *--------------------------------------------------------------------- * deuteron-nucleon overlap cases D0 assignments in a(4) *--------------------------------------------------------------------- if(ireac.lt.5) then if(ireac.eq.1.or.ireac.eq.2) then print*,' vertex constant D0 ' else print*,' vertex constant D0 ' endif 811 print*,' [1] use default value -122.50 MeV fm^3/2 ' print*,' [2] use Reid SC value -125.19 MeV fm^3/2 ' print*,' [3] use AV18 value -126.11 MeV fm^3/2 ' read*,idwf if(idwf.lt.1.or.idwf.gt.3) go to 811 write(18,*) idwf print*,' >>>> ',idwf a(4)=-122.5d0 if(idwf.eq.2) a(4)=-125.19d0 if(idwf.eq.3) a(4)=-126.11d0 a(4)=a(4)*a(4) print*,' this gives D0^2 = ',real(a(4)),' MeV^2 fm^3 ' 881 print*,' use this value [1] yes ' print*,' [2] no ' read*,ianq if(ianq.lt.1.or.ianq.gt.2) go to 881 write(18,*) ianq print*,' >>>> ',ianq if(ianq.eq.2) then print*,' input D0^2 MeV^2 fm^3 ' read*,a(4) write(18,*) a(4) print*,' >>>> ',a(4) endif *--------------------------------------------------------------------- else if(ireac.eq.5) then print*,' vertex constant D0 = -160.0 MeV fm^3/2 ' print*,' e.g. Phys. Rev. C 20 (1979) 1631 ' a(4)=160.0d0**2 print*,' this gives D0^2 = ',real(a(4)),' MeV^2 fm^3 ' 882 print*,' use this default [1] yes ' print*,' [2] no ' read*,ianq if(ianq.lt.1.or.ianq.gt.2) go to 882 write(18,*) ianq print*,' >>>> ',ianq if(ianq.eq.2) then print*,' input D0^2 MeV^2 fm^3 ' read*,a(4) write(18,*) a(4) print*,' >>>> ',a(4) endif *--------------------------------------------------------------------- else if(ireac.eq.6.or.ireac.eq.7) then print*,' vertex constant D0 = -160.0 MeV fm^3/2 ' print*,' e.g. Phys. Rev. C 20 (1979) 1631 ' a(4)=160.0d0**2 print*,' this gives D0^2 = ',real(a(4)),' MeV^2 fm^3 ' 883 print*,' use this default [1] yes ' print*,' [2] no ' read*,ianq if(ianq.lt.1.or.ianq.gt.2) go to 883 write(18,*) ianq print*,' >>>> ',ianq if(ianq.eq.2) then print*,' input D0^2 MeV^2 fm^3 ' read*,a(4) write(18,*) a(4) print*,' >>>> ',a(4) endif *--------------------------------------------------------------------- else if(ireac.eq.8.or.ireac.eq.9) then print*,' vertex constant D0 = -469.0 MeV fm^3/2 ' print*,' e.g. Phys. Rev. C 4 (1971) 196 ' a(4)=469.0d0**2 print*,' this gives D0^2 = ',real(a(4)),' MeV^2 fm^3 ' 8882 print*,' use this default [1] yes ' print*,' [2] no ' read*,ianq if(ianq.lt.1.or.ianq.gt.2) go to 8882 write(18,*) ianq print*,' >>>> ',ianq if(ianq.eq.2) then print*,' input D0^2 MeV^2 fm^3 ' read*,a(4) write(18,*) a(4) print*,' >>>> ',a(4) endif *--------------------------------------------------------------------- else if(ireac.eq.10.or.ireac.eq.11) then print*,' vertex constant D0 = -469.0 MeV fm^3/2 ' print*,' e.g. Phys. Rev. C 4 (1971) 196 ' a(4)=469.0d0**2 print*,' this gives D0^2 = ',real(a(4)),' MeV^2 fm^3 ' 8889 print*,' use this default [1] yes ' print*,' [2] no ' read*,ianq if(ianq.lt.1.or.ianq.gt.2) go to 8889 write(18,*) ianq print*,' >>>> ',ianq if(ianq.eq.2) then print*,' input D0^2 MeV^2 fm^3 ' read*,a(4) write(18,*) a(4) print*,' >>>> ',a(4) endif *--------------------------------------------------------------------- else if(ireac.eq.12.or.ireac.eq.13) then print*,' vertex constant D0 = -469.0 MeV fm^3/2 ' print*,' e.g. Phys. Rev. C 4 (1971) 196 ' a(4)=469.0d0**2 print*,' this gives D0^2 = ',real(a(4)),' MeV^2 fm^3 ' 8669 print*,' use this default [1] yes ' print*,' [2] no ' read*,ianq if(ianq.lt.1.or.ianq.gt.2) go to 8669 write(18,*) ianq print*,' >>>> ',ianq if(ianq.eq.2) then print*,' input D0^2 MeV^2 fm^3 ' read*,a(4) write(18,*) a(4) print*,' >>>> ',a(4) endif *--------------------------------------------------------------------- else if(ireac.eq.14) then 5559 print*,' <3He|a> vertex constant D0 ' print*,' [1] -539.0 MeV fm^3/2 (from dwuck4 range) ' print*,' [2] -455.0 MeV fm^3/2 (Barnwell,ZR+nonloc) ' print*,' [3] -275.0 MeV fm^3/2 (Barnwell,ZR+LEA+nonloc) ' read*,ianq if(ianq.lt.1.or.ianq.gt.3) go to 5559 write(18,*) ianq print*,' >>>> ',ianq a(4)=539.0d0**2 if(ianq.eq.2) a(4)=455.0d0**2 if(ianq.eq.3) a(4)=275.0d0**2 print*,' this gives D0^2 = ',real(a(4)),' MeV^2 fm^3 ' 8872 print*,' use this default [1] yes ' print*,' [2] no ' read*,ianq if(ianq.lt.1.or.ianq.gt.2) go to 8872 write(18,*) ianq print*,' >>>> ',ianq if(ianq.eq.2) then print*,' input D0^2 MeV^2 fm^3 ' read*,a(4) write(18,*) a(4) print*,' >>>> ',a(4) endif *--------------------------------------------------------------------- else if(ireac.eq.15) then 5779 print*,' vertex constant D0 ' print*,' [1] -539.0 MeV fm^3/2 (from dwuck4 range) ' print*,' [2] -455.0 MeV fm^3/2 (Barnwell,ZR+nonloc) ' print*,' [3] -275.0 MeV fm^3/2 (Barnwell,ZR+LEA+nonloc) ' read*,ianq if(ianq.lt.1.or.ianq.gt.3) go to 5779 write(18,*) ianq print*,' >>>> ',ianq a(4)=539.0d0**2 if(ianq.eq.2) a(4)=455.0d0**2 if(ianq.eq.3) a(4)=275.0d0**2 print*,' this gives D0^2 = ',real(a(4)),' MeV^2 fm^3 ' 8772 print*,' use this default [1] yes ' print*,' [2] no ' read*,ianq if(ianq.lt.1.or.ianq.gt.2) go to 8772 write(18,*) ianq print*,' >>>> ',ianq if(ianq.eq.2) then print*,' input D0^2 MeV^2 fm^3 ' read*,a(4) write(18,*) a(4) print*,' >>>> ',a(4) endif endif *--------------------------------------------------------------------- write(17,33) (a(i),i=1,5) 33 format(0p3f10.4,f10.2,3f10.4) *--------------------------------------------------------------------- * finite range correction: light particle vertex - card 10.01 *--------------------------------------------------------------------- a(1)=10.01 print*,'----------------------------------------------------' if(ireac.eq.1) then print*,' Treatment of finite range (fnrng) of vertex ' else if(ireac.eq.3) then print*,' Treatment of finite range (fnrng) of vertex ' else if(ireac.eq.2) then print*,' Treatment of finite range (fnrng) of vertex ' else if(ireac.eq.4) then print*,' Treatment of finite range (fnrng) of vertex ' else if(ireac.eq.5) then print*,' Treatment of finite range (fnrng) of vertex ' else if(ireac.eq.6) then print*,' Treatment of finite range (fnrng) of vertex' else if(ireac.eq.7) then print*,' Treatment of finite range (fnrng) of <3He|d> vertex' else if(ireac.eq.8) then print*,' Treatment of finite range (fnrng) of vertex ' print*,' Glendenning: Ch 9, Nuclear Spectroscopy and ' print*,' Reactions - recommends zero range for L<= 2 ' print*,' (p,t) or (t,p) reactions. ' else if(ireac.eq.9) then print*,' Treatment of finite range (fnrng) of vertex ' print*,' Glendenning: Ch 9, Nuclear Spectroscopy and ' print*,' Reactions - recommends zero range for L<= 2 ' print*,' (p,t) or (t,p) reactions. ' else if(ireac.eq.10) then print*,' Treatment of finite range (fnrng) of vertex ' print*,' Glendenning: Ch 9, Nuclear Spectroscopy and ' print*,' Reactions - recommends zero range for L<= 2 ' print*,' (p,t) or (t,p) reactions. ' else if(ireac.eq.11) then print*,' Treatment of finite range (fnrng) of <3He|n> vertex ' print*,' Glendenning: Ch 9, Nuclear Spectroscopy and ' print*,' Reactions - recommends zero range for L<= 2 ' print*,' (p,t) or (t,p) reactions. ' else if(ireac.eq.12) then print*,' Treatment of finite range (fnrng) of vertex ' print*,' Glendenning: Ch 9, Nuclear Spectroscopy and ' print*,' Reactions - recommends zero range for L<= 2 ' else if(ireac.eq.13) then print*,' Treatment of finite range (fnrng) of <3He|p> vertex ' print*,' Glendenning: Ch 9, Nuclear Spectroscopy and ' print*,' Reactions - recommends zero range for L<= 2 ' else if(ireac.eq.14) then print*,' Treatment of finite range (fnrng) of <3He|a> vertex' else if(ireac.eq.15) then print*,' Treatment of finite range (fnrng) of vertex' endif *--------------------------------------------------------------------- 884 print*,' [1] zero-range (fnrng = 0) ' print*,' [2] local-energy (default values) ' *--------------------------------------------------------------------- * if deuteron-nucleon vertex - default built-in values *--------------------------------------------------------------------- if(ireac.lt.5) then if(idwf.eq.1) print*,' default fnrng=0.745712 fm' if(idwf.eq.2) print*,' Reid SC fnrng=0.745650 fm' if(idwf.eq.3) print*,' AV18 fnrng=0.759392 fm' endif *--------------------------------------------------------------------- print*,' [3] local-energy (specify fnrng value) ' read*,izr if(izr.lt.1.or.izr.gt.3) go to 884 write(18,*) izr print*,' >>>> ',izr print*,'---------------------------------------------------- ' *--------------------------------------------------------------------- if(izr.eq.1) then a(2)=0.0 print*,' Zero-range calculation (fnrng = 0) ' *--------------------------------------------------------------------- else if(izr.eq.2) then if(ireac.lt.5) then if(idwf.eq.1) then a(2)=0.745712d0 print*,' Default finite range factor, fnrng=0.745712 fm' else if(idwf.eq.2) then a(2)=0.745650d0 print*,' Reid SC finite range factor, fnrng=0.745650 fm' else if(idwf.eq.3) then a(2)=0.759392d0 print*,' AV18 finite range factor, fnrng=0.759392 fm' endif else if(ireac.eq.5) then a(2)=0.746269d0 print*,' Hulthen finite range factor, fnrng=0.746269 fm' print*,' Nucl. Phys. A234 (1974) 301 ' else if(ireac.eq.6.or.ireac.eq.7) then a(2)=0.746269d0 print*,' Hulthen finite range factor, fnrng=0.746269 fm' print*,' Nucl. Phys. A234 (1974) 301 ' else if(ireac.eq.8.or.ireac.eq.9) then a(2)=0.746269d0 print*,' Hulthen finite range factor, fnrng=0.746269 fm' print*,' Uses same as (d,t), (d,3He), (3He,d) presently' else if(ireac.eq.10.or.ireac.eq.11) then a(2)=0.746269d0 print*,' Hulthen finite range factor, fnrng=0.746269 fm' print*,' Uses same as (d,t), (d,3He), (3He,d) presently' else if(ireac.eq.12.or.ireac.eq.13) then a(2)=0.746269d0 print*,' Hulthen finite range factor, fnrng=0.746269 fm' print*,' Uses same as (d,t), (d,3He), (3He,d) presently' else if(ireac.eq.14.or.ireac.eq.15) then a(2)=0.7d0 print*,' Hulthen finite range factor, fnrng=0.70 fm ' print*,' from dwuck4 appendix ' endif *--------------------------------------------------------------------- else if(izr.eq.3) then print*,' input local-energy vertex interaction range (fm) ' print*,' for conventions: DelVecchio and Daehnick PRC ' print*,' Vol 6 (1972) p2095 (DVD) ' print*,' [if +ve, Hulthen, fnrng = R of DVD ] ' print*,' [fnrng = 1/beta of Nucl. Phys. A241 (1975) 36 ] ' print*,' [if -ve, Gaussian, fnrng = 1/(2*epsilon) of DVD ] ' read*,a(2) write(18,*) real(a(2)) print*,' >>>> ',real(a(2)) endif write(17,102) (a(i),i=1,2) *--------------------------------------------------------------------- * formfactor line *--------------------------------------------------------------------- a(1)=10.41 a(2)=nodes * set the charges product correctly for stripping/pickup cases a(3)=nil if(ireac.eq.3.or.ireac.eq.6.or.ireac.eq.10.or.ireac.eq.12 + .or.ireac.eq.15) a(3)=z2 if(ireac.eq.10) a(3)=2.d0*a(3) if(ireac.eq.4.or.ireac.eq.7.or.ireac.eq.11.or.ireac.eq.13)a(3)=z1 if(ireac.eq.11) a(3)=2.d0*a(3) a(4)=sn a(5)=1.0 if(ireac.eq.8.or.ireac.eq.9.or.ireac.eq.10.or. # ireac.eq.11.or.ireac.eq.12.or.ireac.eq.13) a(5)=2.0 * set the core mass correctly for stripping/pickup cases if(ireac.eq.2.or.ireac.eq.4.or.ireac.eq.7.or.ireac.eq.9 # .or.ireac.eq.11.or.ireac.eq.13) then a(6)=a1 else a(6)=a2 endif a(7)=nil write(17,102) (a(i),i=1,7) *--------------------------------------------------------------------- * formfactor potential line *--------------------------------------------------------------------- a(1)=10.42 print*,'----------------------------------------------------' if(ireac.eq.1.or.ireac.eq.2.or.ireac.eq.5.or.ireac.eq.14) then print*,' neutron binding potential ' else if(ireac.eq.8.or.ireac.eq.9) then print*,' di-neutron binding potential ' else if(ireac.eq.10.or.ireac.eq.11) then print*,' di-proton binding potential ' else if(ireac.eq.12.or.ireac.eq.13) then print*,' (n+p) binding potential ' else print*,' proton binding potential ' endif print*,' radius and diffuseness (e.g. 1.25 0.65 fm)' read*,a(2),a(4) radius =a(2) diffuse=a(4) write(18,*) real(a(2)),real(a(4)) print*,' >>>> ',real(a(2)),real(a(4)) a(3)=a(2) if(ireac.eq.8.or.ireac.eq.9.or.ireac.eq.10.or.ireac.eq.11) then print*,' Spin-orbit: di-nucleon so input strength Vso = 0' else if(ireac.eq.12.or.ireac.eq.13) then if(ids.eq.0) print*,' Spin-orbit: S=0 so input Vso = 0' if(ids.eq.1) then print*,' Spin-orbit: S=1 so input Vso ' print*,' Spin-orbit: Vso is strength of L.S (~6.0 MeV)' endif else print*,' Spin-orbit: strength of l.sigma (~6.0 MeV) ' endif read*,a(5) if(ids.eq.0) a(5)=0.d0 if(ireac.eq. 8.or.ireac.eq. 9) a(5)=0.d0 if(ireac.eq.10.or.ireac.eq.11) a(5)=0.d0 vso=a(5) write(18,*) real(a(5)) print*,' >>>> ',real(a(5)) print*,' Bound state non-locality (0 usually) ' read*,a(6) write(18,*) real(a(6)) print*,' >>>> ',real(a(6)) write(17,102) (a(i),i=1,6) *--------------------------------------------------------------------- * formfactor line (for distinct spin-orbit geometry if |vso|>0) *--------------------------------------------------------------------- if(abs(vso).gt.1.d-3) then a(1)=10.43 print*,' Bound state spin-orbit radius parameter ' print*,' (if 0 entered, use the same geometry as ' print*,' input for the real central interaction) ' read*,a(2) write(18,*) real(a(2)) print*,' >>>> ',real(a(2)) if(abs(a(2)).lt.0.01d0) then a(2)=radius a(3)=diffuse goto 887 endif print*,' Bound state spin-orbit diffuseness parameter ' read*,a(3) write(18,*) real(a(3)) print*,' >>>> ',real(a(3)) 887 write(17,102) (a(i),i=1,3) endif write(17,102) *--------------------------------------------------------------------- * ends creation of tran.xxx data set - print summary information *--------------------------------------------------------------------- close(17) print* print*,'==================================================== ' print'(a,a)',' tran.'//fname,' dataset has been created: ' print 702,' for the [',ia1,',',iz1,'] ',crea(ireac),'[',ia2, # ',',iz2,'] reaction' 702 format(a,i3,a,i2,a,a,a,i3,a,i2,a) print*,'==================================================== ' print*,' when running twofnr the output files are as follows: ' print* print*,' Normal kinematics observables ' print*,' ------------------------------' print '(a,a)',' 20.'//fname,' cm - with all spin observables ' print '(a,a)',' 21.'//fname,' cm - sigma and Ay only ' print '(a,a)',' 22.'//fname,' lab - light in - light out ' print* print*,' Inverse kinematics observables ' print*,' ------------------------------ ' print '(a,a)',' 23.'//fname,' lab - heavy in - heavy out ' print '(a,a)',' 24.'//fname,' lab - heavy in - light out ' if(ktout(1).eq.8) then print* print*,' Rotated frame cm observables ' print*,' ---------------------------- ' print*,' input Euler angles (alfa,beta,gama) in units of pi ' print'(3x,3f8.3)',real(angal),real(angbe),real(angga) print '(a,a)',' 39.'//fname,' m-substates sigma_jm of transfer' print '(a,a)',' 40.'//fname,' cm - sigma of rotated amplitudes' print* print '(a,a)',' amp.'//fname,'transfer amplitude (for mixing) ' print*,'---------------------------------------------------- ' print*,' weighted linear combinations of such stored amp.xxx ' print*,' amplitudes and residual nucleus substate populations ' print*,' can be computed with a suitable additional data set ' 814 print*,' Options:' print*,'---------------------------------------------------- ' print*,' [1] do not create at this time ' print*,' [2] create a mixing data set ' read*,imix if(imix.lt.1.or.imix.gt.2) go to 814 write(18,*) imix print*,' >>>> ',imix if(imix.eq.1) then print*,'==================================================== ' stop endif ins=8 ktout(1)=9 ktout(3)=0 ktout(4)=0 fname=mix//fname title=titf//fname open(17,file='tran.'//fname,status='unknown') print '(a,a)',' Mix data is to file: ','tran.'//fname write(17,101) (ktout(i),i=1,10),ins,iday,imon,iyear,title 664 print*,' How many amplitudes are to be combined? ' read*,namp if(namp.le.0) then print*,' need at least one amplitude ' go to 664 endif write(18,*) namp print*,' >>>> ',namp do ia=1,namp print'(a,i3)',' name, i.e. xxx (of amp.xxx) amplitude',ia read'(a)',ampnam(ia) write(18,'(a)') ampnam(ia) print'(a,i3)',' spectroscopic amplitude for amplitude',ia read*,specamp write(18,*) specamp print'(a,a12,f8.4)',' >>>> ',ampnam(ia),real(specamp) write(17,432) real(ia),specamp,ampnam(ia) 432 format(f3.1,7x,f7.4,3x,a) enddo write(17,*)' ' close(17) print*,'==================================================== ' print'(a,a)',' tran.'//fname,' dataset has been created ' endif print*,'==================================================== ' end *--------------------------------------------------------------------- subroutine proton(energy,a1,z1,step,nrmax) implicit real*8(a-h,o-z) character nucleon,form*12 common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd common/cjlm/potr(900),poti(900),ijlm,ijlmp,ikd *--------------------------------------------------------------------- * woods-saxon potential formfactor statement functions *--------------------------------------------------------------------- ws (r,vv,r0,aa)=-vv/(1.d0+dexp((r-r0)/aa)) wsd(r,ww,w0,wa)=-ww*4.d0*dexp((r-w0)/wa)/(1.+dexp((r-w0)/wa))**2 wso(r,ww,w0,wa)= wsd(r,ww,w0,wa)/(2.d0*wa*r) *--------------------------------------------------------------------- * latter is coefficient of l.sigma for nucleons (ww~6MeV) *--------------------------------------------------------------------- 887 print*,' [1] Bechetti-Greenlees (A>40 2040 E>10 MeV) ' print*,' Phys Rep 201 (1991) 57 ' print*,' [3] Menet (30>>> ',inopt if(inopt.eq.1) then a=a1 ed=energy e=z1 an=(a-2.d0*e)/a a13=a**0.3333333333d0 vpr=54.d0-0.32d0*ed+0.4d0*e/a13+24.d0*an rr=1.17d0 ar=0.75d0 rpi=1.32d0 api=0.51d0+0.7d0*an wpi=11.8d0-0.25d0*ed+12.d0*an if(wpi.lt.0.d0) wpi=0.d0 wvpi=0.22d0*ed-2.7d0 if(wvpi.lt.0.d0) wvpi=0.d0 print 10,a print 101,e,ed 10 format(1h ,' bechetti greenlees potentials for a = ',f5.1) 101 format(1h ,' z = ',f4.1,' at ',f6.2,' MeV proton energy ') rcd=1.25d0 print*,' Coulomb radius parameter = ',real(rcd) print 111 111 format(1h ,' vr ro ao ws ri ai wv ') print 12,vpr,rr,ar,wpi,rpi,api,wvpi 12 format(1h ,7f7.3) vd=vpr rrd=rr ard=ar wd=wvpi rid=rpi aid=api wisd=wpi risid=rpi aisid=api vsod=6.2d0 rsord=1.01d0 asord=0.75d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 112 format(1h ,' vso rso aso ') print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.2) then a=a1 e=energy z=z1 n=nint(a-z) *--------------------------------------------------------------------- * CH86 parameters v0= 52.9d0 vt= 13.d0 ve= -0.3d0 r0= 1.25d0 r00= -0.24d0 a0= 0.69d0 rc= 1.24d0 rc0= 0.12d0 wv0= 10.d0 wve0= 35.d0 wvew= 15.d0 ws0= 9.d0 wst= 14.d0 wse0= 29.d0 wsew= 23.d0 rw= 1.32d0 rw0= -0.41d0 aw= 0.72d0 *--------------------------------------------------------------------- * CH89 parameters v0= 52.9d0 vt= 13.1d0 ve= -0.299d0 r0= 1.25d0 r00= -0.225d0 a0= 0.69d0 rc= 1.24d0 rc0= 0.12d0 wv0= 7.8d0 wve0= 35.d0 wvew= 16.d0 ws0= 10.d0 wst= 18.d0 wse0= 36.d0 wsew= 37.d0 rw= 1.33d0 rw0= -0.42d0 aw= 0.69d0 *--------------------------------------------------------------------- a13=a**(1.d0/3.d0) rrc=rc*a13+rc0 rcn=rrc/a13 ecpp=1.73d0*z/rrc erp=e-ecpp vrp=v0+vt*((n-z)/a)+erp*ve rp=r0*a13+r00 rpn=rp/a13 ap=a0 wvp=wv0/(1.d0+exp((wve0-erp)/wvew)) if(wvp.lt.0.d0) wvp=0.d0 rwp=rw*a13+rw0 rwpn=rwp/a13 awp=aw wsp=(ws0+wst*((n-z)/a))/(1.d0+exp((erp-wse0)/wsew)) if(wsp.lt.0.d0) wsp=0.d0 print 20,a print 101,z,e 20 format(1h ,' Chapel Hill 89 potentials for a = ',f5.1) rcd=rcn print*,' Coulomb radius parameter = ',real(rcd) print 111 print 12,vrp,rpn,ap,wsp,rwpn,awp,wvp vd=vrp rrd=rpn ard=ap wd=wvp rid=rwpn aid=awp wisd=wsp risid=rwpn aisid=awp *--------------------------------------------------------------------- * CH86 parameters vsod=5.9d0 rsord=(1.39d0*a13-1.43)/a13 asord=0.65d0 *--------------------------------------------------------------------- * CH89 parameters vsod=5.9d0 rsord=(1.34d0*a13-1.20)/a13 asord=0.63d0 *--------------------------------------------------------------------- wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.3) then a=a1 e=energy z=z1 n=nint(a-z) a13=a**0.3333333333d0 vrp=49.9d0-0.22*e+26.4*(n-z)/a+0.4*z/a13 wvp=1.2+0.09*e wsp=4.2-0.05*e+15.5*(n-z)/a if(wsp.lt.0.d0) wsp=0.d0 awp=0.74d0-0.008*e+(n-z)/a rrd=1.16d0 ard=0.75d0 rid=1.37d0 print 25,a print 101,z,e 25 format(1h ,' Menet potential for a = ',f5.1) rcd=1.25d0 print*,' Coulomb radius parameter = ',real(rcd) * print 11 print 111 print 12,vrp,rrd,ard,wsp,rid,awp,wvp vd=vrp wd=wvp aid=awp wisd=wsp risid=rid aisid=aid vsod=6.04d0 rsord=1.064d0 asord=0.78d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.4) then a=a1 e=energy z=z1 n=nint(a-z) a13=a**0.3333333333d0 vrp=53.3d0-0.55*e+27.0*(n-z)/a+0.4*z/a13 wvp=0.d0 wsp=13.5d0 rrd=1.25d0 ard=0.65d0 rid=1.25d0 awp=0.47d0 print 24,a print 101,z,e 24 format(1h ,' Perey potential for a = ',f5.1) rcd=1.25d0 print*,' Coulomb radius parameter = ',real(rcd) * print 11 print 111 print 12,vrp,rrd,ard,wsp,rid,awp,wvp vd=vrp wd=wvp aid=awp wisd=wsp risid=rid aisid=aid vsod=7.50d0 rsord=1.25d0 asord=0.47d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.5) then ijlmp=1 ijlm=1 print 29,a1 29 format(1h ,' JLM potential for a = ',f5.1) rcd=1.25d0 print*,' Coulomb radius parameter = ',real(rcd) print*,' printout is in',nrmax,' steps of',real(step) vd=1.d0 rrd=99.d0 ard=1.d0 wd=1.d0 rid=99.d0 aid=1.d0 wisd=0.d0 risid=rid aisid=1.d0 vsod=0.d0 rsord=1.d0 asord=1.d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 form='(5e14.7)' nucleon='p' call jlm(potr,poti,nucleon,a1,z1,energy,step,nrmax) endif *--------------------------------------------------------------------- if(inopt.eq.6) then * KD02 Koning-Delaroche for proton (Pang/KD02 code) a=a1 e=energy z=z1 n=nint(a-z) * defined in KD02 rvKD=1.3039-0.4054*A**(-1./3.) avKD=0.6778-1.487e-4*A rwKD=rvKD awKD=avKD v4KD=7.0e-9 w2KD=73.55+0.0795*A rvdKD=1.3424-0.01585*A**(1./3.) rwdKD=rvdKD vdKD=0. d2KD=0.0180+3.802e-3/(1.+exp((A-156.)/8.)) d3KD=11.5 vso1KD=5.922+0.0030*A vso2KD=0.0040 rvsoKD=1.1854-0.647*A**(-1./3.) rwsoKD=rvsoKD avsoKD=0.59 awsoKD=avsoKD wso1KD=-3.1 wso2KD=160. efKD=-8.4075+0.01378*A v1KD=59.30+21.0*real(N-Z)/A-0.024*A v2KD=7.067e-3+4.23e-6*A v3KD=1.729e-5+1.136e-8*A w1KD=14.667+0.009629*A avdKD=0.5187+5.205e-4*A awdKD=avdKD d1KD=16.0+16.0*real(N-Z)/A rcKD=1.198+0.697*A**(-2./3.)+12.994*A**(-5./3.) fKD=E-efKD * Coulomb VcKD=1.73/rcKD*Z/(A**(1./3.)) vcoulKD=VcKD*v1KD*(v2KD-2.*v3KD*fKD+3.*v4KD*fKD*fKD) vKD=v1KD*(1.-v2KD*fKD+v3KD*fKD**2-v4KD*fKD**3)+vcoulKD wKD=w1KD*fKD**2/(fKD**2+w2KD**2) vdKD=0. wdKD=d1KD*fKD**2*exp(-d2KD*fKD)/(fKD**2+d3KD**2) vsoKD=vso1KD*exp(-vso2KD*fKD) wsoKD=wso1KD*fKD**2/(fKD**2+wso2KD**2) vd = vKD rrd = rvKD ard = avKD wd = wKD rid = rrd aid = ard wisd = wdKD risid = rwdKD aisid = awdKD print 60,a print 101,z,e 60 format(1h ,' KD02 potential for a = ',f5.1) rcd=rcKD print*,' Coulomb radius parameter = ',real(rcd) print 1112 1112 format(1h ,' v rv av w rw aw ') print 122, vd,rrd,ard,wd,rid,aid print 1312 1312 format(1h ,' ws rws aws ') print 122, wisd,risid,aisid 122 format(1h ,9f7.3) * KD02 spin-orbit vsod=vsoKD rsord=rvsoKD asord=avsoKD wsod=wsoKD rsoid=rwsoKD asoid=awsoKD print 1129 1129 format(1h ,' vso rso aso wso rsoi asoi ') print 122,vsod,rsord,asord,wsod,rsoid,asoid ikd=1 *--------------------------------------------------------------------- * twofnr assumes the same geometry for the volume and surface * imaginary potentials. KD does not have the same geometry so * compute to print the imaginary part as two shapes involved *--------------------------------------------------------------------- a13=a**(1./3.) brid =rid *a13 brisd=risid*a13 do ii=1,nrmax r=ii*step poti(ii)=ws(r,wd,brid,aid)+wsd(r,wisd,brisd,aisid) enddo wd=1.d0 rid=99.d0 aid=1.d0 wisd=0.d0 risid=rid aisid=1.d0 endif return end *--------------------------------------------------------------------- subroutine neutron(energy,a1,z1,step,nrmax) implicit real*8(a-h,o-z) character nucleon,form*12 common/cjlm/potr(900),poti(900),ijlm,ijlmp,ikd common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd *--------------------------------------------------------------------- * potential formfactor statement functions *--------------------------------------------------------------------- ws (r,vv,r0,aa)=-vv/(1.d0+dexp((r-r0)/aa)) wsd(r,ww,w0,wa)=-ww*4.d0*dexp((r-w0)/wa)/(1.+dexp((r-w0)/wa))**2 wso(r,ww,w0,wa)= wsd(r,ww,w0,wa)/(2.d0*wa*r) *--------------------------------------------------------------------- * latter is coefficient of l.sigma for nucleons (ww~6MeV) *--------------------------------------------------------------------- 888 print*,' [1] Bechetti-Greenlees (A>40 2040 E>10 MeV) ' print*,' Phys Rep 201 (1991) 57 ' * print*,' [3] Menet (30>>> ',inopt if(inopt.eq.1) then a=a1 ed=energy e=z1 an=(a-2.d0*e)/a a13=a**0.3333333333d0 vpr=56.3d0-0.32d0*ed-24.d0*an rr=1.17d0 ar=0.75d0 rpi=1.26d0 api=0.58d0 wpi=13.0d0-0.25d0*ed-12.d0*an if(wpi.lt.0.d0) wpi=0.d0 wvpi=0.22d0*ed-1.56d0 if(wvpi.lt.0.d0) wvpi=0.d0 print 10,a print 101,e,ed 10 format(1h ,' bechetti greenlees potentials for a = ',f5.1) 101 format(1h ,' z = ',f4.1,' at ',f6.2,' MeV neutron energy ') rcd=1.25d0 * print*,' Coulomb radius parameter = ',real(rcd) print 111 111 format(1h ,' vr ro ao ws ri ai wv ') print 12,vpr,rr,ar,wpi,rpi,api,wvpi 12 format(1h ,7f7.3) vd=vpr rrd=rr ard=ar wd=wvpi rid=rpi aid=api wisd=wpi risid=rpi aisid=api vsod=6.2d0 rsord=1.01d0 asord=0.75d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 112 format(1h ,' vso rso aso ') print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.2) then a=a1 e=energy z=z1 n=nint(a-z) *--------------------------------------------------------------------- * CH86 parameters v0= 52.9d0 vt= 13.d0 ve= -0.3d0 r0= 1.25d0 r00= -0.24d0 a0= 0.69d0 rc= 1.24d0 rc0= 0.12d0 wv0= 10.d0 wve0= 35.d0 wvew= 15.d0 rw= 1.32d0 rw0= -0.41d0 aw= 0.72d0 ws0= 9.d0 wst= 14.d0 wse0= 29.d0 wsew= 23.d0 *--------------------------------------------------------------------- * CH89 parameters v0= 52.9d0 vt= 13.1d0 ve= -0.299d0 r0= 1.25d0 r00= -0.225d0 a0= 0.69d0 rc= 1.24d0 rc0= 0.12d0 wv0= 7.8d0 wve0= 35.d0 wvew= 16.d0 ws0= 10.d0 wst= 18.d0 wse0= 36.d0 wsew= 37.d0 rw= 1.33d0 rw0= -0.42d0 aw= 0.69d0 *--------------------------------------------------------------------- a13=a**(1.d0/3.d0) rrc=rc*a13+rc0 rcn=rrc/a13 ecpp=0.d0 erp=e-ecpp vrp=v0-vt*((n-z)/a)+erp*ve rp=r0*a13+r00 rpn=rp/a13 ap=a0 wvp=wv0/(1.d0+exp((wve0-erp)/wvew)) if(wvp.lt.0.d0) wvp=0.d0 rwp=rw*a13+rw0 rwpn=rwp/a13 awp=aw wsp=(ws0-wst*((n-z)/a))/(1.d0+exp((erp-wse0)/wsew)) if(wsp.lt.0.d0) wsp=0.d0 print 20,a print 101,z,e 20 format(1h ,' Chapel Hill 89 potentials for a = ',f5.1) rcd=rcn * print*,' Coulomb radius parameter = ',real(rcd) print 111 print 12,vrp,rpn,ap,wsp,rwpn,awp,wvp vd=vrp rrd=rpn ard=ap wd=wvp rid=rwpn aid=awp wisd=wsp risid=rwpn aisid=awp *--------------------------------------------------------------------- * CH86 parameters vsod=5.9d0 rsord=(1.39d0*a13-1.43)/a13 asord=0.65d0 *--------------------------------------------------------------------- * CH89 parameters vsod=5.9d0 rsord=(1.34d0*a13-1.20)/a13 asord=0.63d0 *--------------------------------------------------------------------- wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.98) then a=a1 e=energy z=z1 n=nint(a-z) a13=a**0.3333333333d0 vrp=49.9d0-0.22*e+26.4*(n-z)/a+0.4*z/a13 wvp=1.2+0.09*e wsp=4.2-0.05*e+15.5*(n-z)/a if(wsp.lt.0.d0) wsp=0.d0 awp=0.74d0-0.008*e+(n-z)/a rrd=1.16d0 ard=0.75d0 rid=1.37d0 print 25,a print 101,z,e 25 format(1h ,' Menet potential for a = ',f5.1) rcd=1.25d0 print*,' Coulomb radius parameter = ',real(rcd) * print 11 print 111 print 12,vrp,rrd,ard,wsp,rid,awp,wvp vd=vrp wd=wvp aid=awp wisd=wsp risid=rid aisid=aid vsod=6.04d0 rsord=1.064d0 asord=0.78d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.99) then a=a1 e=energy z=z1 n=nint(a-z) a13=a**0.3333333333d0 vrp=53.3d0-0.55*e+27.0*(n-z)/a+0.4*z/a13 wvp=0.d0 wsp=13.5d0 rrd=1.25d0 ard=0.65d0 rid=1.25d0 awp=0.47d0 print 24,a print 101,z,e 24 format(1h ,' Perey potential for a = ',f5.1) rcd=1.25d0 * print*,' Coulomb radius parameter = ',real(rcd) * print 11 print 111 print 12,vrp,rrd,ard,wsp,rid,awp,wvp vd=vrp wd=wvp aid=awp wisd=wsp risid=rid aisid=aid vsod=7.50d0 rsord=1.25d0 asord=0.47d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.3) then ijlmp=1 ijlm=1 print 29,a1 29 format(1h ,' JLM potential for a = ',f5.1) rcd=1.25d0 * print*,' Coulomb radius parameter = ',real(rcd) print*,' printout is in',nrmax,' steps of',real(step) vd=1.d0 rrd=99.d0 ard=1.d0 wd=1.d0 rid=99.d0 aid=1.d0 wisd=0.d0 risid=rid aisid=1.d0 vsod=0.d0 rsord=1.d0 asord=1.d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 form='(5e14.7)' nucleon='n' call jlm(potr,poti,nucleon,a1,z1,energy,step,nrmax) endif *--------------------------------------------------------------------- if(inopt.eq.4) then * KD02 Koning-Delaroche for neutron (Pang code) a=a1 e=energy z=z1 n=nint(a-z) * defined in KD02 rvKD=1.3039-0.4054*A**(-1./3.) avKD=0.6778-1.487e-4*A rwKD=rvKD awKD=avKD v4KD=7.0e-9 w2KD=73.55+0.0795*A rvdKD=1.3424-0.01585*A**(1./3.) rwdKD=rvdKD vdKD=0. d2KD=0.0180+3.802e-3/(1.+exp((A-156.)/8.)) d3KD=11.5 vso1KD=5.922+0.0030*A vso2KD=0.0040 rvsoKD=1.1854-0.647*A**(-1./3.) rwsoKD=rvsoKD avsoKD=0.59 awsoKD=avsoKD wso1KD=-3.1 wso2KD=160. efKD=-11.2814+0.02646*A v1KD=59.30-21.0*real(N-Z)/A-0.024*A v2KD=7.228e-3-1.48e-6*A v3KD=1.994e-5-2.0e-8*A w1KD=12.195+0.0167*A d1KD=16.0-16.0*real(N-Z)/A avdKD=0.5446-1.656e-4*A awdKD=avdKD rcKD=1. fKD=E-efKD * Coulomb vcoulKD=0. vKD=v1KD*(1.-v2KD*fKD+v3KD*fKD**2-v4KD*fKD**3)+vcoulKD wKD=w1KD*fKD**2/(fKD**2+w2KD**2) vdKD=0. wdKD=d1KD*fKD**2*exp(-d2KD*fKD)/(fKD**2+d3KD**2) vsoKD=vso1KD*exp(-vso2KD*fKD) wsoKD=wso1KD*fKD**2/(fKD**2+wso2KD**2) vd = vKD rrd = rvKD ard = avKD wd = wKD rid = rrd aid = ard wisd = wdKD risid = rwdKD aisid = awdKD print 60,a print 101,z,e 60 format(1h ,' KD02 systematics for a = ',f5.1) rcd=rcKD print*,' Coulomb radius parameter = ',real(rcd) print 1112 1112 format(1h ,' v rv av w rw aw ') print 122, vd,rrd,ard,wd,rid,aid print 1312 1312 format(1h ,' ws rws aws ') print 122, wisd,risid,aisid 122 format(1h ,9f7.3) * KD02 spin-orbit vsod=vsoKD rsord=rvsoKD asord=avsoKD wsod=wsoKD rsoid=rwsoKD asoid=awsoKD print 1129 1129 format(1h ,' vso rso aso wso rsoi asoi ') print 122,vsod,rsord,asord,wsod,rsoid,asoid ikd=1 *--------------------------------------------------------------------- * twofnr assumes the same geometry for the volume and surface * imaginary potentials. KD does not have the same geometry so * compute to print the imaginary part as two shapes involved *--------------------------------------------------------------------- a13=a**(1./3.) brid =rid *a13 brisd=risid*a13 do ii=1,nrmax r=ii*step poti(ii)=ws(r,wd,brid,aid)+wsd(r,wisd,brisd,aisid) enddo wd=1.d0 rid=99.d0 aid=1.d0 wisd=0.d0 risid=rid aisid=1.d0 endif return end *--------------------------------------------------------------------- subroutine deuteron(energy,a1,z1,ireac,inonloc) implicit real*8(a-h,o-z) character fname*12 common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd common/deut/iadia,iwat,ideutwf,ii,imso common/file/fname *--------------------------------------------------------------------- 889 print*,'----------------------------------------------------' print*,' Optical potentials for DWBA ' print*,' ' print*,' [1] Lohr-Haeberli (A>40 827 12>>> ',inopt if(inopt.eq.1) then a=a1 e=energy z=z1 n=nint(a-z) a13=a**0.3333333333d0 vrp=91.13+2.2*z/a13 wvp=0.d0 wsp=218.d0/a13/a13 rrd=1.05d0 ard=0.86d0 rid=1.43d0 awp=0.5d0+0.013*a13*a13 print 20,a 20 format(1h ,' LH deuteron potential for a = ',f5.1) print 101,z,e 101 format(1h ,' z = ',f4.1,' at ',f6.2,' MeV deuteron energy ') rcd=1.30d0 print*,' Coulomb radius parameter = ',real(rcd) print 111 111 format(1h ,' vr ro ao ws ri ai wv ') print 12,vrp,rrd,ard,wsp,rid,awp,wvp 12 format(1h ,7f7.3) vd=vrp wd=wvp aid=awp wisd=wsp risid=rid aisid=aid vsod=7.0d0/2.d0 rsord=0.75d0 asord=0.50d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.2) then a=a1 e=energy z=z1 n=nint(a-z) a13=a**0.3333333333d0 vrp=81.1-0.22*e+2.0*z/a13 wvp=0.d0 wsp=14.4+0.24*e rrd=1.15d0 ard=0.81d0 rid=1.34d0 awp=0.68d0 print 21,a 21 format(1h ,' P-P deuteron potential for a = ',f5.1) print 101,z,e rcd=1.15d0 print*,' Coulomb radius parameter = ',real(rcd) print 111 print 12,vrp,rrd,ard,wsp,rid,awp,wvp vd=vrp wd=wvp aid=awp wisd=wsp risid=rid aisid=aid vsod=0.0d0 rsord=1.d0 asord=1.d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.3) then a=a1 e=energy bet=-(e/100.d0)**2 bet=exp(bet) z=z1 n=nint(a-z) a13=a**0.3333333333d0 vrp=88.5-0.26*e+0.88*z/a13 wvp=(12.2+0.026*e)*(1.d0-bet) wsp=(12.2+0.026*e)*(bet) rrd=1.17d0 ard=0.709d0+0.0017*e rid=1.325d0 awp=0.53d0+0.07*a13 awp=awp-0.04*exp(-(( 8-n)/2.d0)**2) awp=awp-0.04*exp(-(( 20-n)/2.d0)**2) awp=awp-0.04*exp(-(( 28-n)/2.d0)**2) awp=awp-0.04*exp(-(( 50-n)/2.d0)**2) awp=awp-0.04*exp(-(( 82-n)/2.d0)**2) awp=awp-0.04*exp(-((126-n)/2.d0)**2) print 23,a 23 format(1h ,' Daehnick deuteron potential for a = ',f5.1) print 101,z,e rcd=1.30d0 print*,' Coulomb radius parameter = ',real(rcd) vd=Vrp wd=Wvp aid=awp wisd=Wsp risid=rid aisid=aid vsod=(7.33d0-0.029*e)/2.d0 rsord=1.07d0 asord=0.66d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 111 print 12,vrp,rrd,ard,wsp,rid,awp,wvp print 112 112 format(1h ,' vso rso aso ') print 12,vsod,rsord,asord endif *--------------------------------------------------------------------- if(inopt.eq.4) then iwat=1 iadia=0 print 33,a1 33 format(1h ,' Watanabe deuteron potential for a = ',f5.1) print 101,z1,energy print*,' from one of the nucleon potentials: ' rcd=1.30d0 print*,' Coulomb radius parameter = ',real(rcd) vd=1.d0 rrd=99.d0 ard=1.d0 wd=1.d0 rid=99.d0 aid=1.d0 wisd=0.d0 risid=rid aisid=1.d0 vsod=1.d0 rsord=99.d0 asord=1.d0 wsod=1.d0 rsoid=99.d0 asoid=1.d0 print* 701 print*,' Deuteron wave function for Watanabe folding ' print*,'----------------------------------------------------' print*,' [1] Reid soft-core wfn and interaction ' print*,' [2] Hulthen S+D-state wave function ' print*,' [3] Hulthen S-state only wave function ' print*,' [4] AV18 deuteron wave function ' print*,'----------------------------------------------------' read*,ideutwf if(ideutwf.lt.1.or.ideutwf.gt.4) go to 701 open(77,file='deutwf.'//fname,status='unknown') write(18,*) ideutwf print*,' >>>> ',ideutwf if(ideutwf.eq.1) then print*,' Reid soft-core wfn and interaction ' else if(ideutwf.eq.2) then print*,' Hulthen S+D-state wave function ' else if(ideutwf.eq.3) then print*,' Hulthen S-state only wave function ' else if(ideutwf.eq.4) then print*,' AV18 deuteron wave function ' endif endif *--------------------------------------------------------------------- if(ireac.lt.5.and.inopt.gt.4) then if(inonloc.eq.2) then print*,'----------------------------------------------------' print*,' Conventional Perey-Buck type nonlocality was chosen' print*,' plus an adiabatic deuteron channel description ' print*,' This is not well founded - and NOT recommended ' print*,'----------------------------------------------------' endif iadia=inopt iw=0 if(iadia.eq.5) then print 27,a1 27 format(1h ,' ZR Adiabatic deuteron potential for a = ',f5.1) else print 57,a1 57 format(1h ,' FR Adiabatic deuteron potential for a = ',f5.1) endif print 101,z1,energy print*,' from one of the nucleon potentials: ' rcd=1.30d0 print*,' Coulomb radius parameter = ',real(rcd) vd=1.d0 rrd=99.d0 ard=1.d0 wd=1.d0 rid=99.d0 aid=1.d0 wisd=0.d0 risid=rid aisid=1.d0 vsod=1.d0 rsord=99.d0 asord=1.d0 wsod=1.d0 rsoid=99.d0 asoid=1.d0 if(iadia.eq.6) then print* 702 print*,' Deuteron wave function for adiabatic folding' print*,'----------------------------------------------------' print*,' [1] Reid soft-core wfn and interaction ' print*,' [2] Hulthen S+D-state wave function ' print*,' [3] Hulthen S-state only wave function ' print*,' [4] AV18 deuteron wave function ' print*,'----------------------------------------------------' read*,ideutwf if(ideutwf.lt.1.or.ideutwf.gt.4) go to 702 open(77,file='deutwf.'//fname,status='unknown') write(18,*) ideutwf print*,' >>>> ',ideutwf if(ideutwf.eq.1) then print*,' Reid soft-core wfn and interaction ' else if(ideutwf.eq.2) then print*,' Hulthen S+D-state wave function ' else if(ideutwf.eq.3) then print*,' Hulthen S-state only wave function ' else if(ideutwf.eq.4) then print*,' AV18 deuteron wave function ' endif endif endif return end *--------------------------------------------------------------------- subroutine adiab(energy,a,z,step,nrmax) implicit real*8(a-h,o-z) real*8 prn(900),pin(900),prp(900),pip(900),pson(900),psop(900) real*8 vreal(900),vimag(900),vspin(900),vspii(900),pgrid(900) character form*12,nucleon,fname*12 real*8 psin(900),psip(900) common/folded/prn,pin,pson,psin,prp,pip,psop,psip,pgrid common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd common/cjlm/potr(900),poti(900),ijlm,ijlmp,ikd common/fromfold/vreal,vimag,vspin,vspii common/deut/iadia,iwat,ideutwf,ii,imso common/djlm/rlr,rli common/file/fname *--------------------------------------------------------------------- * woods-saxon potential formfactor statement functions *--------------------------------------------------------------------- ws (r,vv,r0,aa)=-vv/(1.d0+dexp((r-r0)/aa)) wsd(r,ww,w0,wa)=-ww*4.d0*dexp((r-w0)/wa)/(1.+dexp((r-w0)/wa))**2 wso(r,ww,w0,wa)= wsd(r,ww,w0,wa)/(2.d0*wa*r) *--------------------------------------------------------------------- * latter is coefficient of l.sigma for nucleons (ww~6MeV) *--------------------------------------------------------------------- * we are here if iadia > 0 or iwat > 0 *--------------------------------------------------------------------- open(36,file='folded.'//fname,status='unknown') do ii=1,900 prn(ii)= 0.d0 pin(ii)= 0.d0 pson(ii)=0.d0 psin(ii)=0.d0 prp(ii)= 0.d0 pip(ii)= 0.d0 psop(ii)=0.d0 psip(ii)=0.d0 vreal(ii)=0.d0 vimag(ii)=0.d0 vspin(ii)=0.d0 vspii(ii)=0.d0 enddo form='(5e14.7)' imso=0 *--------------------------------------------------------------------- 890 print*,' [1] Bechetti-Greenlees (A>40 2040 E>10 MeV) ' print*,' Phys Rep 201 (1991) 57 ' print*,' [3] JLM microscopic optical potential ' print*,' Bauge implementation PRC 58, 1120 ' print*,' [4] Koning-Delaroche global potential ' print*,' Nucl Phys A713 (2003) 231 ' print*,'----------------------------------------------------' *--------------------------------------------------------------------- read*,inopt if(inopt.lt.1.or.inopt.gt.4) go to 890 write(18,*) inopt print*,' >>>> ',inopt *--------------------------------------------------------------------- if(inopt.eq.1) then *--------------------------------------------------------------------- * use half the deuteron energy *--------------------------------------------------------------------- ed=energy/2.d0 e=z an=(a-2.d0*e)/a a13=a**0.3333333333d0 vpr=54.d0-0.32d0*ed+0.4d0*e/a13+24.d0*an vnr=56.3d0-0.32d0*ed-24.d0*an rr=1.17d0 ar=0.75d0 rpi=1.32d0 rni=1.26d0 api=0.51d0+0.7d0*an ani=0.58d0 wpi=11.8d0-0.25d0*ed+12.d0*an wni=13.0d0-0.25d0*ed-12.d0*an if(wpi.lt.0.d0) wpi=0.d0 if(wni.lt.0.d0) wni=0.d0 wvpi=0.22d0*ed-2.7d0 wvni=0.22d0*ed-1.56d0 if(wvpi.lt.0.d0) wvpi=0.d0 if(wvni.lt.0.d0) wvni=0.d0 print 10,a print 101,e,ed 10 format(1h ,' bechetti greenlees potentials for a = ',f5.1) 101 format(1h ,' z = ',f4.1,' at ',f6.2,' MeV nucleon energy ') print 11 print 111 11 format(1h ,' proton ') 111 format(1h ,' vr ro ao ws ri ai wv ') print 12,vpr,rr,ar,wpi,rpi,api,wvpi print 19 print 191 print* 19 format(1h ,' neutron') 191 format(1h ,' vr ro ao ws ri ai wv ') print 12,vnr,rr,ar,wni,rni,ani,wvni 12 format(1h ,7f7.3) vso=6.2d0 rso=1.01d0 aso=0.75d0 print 112 112 format(1h ,' vso rso aso ') print 12,vso,rso,aso *--------------------------------------------------------------------- rr =rr *a13 rpi=rpi*a13 rni=rni*a13 rso=rso*a13 * for /folded/prn,pin,pson,prp,pip,psop do ii=1,nrmax r=ii*step pgrid(ii)=r prn(ii)=ws(r,vnr,rr,ar) pin(ii)=ws(r,wvni,rni,ani)+wsd(r,wni,rni,ani) pson(ii)=wso(r,vso,rso,aso) prp(ii)=ws(r,vpr,rr,ar) pip(ii)=ws(r,wvpi,rpi,api)+wsd(r,wpi,rpi,api) psop(ii)=pson(ii) * if zero-range adiabatic then construct coincidence potentials if(iadia.eq.5) then vreal(ii)=prn(ii)+prp(ii) vimag(ii)=pin(ii)+pip(ii) * mean coincidence n and p spin-orbit form factor vspin(ii)=(pson(ii)+psop(ii))/2.d0 endif enddo if(iadia.eq.5) then print*,'printout is in',nrmax,' steps of',real(step) write(17,'(a)') form write(17,'(5e14.7)')(vreal(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vimag(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspin(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspii(ii),ii=1,nrmax) print*,'potential is written to tran and folded ' do ii=1,nrmax r=ii*step write(36,1077) r,vreal(ii),vimag(ii),vspin(ii),vspii(ii) enddo endif endif *--------------------------------------------------------------------- if(inopt.eq.2) then e=energy/2.d0 n=nint(a-z) *--------------------------------------------------------------------- * CH86 parameters v0= 52.9d0 vt= 13.d0 ve= -0.3d0 r0= 1.25d0 r00= -0.24d0 a0= 0.69d0 rc= 1.24d0 rc0= 0.12d0 wv0= 10.d0 wve0= 35.d0 wvew= 15.d0 rw= 1.32d0 rw0= -0.41d0 aw= 0.72d0 ws0= 9.d0 wst= 14.d0 wse0= 29.d0 wsew= 23.d0 *--------------------------------------------------------------------- * CH89 parameters v0= 52.9d0 vt= 13.1d0 ve= -0.299d0 r0= 1.25d0 r00= -0.225d0 a0= 0.69d0 rc= 1.24d0 rc0= 0.12d0 wv0= 7.8d0 wve0= 35.d0 wvew= 16.d0 ws0= 10.d0 wst= 18.d0 wse0= 36.d0 wsew= 37.d0 rw= 1.33d0 rw0= -0.42d0 aw= 0.69d0 *--------------------------------------------------------------------- a13=a**(1.d0/3.d0) rrc=rc*a13+rc0 rcn=rrc/a13 ecpp=1.73d0*z/rrc ecnn=0.d0 erp=e-ecpp ern=e-ecnn vrp=v0+vt*((n-z)/a)+erp*ve vrn=v0-vt*((n-z)/a)+ern*ve rp=r0*a13+r00 rpn=rp/a13 rn=rpn ap=a0 an=ap wvp=wv0/(1.d0+exp((wve0-erp)/wvew)) wvn=wv0/(1.d0+exp((wve0-ern)/wvew)) if(wvp.lt.0.d0) wvp=0.d0 if(wvn.lt.0.d0) wvn=0.d0 rwp=rw*a13+rw0 rwpn=rwp/a13 rwn=rwpn awp=aw awn=awp wsp=(ws0+wst*((n-z)/a))/(1.d0+exp((erp-wse0)/wsew)) wsn=(ws0-wst*((n-z)/a))/(1.d0+exp((ern-wse0)/wsew)) if(wsp.lt.0.d0) wsp=0.d0 if(wsn.lt.0.d0) wsn=0.d0 print 20,a print 101,z,e 20 format(1h ,' Chapel Hill 89 potentials for a = ',f5.1) print 11 print 111 print 12,vrp,rpn,ap,wsp,rwpn,awp,wvp print * print 19 print 191 print 12,vrn,rn,an,wsn,rwn,awn,wvn *--------------------------------------------------------------------- * CH86 parameters vso=5.9d0 rso=(1.39d0*a13-1.43)/a13 aso=0.65d0 *--------------------------------------------------------------------- * CH89 parameters vso=5.9d0 rso=(1.34d0*a13-1.20)/a13 aso=0.63d0 *--------------------------------------------------------------------- print 112 print 12,vso,rso,aso *--------------------------------------------------------------------- rr =rpn*a13 rpi=rwpn*a13 rni=rwn*a13 rso=rso*a13 * for /folded/prn,pin,pson,prp,pip,psop do ii=1,nrmax r=ii*step pgrid(ii)=r prn(ii)=ws(r,vrn,rr,ap) pin(ii)=ws(r,wvn,rni,awn)+wsd(r,wsn,rni,awn) pson(ii)=wso(r,vso,rso,aso) prp(ii)=ws(r,vrp,rr,ap) pip(ii)=ws(r,wvp,rpi,awp)+wsd(r,wsp,rpi,awp) psop(ii)=pson(ii) * if zero-range adiabatic then construct coincidence potentials if(iadia.eq.5) then vreal(ii)=prn(ii)+prp(ii) vimag(ii)=pin(ii)+pip(ii) * mean coincidence n and p spin-orbit form factor vspin(ii)=(pson(ii)+psop(ii))/2.d0 endif enddo if(iadia.eq.5) then print*,'printout is in',nrmax,' steps of',real(step) write(17,'(a)') form write(17,'(5e14.7)')(vreal(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vimag(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspin(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspii(ii),ii=1,nrmax) print*,'potential is written to tran and folded ' do ii=1,nrmax r=ii*step write(36,1077) r,vreal(ii),vimag(ii),vspin(ii),vspii(ii) enddo endif endif *--------------------------------------------------------------------- if(inopt.eq.3) then if(ijlm.eq.0) ijlm=1 ed=energy/2.d0 nucleon='n' call jlm(prn,pin,nucleon,a,z,ed,step,nrmax) nucleon='p' call jlm(prp,pip,nucleon,a,z,ed,step,nrmax) * for /folded/prn,pin,pson,prp,pip,psop do ii=1,nrmax r=ii*step pgrid(ii)=r * no spin-orbit currently in jlm option pson(ii)=0.d0 psop(ii)=pson(ii) * if zero-range adiabatic then construct coincidence potentials if(iadia.eq.5) then vreal(ii)=prn(ii)+prp(ii) vimag(ii)=pin(ii)+pip(ii) * mean coincidence n and p spin-orbit form factor vspin(ii)=(pson(ii)+psop(ii))/2.d0 endif enddo if(iadia.eq.5) then print*,'printout is in',nrmax,' steps of',real(step) write(17,'(a)') form write(17,'(5e14.7)')(vreal(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vimag(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspin(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspii(ii),ii=1,nrmax) print*,'potential is written to tran and folded ' do ii=1,nrmax r=ii*step write(36,1077) r,vreal(ii),vimag(ii),vspin(ii),vspii(ii) enddo endif endif *--------------------------------------------------------------------- if(inopt.eq.4) then * KD02 systematics e=energy/2.d0 n=nint(a-z) imso=1 *--------------------------------------------------------------------- * first the proton rvKD=1.3039-0.4054*A**(-1./3.) avKD=0.6778-1.487e-4*A rwKD=rvKD awKD=avKD v4KD=7.0e-9 w2KD=73.55+0.0795*A rvdKD=1.3424-0.01585*A**(1./3.) rwdKD=rvdKD vdKD=0. d2KD=0.0180+3.802e-3/(1.+exp((A-156.)/8.)) d3KD=11.5 vso1KD=5.922+0.0030*A vso2KD=0.0040 rvsoKD=1.1854-0.647*A**(-1./3.) rwsoKD=rvsoKD avsoKD=0.59 awsoKD=avsoKD wso1KD=-3.1 wso2KD=160. efKD=-8.4075+0.01378*A v1KD=59.30+21.0*real(N-Z)/A-0.024*A v2KD=7.067e-3+4.23e-6*A v3KD=1.729e-5+1.136e-8*A w1KD=14.667+0.009629*A avdKD=0.5187+5.205e-4*A awdKD=avdKD d1KD=16.0+16.0*real(N-Z)/A rcKD=1.198+0.697*A**(-2./3.)+12.994*A**(-5./3.) * proton energy-dependence part fKD=E-efKD * Coulomb VcKD=1.73/rcKD*Z/(A**(1./3.)) vcoulKD=VcKD*v1KD*(v2KD-2.*v3KD*fKD+3.*v4KD*fKD*fKD) vKD=v1KD*(1.-v2KD*fKD+v3KD*fKD**2-v4KD*fKD**3)+vcoulKD wKD=w1KD*fKD**2/(fKD**2+w2KD**2) vdKD=0. wdKD=d1KD*fKD**2*exp(-d2KD*fKD)/(fKD**2+d3KD**2) vsoKD=vso1KD*exp(-vso2KD*fKD) wsoKD=wso1KD*fKD**2/(fKD**2+wso2KD**2) vkdp = vKD rvkdp = rvKD avkdp = avKD wkdp = wKD rwkdp = rvkdp awkdp = avkdp wskdp = wdKD rwskdp = rwdKD awskdp = awdKD vsokdp = vsoKD wsokdp = wsoKD rsokdp = rvsoKD asokdp = avsoKD * neutron energy-dependence part efKD=-11.2814+0.02646*A v1KD=59.30-21.0*real(N-Z)/A-0.024*A v2KD=7.228e-3-1.48e-6*A v3KD=1.994e-5-2.0e-8*A w1KD=12.195+0.0167*A d1KD=16.0-16.0*real(N-Z)/A avdKD=0.5446-1.656e-4*A awdKD=avdKD rcKD=0. fKD=E-efKD * Coulomb vcoulKD=0. vKD=v1KD*(1.-v2KD*fKD+v3KD*fKD**2-v4KD*fKD**3)+vcoulKD wKD=w1KD*fKD**2/(fKD**2+w2KD**2) vdKD=0. wdKD=d1KD*fKD**2*exp(-d2KD*fKD)/(fKD**2+d3KD**2) vsoKD=vso1KD*exp(-vso2KD*fKD) wsoKD=wso1KD*fKD**2/(fKD**2+wso2KD**2) vkdn = vKD rvkdn = rvKD avkdn = avKD wkdn = wKD rwkdn = rvkdn awkdn = avkdn wskdn = wdKD rwskdn = rwdKD awskdn = awdKD vsokdn = vsoKD wsokdn = wsoKD rsokdn = rvsoKD asokdn = avsoKD * print potential parameters print 202,a print 101,z,e 202 format(1h ,' KD02 systematics for a = ',f5.1) *-------------------------------------------------------------------- print 11 print 1112 1112 format(1h ,' v rv av w rw aw ') print 122, vkdp,rvkdp,avkdp,wkdp,rwkdp,awkdp print 1312 1312 format(1h ,' ws rws aws ') print 122, wskdp,rwskdp,awskdp print 1129 1129 format(1h ,' vso rso aso wso rsoi asoi ') print 12,vsokdp,rsokdp,asokdp,wsokdp,rsokdp,asokdp *-------------------------------------------------------------------- print * print 19 print 1112 print 122, vkdn,rvkdn,avkdn,wkdn,rwkdn,awkdn print 1312 print 122, wskdn,rwskdn,awskdn print 1129 print 12,vsokdn,rsokdn,asokdn,wsokdn,rsokdn,asokdn 122 format(1h ,9f7.3) *--------------------------------------------------------------------- a13 = a**(1./3.) rrvp =rvkdp*a13 rrwp =rwkdp*a13 rrwsp=rwskdp*a13 rrvn =rvkdn*a13 rrwn =rwkdn*a13 rrwsn=rwskdn*a13 rrsop=rsokdp*a13 rrson=rsokdn*a13 * for /folded/prn,pin,pson,prp,pip,psop do ii=1,nrmax r=ii*step pgrid(ii)=r prn(ii)=ws(r,vkdn,rrvn,avkdn) pin(ii)=ws(r,wkdn,rrwn,awkdn)+wsd(r,wskdn,rrwsn,awskdn) pson(ii)=wso(r,vsokdn,rrson,asokdn) * imaginary spin-orbit included psin(ii)=wso(r,wsokdn,rrson,asokdn) prp(ii)=ws(r,vkdp,rrvp,avkdp) pip(ii)=ws(r,wkdp,rrvp,awkdp)+wsd(r,wskdp,rrwsp,awkdp) psop(ii)=wso(r,vsokdp,rrsop,asokdp) * imaginary spin-orbit included psip(ii)=wso(r,wsokdp,rrsop,asokdp) * if zero-range adiabatic then construct coincidence potentials if(iadia.eq.5) then vreal(ii)=prn(ii)+prp(ii) vimag(ii)=pin(ii)+pip(ii) * mean coincidence n and p spin-orbit form factor vspin(ii)=(pson(ii)+psop(ii))/2.d0 vspii(ii)=(psin(ii)+psip(ii))/2.d0 endif enddo if(iadia.eq.5) then print*,'printout is in',nrmax,' steps of',real(step) write(17,'(a)') form write(17,'(5e14.7)')(vreal(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vimag(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspin(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspii(ii),ii=1,nrmax) print*,'potential is written to tran and folded ' do ii=1,nrmax r=ii*step write(36,1077) r,vreal(ii),vimag(ii),vspin(ii),vspii(ii) enddo endif endif 1077 format(2x,f5.2,4(2x,d12.5)) *--------------------------------------------------------------------- * if finite range folding to be done, nucleon potentials to * be used have already been calculated above. call folder *--------------------------------------------------------------------- if(iwat.eq.1.or.iadia.eq.6) then call folder(step,nrmax) * print the returned folded potentials print*,'printout is in',nrmax,' steps of',real(step) write(17,'(a)') form write(17,'(5e14.7)')(vreal(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vimag(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspin(ii),ii=1,nrmax) write(17,'(a)') form write(17,'(5e14.7)')(vspii(ii),ii=1,nrmax) print*,'the potential was written to tran and folded ' endif *--------------------------------------------------------------------- return end *--------------------------------------------------------------------- subroutine folder(step,nrmax) implicit real*8(a-h,o-z) real*8 prn(900),pin(900),prp(900),pip(900),pson(900),psop(900) real*8 pgrid(900),br(12),wri(200),xri(200),sint(10),pint(13) real*8 g(8,400),vtr(8,900),funct(13,200),psin(900),psip(900) common/fromfold/vreal(900),vimag(900),vspin(900),vspii(900) common/avstuff/uavs(1501),vavs(1501),uavd(1501),vavd(1501) common/folded/prn,pin,pson,psin,prp,pip,psop,psip,pgrid common/deut/iadia,iwat,ideutwf,k,imso common/avstuf2/uasp(1501),uadp(1501) * parameter(ndim=900,ndata=201,ndatar=200,mmts=96,sr2=1.41421354) parameter(ndim=900,ndata=201,mmts=96,sr2=1.41421354) data vtr/7200*0.d0/ c ---------------------------------------------------------------- c icalc=1 watanabe : icalc=2 Johnson and Tandy adiabatic c ---------------------------------------------------------------- icalc=1 if(iadia.gt.0) icalc=2 ndatar=180 c ---------------------------------------------------------------- c gauss quadrature points - number of and weights arrays c if av18 choice then set up the wave function arrays needed c ---------------------------------------------------------------- call gauss(-1.d0,1.d0,mmts,xri,wri) if(ideutwf.eq.4) call av18wf c ------------------------------------------------------------------ c small r - internal ndata,sep big R - external ndatar,step c adjust ndatar according to the chosen reaction step length c ------------------------------------------------------------------ ndatar=nint(ndatar*0.1d0/step) if(ndatar.gt.nrmax) ndatar=nrmax sep=0.1d0 if(icalc.eq.2) sep=0.05d0 do 1001 k=1,ndatar rcap=k*step j21=2 do ii=1,10 sint(ii)=0.0 enddo c ---------------------------------------------------------------- do 1002 j=1,ndata r=(j-1)*sep if(j.eq.1) r=1.d-3 rr1=rcap*rcap+0.25d0*r*r rr2=rcap*r do ii=1,13 pint(ii)=0.0 enddo c ---------------------------------------------------------------- c loop on angular gauss quadrature points - cosine(theta) do i=1,mmts um=xri(i) p2=0.5d0*(3.d0*um*um-1.d0) c ---------------------------------------------------------------- c will use function terp(r,fun,rgrid,npts,ndim) to interpolate c ---------------------------------------------------------------- r1=sqrt(rr1+rr2*um) gr= terp(r1,prn ,pgrid,nrmax,ndim) gi= terp(r1,pin ,pgrid,nrmax,ndim) gso=terp(r1,pson,pgrid,nrmax,ndim) r2=sqrt(rr1-rr2*um) gr= gr +terp(r2,prp ,pgrid,nrmax,ndim) gi= gi +terp(r2,pip ,pgrid,nrmax,ndim) gso=gso+terp(r2,psop,pgrid,nrmax,ndim) gsi=0.d0 if(imso.gt.0) then gsi=terp(r1,psin,pgrid,nrmax,ndim) gsi=gsi+terp(r2,psip,pgrid,nrmax,ndim) endif c ---------------------------------------------------------------- c angle weighted integrands of the different potential terms c ---------------------------------------------------------------- funct(1,i)= gr funct(2,i)= gi funct(3,i)= 0.d0 funct(4,i)= gr*p2 funct(5,i)= gi*p2 funct(6,i)= gso funct(7,i)= gso*um funct(8,i)= gso*p2 funct(9,i)= gso*um*abs(1.d0-um*um) funct(10,i)=gsi funct(11,i)=gsi*um funct(12,i)=gsi*p2 funct(13,i)=gsi*um*abs(1.d0-um*um) c ---------------------------------------------------------------- do ii=1,13 pint(ii)=pint(ii)+funct(ii,i)*wri(i) enddo enddo c ---------------------------------------------------------------- c ends loop over angles gauss quadrature points if given (r,R) c ---------------------------------------------------------------- call fact(r,br,icalc) c central c with added nucleon spin-orbit potential contributions g(1,j)=br(1)*pint(1)-1.5d0*br(6)*pint(6) g(1,j)=g(1,j)-3.d0*(rcap/r)*br(6)*pint(7) g(1,j)=g(1,j)/2.d0 c added spin-orbit terms in imaginary part g(2,j)=br(1)*pint(2)-1.5d0*br(6)*pint(10) g(2,j)=g(2,j)-3.d0*(rcap/r)*br(6)*pint(11) g(2,j)=g(2,j)/2.d0 c tensor tr c with added nucleon spin-orbit potential contributions g(4,j)=3.d0/sr2*br(2)*pint(4) g(4,j)=g(4,j)-4.5d0*(rcap/r)*br(7)*pint(7) g(4,j)=g(4,j)+4.50*rcap*br(8)*pint(9) g(4,j)=g(4,j)-4.50*br(9)*pint(8) g(4,j)=g(4,j)/2.d0 c with added nucleon spin-orbit potential contributions g(5,j)=3.d0/sr2*br(2)*pint(5) g(5,j)=g(5,j)-4.5d0*(rcap/r)*br(7)*pint(11) g(5,j)=g(5,j)+4.50*rcap*br(8)*pint(13) g(5,j)=g(5,j)-4.50*br(9)*pint(12) g(5,j)=g(5,j)/2.d0 c spin-orbit g(6,j)=(br(5)-br(6)/2.0)*pint(6)/2.d0 c g(6,j)=g(6,j)+br(3)*(r/(2.0*rcap))*pint(7)/2.d0 c g(6,j)=g(6,j)-br(4)*pint(8)/2.0 c overall L.S factor of one-half in Keaton + Armstrong g(6,j)=g(6,j)/2.d0 c imaginary spin-orbit, use(g(3,*) g(3,j)=0.d0 if(imso.gt.0) then g(3,j)=(br(5)-br(6)/2.0)*pint(10)/2.d0 g(3,j)=g(3,j)/2.d0 endif c adiabatic model denominator g(7,j)=br(1) c s-state part of the denominator to calculate prob_s and prob_d g(8,j)=br(5) c ---------------------------------------------------------------- if(j-j21.le.0) go to 1002 j1=j-1 j2=j-2 c ---------------------------------------------------------------- do ii=1,8 sint(ii)=sint(ii)+sep*(g(ii,j2)+4.d0*g(ii,j1)+g(ii,j))/3.0 enddo c ---------------------------------------------------------------- j21=j+1 1002 continue c ---------------------------------------------------------------- do ii=1,6 vtr(ii,k)=sint(ii)/sint(7) enddo c ---------------------------------------------------------------- c potentials to usual arrays for writing to tran data set c ---------------------------------------------------------------- vreal(k)=vtr(1,k) vimag(k)=vtr(2,k) vspin(k)=vtr(6,k) vspii(k)=vtr(3,k) c ---------------------------------------------------------------- c write out the folded potentials in the order real central, imag c central, real and imag spin orbit (coefficient of L.S), real TR c tensor and imag TR tensor. The tensor interactions are not used c by twofnr at this time c ---------------------------------------------------------------- write(36,17) rcap,vreal(k),vimag(k),vspin(k),vspii(k), # vtr(4,k),vtr(5,k) 17 format(2x,f5.2,6(2x,d12.5)) 1001 continue c ---------------------------------------------------------------- c print the s- and d-state probabilities in the Watanabe or the c Johnson and Tandy (JT) approaches. For Watanabe these are the c wfn probabilities, for JT adiabatic, those of c ---------------------------------------------------------------- probs=100*sint(8)/sint(7) print*,'----------------------------------------------------' if(ideutwf.eq.1) then print*,' Reid soft-core wfn and interaction ' else if(ideutwf.eq.2) then print*,' Hulthen S+D-state wave function ' else if(ideutwf.eq.3) then print*,' Hulthen S-state only wave function ' else if(ideutwf.eq.4) then print*,' AV18 deuteron wave function ' endif if(icalc.eq.1) then print*,' Deuteron s and d-state probabilities (%): ' else print*,' Johnson-Tandy s and d-state probabilities (%): ' endif print*,' Ps = ',real(probs),' Pd = ',real(100.0-probs) if(icalc.eq.2) then print*,' Johnson-Tandy denominator: ' print*,' = ',real(sint(7)),' MeV' endif print*,'----------------------------------------------------' return end c----------------------------------------------------------------------- subroutine fact(r,br,icalc) implicit real*8(a-h,o-z) real*8 br(12) common/avstuff/uavs(1501),vavs(1501),uavd(1501),vavd(1501) common/avstuf2/uasp(1501),uadp(1501) common/deut/iadia,iwat,ideutwf,k,imso parameter (h=0.01d0,twoh=2.d0*h,sr2=1.41421354,sr8=2.d0*sr2) z=0.d0 if(r.le.1.d-3) goto 1 c -------------------------------------------------- if(ideutwf.eq.1)then c Reid soft core case u =us(r) w =ud(r) up=(us(r+h)-us(r-h))/twoh wp=(ud(r+h)-ud(r-h))/twoh if(icalc.ne.1)then v0=vs(r) v2=vd(r) endif endif c -------------------------------------------------- if(ideutwf.eq.2)then c Hulthen s+d case u =uhs(r) w =uhd(r) up=(uhs(r+h)-uhs(r-h))/twoh wp=(uhd(r+h)-uhd(r-h))/twoh if(icalc.ne.1)then v0=vhs(r) v2=vhd(r) endif endif c -------------------------------------------------- if(ideutwf.eq.3)then c Hulthen s-only case u =uhp(r) w =0.d0 up=(uhp(r+h)-uhp(r-h))/twoh wp=0.d0 if(icalc.ne.1)then v0=vhp(r) v2=0.d0 endif endif c -------------------------------------------------- if(ideutwf.eq.4) then c AV18 case irele=nint(r*100)+1 if(irele.gt.1501) go to 1 u =uavs(irele) w= uavd(irele) up=uasp(irele) wp=uadp(irele) if(icalc.ne.1)then v0=vavs(irele) v2=vavd(irele) endif endif c -------------------------------------------------- if(icalc.eq.1) then v0=u v2=w endif c -------------------------------------------------- if(k.eq.1) write(77,'(f7.2,4d18.9)') r,u,w,v0,v2 c -------------------------------------------------- br(1)=(v0*u+v2*w) br(2)=v0*w+v2*u-v2*w/sr2 br(3)=v0*u-v2*w-(v0*w+v2*u)/sr8 br(4)=(v0*w+v2*u)/sr8+w*v2/2.d0 br(5)=v0*u br(6)=v2*w br(7)=sr2*v0*w-v2*w br(8)=((v2*up-v0*wp)-(v2*u-v0*w)/r)/sr2 br(8)=br(8)+(sr2*v0*w-2.d0*v2*w)/r br(9)=br(7)/2.d0 c -------------------------------------------------- return 1 do jt=1,12 br(jt)=0.d0 enddo if(k.eq.1) then write(77,'(f7.2,4d18.9)') z,z,z,z,z endif return end c----------------------------------------------------------------------- real*8 function us(r) *---------------------------------------------------------------------- * Reid soft core s-state wavefunction *---------------------------------------------------------------------- implicit real*8(a-h,o-z) dimension x(33),y(33),v(33) data x,y/1.000d-2,4.125d-2,7.250d-2,1.350d-1,1.975d-1, 1 2.600d-1,3.225d-1,3.850d-1,4.475d-1,5.100d-1, 2 5.725d-1,6.350d-1,6.975d-1,7.600d-1,8.850d-1, 3 1.010d-0,1.135d-0,1.260d-0,1.385d-0,1.510d-0, 4 1.760d-0,2.010d-0,2.510d-0,3.010d-0,3.510d-0, 5 4.010d-0,4.510d-0,5.010d-0,5.510d-0,6.010d-0, 6 7.010d-0,8.010d-0,9.010d-0, 7 0.0000d-0,3.3373d-5,2.3901d-4,2.7621d-3,1.2737d-2, 8 3.6062d-2,7.5359d-2,1.2847d-1,1.8993d-1,2.5349d-1, 9 3.1390d-1,3.6770d-1,4.1317d-1,4.4992d-1,4.9953d-1, a 5.2406d-1,5.3166d-1,5.2864d-1,5.1926d-1,5.0621d-1, b 4.7505d-1,4.4200d-1,3.7864d-1,3.2249d-1,2.7399d-1, c 2.3251d-1,1.9719d-1,1.6718d-1,1.4172d-1,1.2012d-1, d 8.6290d-2,6.1983d-2,4.4523d-2/ data v/2.9751d-4,2.6127d-3,1.2335d-2,8.2951d-2,2.5326d-1, 1 5.0052d-1,7.5072d-1,9.3349d-1,1.0162d-0,1.0034d-0, 2 9.2042d-1,7.9674d-1,6.5744d-1,5.1985d-1,2.8494d-1, 3 1.1865d-1,1.1397d-2,-5.4090d-2,-9.2523d-2,-1.1418d-1, 4 -1.3097d-1,-1.3193d-1,-1.2004d-1,-1.0453d-1,-8.9709d-2, 5 -7.6510d-2,-6.5054d-2,-5.5229d-2,-4.6850d-2,-3.9726d-2, 6 -2.8547d-2,-2.0508d-2,-1.4731d-2/ z=0.7*r if(z-0.01)10,10,20 10 us=0.0d0 return 20 if(z-9.01) 40,40,30 30 us=0.87758d0*exp(-.33087d0*z) return 40 do 100 i=1,33 if(x(i)-z) 70,80,100 70 if(x(i+1)-z) 100,60,50 100 continue 80 us=y(i) return 60 us=y(i+1) return 50 h=x(i+1)-x(i) p=(z-x(i))/h y1=y(i) y2=y(i+1) v1=v(i) v2=v(i+1) a1=y1 a2=h*v1 a3=3.d0*(y2-y1)-h*(2.d0*v1+v2) a4=2.d0*(y1-y2)+h*(v1+v2) us=((a4*p+a3)*p+a2)*p+a1 return end c----------------------------------------------------------------------- real*8 function ud(r) *---------------------------------------------------------------------- * Reid soft core d-state wavefunction *---------------------------------------------------------------------- implicit real*8(a-h,o-z) dimension x(33),y(33),v(33) data x,y/1.000d-2,4.125d-2,7.250d-2,1.350d-1,1.975d-1, 1 2.600d-1,3.225d-1,3.850d-1,4.475d-1,5.100d-1, 2 5.725d-1,6.350d-1,6.975d-1,7.600d-1,8.850d-1, 3 1.010d-0,1.135d-0,1.260d-0,1.385d-0,1.510d-0, 4 1.760d-0,2.010d-0,2.510d-0,3.010d-0,3.510d-0, 5 4.010d-0,4.510d-0,5.010d-0,5.510d-0,6.010d-0, 6 7.010d-0,8.010d-0,9.010d-0, 8 0.0000d-0,1.0850d-5,8.4073d-5,1.0369d-3,4.9642d-3, 9 1.4446d-2,3.0795d-2,5.3157d-2,7.8995d-2,1.0525d-1, a 1.2933d-1,1.4958d-1,1.6529d-1,1.7645d-1,1.8710d-1, b 1.8654d-1,1.7946d-1,1.6910d-1,1.5742d-1,1.4553d-1, c 1.2314d-1,1.0373d-1,7.3859d-2,5.3293d-2,3.9077d-2, d 2.9115d-2,2.2016d-2,1.6871d-2,1.3079d-2,1.0243d-2, f 6.4412d-3,4.1575d-3,2.7363d-3/ data v/7.4202d-5,8.9321d-4,4.4755d-3,3.1982d-2,1.0121d-1, 1 2.0596d-1,3.1477d-1,3.9371d-1,4.2466d-1,4.0842d-1, 2 3.5772d-1,2.8848d-1,2.1428d-1,1.4427d-1,3.3294d-2, 3 -3.5899d-2,-7.3151d-2,-9.0091d-2,-9.5299d-2,-9.4158d-2, 4 -8.3973d-2,-7.1282d-2,-4.9327d-2,-3.3940d-2,-2.3612d-2, 5 -1.6691d-2,-1.2002d-2,-8.7768d-3,-6.5201d-3,-4.9136d-3 6 ,-2.8956d-3,-1.7758d-3,-1.1227d-3/ z=0.7*r if(z-0.01)10,10,20 10 ud=0.0d0 return 20 if(z-9.01) 40,40,30 30 z=0.33087d0*z w=1.d0/z ud=0.023013d0*exp(-z)*(1.d0+3.d0*w*(1.d0+w)) return 40 do 100 i=1,33 if(x(i)-z) 70,80,100 70 if(x(i+1)-z) 100,60,50 100 continue 80 ud=y(i) return 60 ud=y(i+1) return 50 h=x(i+1)-x(i) p=(z-x(i))/h y1=y(i) y2=y(i+1) v1=v(i) v2=v(i+1) a1=y1 a2=h*v1 a3=3.d0*(y2-y1)-h*(2.d0*v1+v2) a4=2.d0*(y1-y2)+h*(v1+v2) ud=((a4*p+a3)*p+a2)*p+a1 return end c----------------------------------------------------------------------- real*8 function vs(r) *---------------------------------------------------------------------- * Reid soft core s-state of Vnp*wavefunction *---------------------------------------------------------------------- implicit real*8(a-h,o-z) if(r.eq.0.0) r=1.0d-10 vs=(vc(r)*us(r)+2.82842712*vt(r)*ud(r)) return end c----------------------------------------------------------------------- real*8 function vd(r) *---------------------------------------------------------------------- * Reid soft core d-state of Vnp*wavefunction *---------------------------------------------------------------------- implicit real*8(a-h,o-z) if(r) 10,10,20 10 vd=0.0 return 20 vd=((vc(r)-2.*vt(r)-3.*vls(r))*ud(r)+2.82842712*vt(r)*us(r)) return end c----------------------------------------------------------------------- real*8 function vc(r) implicit real*8(a-h,o-z) x=0.7*r e=exp(-x) vc=e*(-10.463+e*(105.468+e*e*(-3187.8+9924.3*e*e)))/x return end c----------------------------------------------------------------------- real*8 function vt(r) implicit real*8(a-h,o-z) x=0.7*r y=1.0/x e=exp(-x) vt=e*y*(-10.463*(1.+3.*y*(1.+y)-3.*y*(4.+y)*e**3)+ 1e**3*(351.77-1673.5*e*e)) return end c----------------------------------------------------------------------- real*8 function vls(r) implicit real*8(a-h,o-z) x=0.7*r e=exp(-x) vls=e**4*(708.91-2713.1*e*e)/x return end *---------------------------------------------------------------------- real*8 function uhs(r) *---------------------------------------------------------------------- * hulthen s-state wavefunction beta ~ 6*alpha (r space) *---------------------------------------------------------------------- implicit real*8(a-h,o-z) parameter (alpha=0.2314549d0, beta=1.3887294d0) parameter (rnorm=0.8474405d0) uhs=(exp(-alpha*r)-exp(-beta*r))*rnorm return end *----------------------------------------------------------------------- real*8 function uhd(r) *----------------------------------------------------------------------- * hulthen d-state wfunction gamma(t)~4alpha (r space) x~d/s ratio *----------------------------------------------------------------------- implicit real*8(a-h,o-z) parameter (alpha=0.2314549d0, t=4.d0*alpha) parameter (rnorm=0.8474405d0, x=0.026d0) uhd=0.d0 if(r.gt.1.d-12) then exg=1.d0-exp(-t*r) exgsq=exg*exg alrd=alpha*r alrdsq=alrd*alrd uhd=(1.d0+3.d0*exg/alrd+3.d0*exgsq/alrdsq)*exgsq uhd=uhd*x*exp(-alrd)*rnorm endif return end *------------------------------------------------------------------------ real*8 function vhs(r) *------------------------------------------------------------------------ * hulthen s-state wavefunction * vnp *------------------------------------------------------------------------ implicit real*8(a-h,o-z) parameter (rmn=939.565d0,rmp=938.272d0, rmu=rmn*rmp/(rmn+rmp)) parameter (ed=-2.22452d0, h=0.01d0, hc=197.32696010352811d0) parameter (alpha=0.2314549d0, beta=1.3887294d0) cons=-hc*hc/2.d0/rmu twel=12.d0*h*h d2=16.d0*(uhs(r+h)+uhs(r-h))-30.d0*uhs(r)-uhs(r+2*h)-uhs(r-2*h) vhs=ed*uhs(r)-cons*d2/twel return end *------------------------------------------------------------------------ real*8 function vhd(r) *------------------------------------------------------------------------ * hulthen d-state wavefunction * vnp *------------------------------------------------------------------------ implicit real*8(a-h,o-z) parameter (rmn=939.565d0,rmp=938.272d0, rmu=rmn*rmp/(rmn+rmp)) parameter (ed=-2.22452d0, h=0.01d0, hc=197.32696010352811d0) parameter (alpha=0.2314549d0, beta=1.3887294d0) vhd=0.d0 if(r.gt.1.d-12) then cons=-hc*hc/2.d0/rmu twel=12.d0*h*h d2=16.d0*(uhd(r+h)+uhd(r-h))-30.d0*uhd(r)-uhd(r+2*h)-uhd(r-2*h) vhd=ed*uhd(r)-cons*(d2/twel-6.d0*uhd(r)/r/r) endif return end *------------------------------------------------------------------------ real*8 function uhp(r) *---------------------------------------------------------------------- * hulthen s-state wavefunction beta~6*alpha (r space) *---------------------------------------------------------------------- implicit real*8(a-h,o-z) parameter (alpha=0.2314549d0, beta=1.3887294d0) parameter (rnorm=0.8818672d0) uhp=(exp(-alpha*r)-exp(-beta*r))*rnorm return end *----------------------------------------------------------------------- real*8 function vhp(r) *------------------------------------------------------------------------ * hulthen s-state wavefunction * vnp *------------------------------------------------------------------------ implicit real*8(a-h,o-z) parameter (rmn=939.565d0,rmp=938.272d0, rmu=rmn*rmp/(rmn+rmp)) parameter (ed=-2.22452d0, h=0.01d0, hc=197.32696010352811d0) parameter (alpha=0.2314549d0, beta=1.3887294d0) cons=-hc*hc/2.d0/rmu twel=12.d0*h*h d2=16.d0*(uhp(r+h)+uhp(r-h))-30.d0*uhp(r)-uhp(r+2*h)-uhp(r-2*h) vhp=ed*uhp(r)-cons*d2/twel return end *--------------------------------------------------------------------- subroutine alphap(energy,a1,z1,step,nrmax) implicit real*8(a-h,o-z) dimension aji(100), e(100) common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd *--------------------------------------------------------------------- * potential formfactor statement functions *--------------------------------------------------------------------- * ws (r,vv,r0,aa)=-vv/(1.d0+dexp((r-r0)/aa)) * wsd(r,ww,w0,wa)=-ww*4.d0*dexp((r-w0)/wa)/(1.+dexp((r-w0)/wa))**2 *--------------------------------------------------------------------- print*,'----------------------------------------------------' 890 print*,' [1] Atzrott/Kumar et al. global alpha potential ' print*,' PRC 53 (1996) 1336 and NP A776 (2006) 105 ' print*,'----------------------------------------------------' *--------------------------------------------------------------------- read*,inopt if(inopt.lt.1.or.inopt.gt.1) go to 890 write(18,*) inopt print*,' >>>> ',inopt a=a1 a13=a**0.3333333333d0 if(inopt.eq.1) then *--------------------------------------------------------------------- amass=a1 az=z1 * program alphaop * dimension aji(100), e(100) c calculation of real and imaginary potentials for alpha - c nucleus systems c please send your comments to kailas@magnum.barc.ernet.in c modified on 30.8.2002 c real and imaginary potentials starting from volume integral c systematics, potential and slope of potential at radius c close to strong absorption radius c ref. mahaux,ngo and satchler nucl.,phys.a 446,1986,354 c for dispersion correction * open(unit=5, file='input') * open(unit=6, file='output') pi=4.*atan(1.) ex=1.0 elab=energy at13=amass**(1./3.) *--------------------------------------------------------------------- c read mass of target, z of target, 1st excited state of target(in mev) c and e lab (in mev) * read(5, 99001)amass, az, ex, elab *9001 format(f5.0, f5.0, 2f10.3) * write(6, 99002)amass, az, ex, elab *9002 format('amass ', f5.1, 5x, 'az ', f5.1, 5x, 'ex ', f10.3, '(mev)', * & 5x, 'elab', f10.3, '(mev)') *--------------------------------------------------------------------- c r2.4 systematics for real and imaginary parts of potential c ar, ai are the diffuseness parameter values r24r=1.35*at13 + 2.55 r24i=1.35*at13 + 2.14 ar=0.76 ai=0.60 c eref is the reference energy for normalisation in making dispersion c relation calculation eref=140.01 erefc=140.01*amass/(amass + 4.) c jref is the volume integral at the reference energy and is c calculated using the empirical relation given below jref=(224. - 0.98*erefc/amass**0.184 + 2.57*az/at13) & *(1. + (2.05/at13)) jref=-jref c imaginary part systematics is taken from a.shridahar et al. c phys. rev. c30,1760 (1984) ajii=32.8*(1. + 7.1/at13) c calculation of real and imaginary potential radii by fitting c r 2.4 and volume integral values at e=90 mev const=4.*pi/4./amass/3. const1=pi*ar const2=pi*ai ec=90.*amass/(amass + 4.) c bar is the coulomb barrier bar=1.44*2.*az/1.5/(4.**(1./3.) + amass**(1./3.)) c alpha and beta are the energy coefficients for imaginary part alpha=0.05 beta=0.309 ebar=bar + ex jrref=(224. - 0.98*ec/amass**0.184 + 2.57*az/at13) & *(1. + (2.05/at13)) jiief=ajii*(1. - exp( - (90.-ebar)*alpha)) j=0 ror=1.0 100 rr=ror*at13 vor=jrref/const/rr**3./(1 + (const1/rr)**2.) r24rc=rr + ar*log((vor - 2.4)/2.4) diff=r24rc - r24r j=j + 1 if(j.le.200)then if(abs(diff).gt.0.05)then ror=ror + 0.005 goto 100 endif endif roi=1.2 j=0 200 ri=roi*at13 voi=jiief/const/ri**3./(1. + (const2/ri)**2.) r24ic=ri + ai*log((voi - 2.4)/2.4) diff=r24ic - r24i j=j + 1 if(j.le.200)then if(abs(diff).gt.0.05)then roi=roi + 0.005 goto 200 endif endif ecm=elab*amass/(amass + 4.) ed=-elab + ebar edd=elab - ebar - 3. if(edd.le.0)then ajie=ajii*0.055*exp( - beta*ed) else ajie=ajii*(1. - exp( - (elab-ebar)*alpha)) endif c matching of two forms of imaginary potentials is done c at ebar + 3 mev. n=0 ee=ex emax=ebar + 3. 300 n=n + 1 e(n)=ee if(e(n).le.emax)then aji(n)=ajii*0.055*exp( - beta*( - e(n) + ebar)) ee=ee + 2. goto 300 else 350 if(e(n).le.140.)then aji(n)=ajii*(1. - exp( - (e(n)-ebar)*alpha)) n=n + 1 ee=ee + 4. e(n)=ee goto 350 else no=n c do 189 i=1,no-1 c write(6,188) e(i), aji(i) c189 continue c188 format ( 'e',f10.3,'aji',f10.3) c assume the dispersion correction to vanish at eref. dvef=0. dverf=0. do j=1, no - 3 dj=e(j + 1) - e(j) an1=(elab - e(j))*log(abs((elab-e(j))/dj)) an2=(elab - e(j + 1))*log(abs((elab-e(j+1))/dj)) dve=((aji(j+1) - aji(j))/dj)*(an1 - an2)/pi anr1=(eref - e(j))*log(abs((eref-e(j))/dj)) anr2=(eref - e(j + 1))*log(abs((eref-e(j+1))/dj)) dver=((aji(j+1) - aji(j))/dj)*(anr1 - anr2)/pi dvef=dvef + dve dverf=dverf + dver enddo v0=jref - dverf ajre=dvef + v0 ror=rr/at13 roi=ri/at13 vor=ajre/const/rr**3./(1 + (const1/rr)**2.) voi=ajie/const/ri**3./(1. + (const2/ri)**2.) vor=-vor ajre=-ajre * ------------------------------------------------------------- * comment the original output statements * ------------------------------------------------------------- * write(6, 99003) *9003 format(2x, 'elab(mev) ', 2x, 'real v.i.(mev fm3) ', 2x, * & 'img v.i.(mev fm3)') * write(6, 99004)elab, ajre, ajie *9004 format(f10.1, 9x, f10.1, 9x, f10.2) * write(6, 99005) *9005 format(2x, 'elab(mev) ', 2x, 'vor(mev) ', 2x, 'ror(fm) ', * & 2x, 'ar(fm) ', 'voi(mev) ', 2x, 'roi(fm) ', * & 'ai(fm) ') * write(6, 99006)elab, vor, ror, ar, voi, roi, ai *9006 format(f10.1, 2x, f10.3, 2x, f8.3, 2x, f8.3, 2x, f10.3, 2x, * & f8.3, 2x, f8.3) * ------------------------------------------------------------- * print*,elab, vor, ror, ar, voi, roi, ai endif endif * ------------------------------------------------------------- * convert to usual parameters * ------------------------------------------------------------- vpr=vor rr=ror wvpi=voi wpi=0.d0 rpi=roi api=ai * ------------------------------------------------------------- print 10,a 10 format(1h ,' alpha particle potentials for a=',f5.1) print 15,z1,energy 15 format(1h ,' z = ',f4.1,' at ',f5.1,' mev alpha energy ') rcd=ror print*,' coulomb radius parameter = ',real(rcd) print 111 111 format(1h ,' vr ro ao ws ri ai wv ') print 12,vpr,rr,ar,wpi,rpi,api,wvpi 12 format(1h ,7f7.3) vd=vpr rrd=rr ard=ar wd=wvpi rid=rpi aid=api wisd=wpi risid=rpi aisid=api vsod=0.0 wsod=0.d0 rsord=1.0d0 asord=1.0d0 rsoid=1.d0 asoid=1.d0 endif return end *--------------------------------------------------------------------- subroutine triton(energy,a1,z1,step,nrmax) implicit real*8(a-h,o-z) common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd common/che3/pspr(900),pspi(900),psps(900),ihesp *--------------------------------------------------------------------- * woods-saxon potential formfactor statement functions *--------------------------------------------------------------------- ws (r,vv,r0,aa)=-vv/(1.d0+dexp((r-r0)/aa)) wsd(r,ww,w0,wa)=-ww*4.d0*dexp((r-w0)/wa)/(1.+dexp((r-w0)/wa))**2 wso(r,ww,w0,wa)= wsd(r,ww,w0,wa)/(2.d0*wa*r) *--------------------------------------------------------------------- * latter is the coefficient of l.sigma *--------------------------------------------------------------------- 890 print*,' [1] Bechetti-Greenlees (not well determined) ' print*,' see: ADNDT 17 (1976) p6 ' print*,' Potential B2 of Nucl Phys A190 (1972) 437 ' print*,' [2] X. Li et al. Global potential E<40 MeV ' print*,' see: NPA 789 (2007) 103 ' print*,' [3] D.Y. Pang et al. GDP08 ' print*,' see: PRC 79 (2009) 024615 ' print*,'----------------------------------------------------' *--------------------------------------------------------------------- read*,inopt if(inopt.lt.1.or.inopt.gt.3) go to 890 write(18,*) inopt print*,' >>>> ',inopt ihesp=0 a=a1 ed=energy e=z1 an=(a-2.d0*e)/a a13=a**0.3333333333d0 z13=e**0.3333333333d0 if(inopt.eq.1) then vpr=165.d0-0.17d0*ed-6.4d0*an rr=1.20d0 ar=0.72d0 rpi=1.40d0 api=0.84d0 wvpi=46.0d0-0.33d0*ed-110.d0*an if(wvpi.lt.0.d0) wvpi=0.d0 wpi=0.d0 print 10,a print 101,e,ed 10 format(1h ,' bechetti greenlees 3h potentials for a = ',f5.1) 101 format(1h ,' z = ',f4.1,' at ',f6.2,' MeV triton energy ') rcd=1.30d0 print*,' Coulomb radius parameter = ',real(rcd) print 111 111 format(1h ,' vr ro ao ws ri ai wv ') print 12,vpr,rr,ar,wpi,rpi,api,wvpi 12 format(1h ,7f7.3) vd=vpr rrd=rr ard=ar wd=wvpi rid=rpi aid=api wisd=wpi risid=rpi aisid=api vsod=2.5d0 rsord=1.20d0 asord=0.72d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 112 format(1h ,' vso rso aso ') print 12,vsod,rsord,asord endif if(inopt.eq.2) then *--------------------------------------------------------------------- * X Li et al. Global potential NPA 2007 *--------------------------------------------------------------------- ihesp=1 do i=1,900 pspr(i)=0.d0 pspi(i)=0.d0 psps(i)=0.d0 enddo print 29,a1 29 format(1h ,' Li et al. triton potential for a = ',f5.1) rcd=1.4219d0 print*,' Coulomb radius parameter = ',real(rcd) vd=1.d0 rrd=99.d0 ard=1.d0 wd=1.d0 rid=99.d0 aid=1.d0 wisd=0.d0 risid=rid aisid=1.d0 vsod=1.d0 rsord=99.d0 asord=1.d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 *--------------------------------------------------------------------- vlir=137.6d0-0.1456d0*ed+0.0436d0*ed*ed+4.3751d0*an vlir=vlir+1.0474d0*e/a13 wlis=37.06d0-0.6451d0*ed-47.19d0*an wliv=7.383d0+0.5025d0*ed-0.0097d0*ed*ed vliso=1.9029d0 rlir= (1.12010d0-0.1504d0/a13) rliv= (1.32020d0-0.1776d0/a13) rlis= (1.25100d0-0.4622d0/a13) rliso=(0.46991d0+0.1294d0/a13) alir= (0.68330d0+0.01910d0*a13) aliv= (1.11900d0+0.01913d0*a13) alis= (0.81140d0+0.01159d0*a13) aliso=(0.35450d0-0.05220d0*a13) print 117 117 format(1h ,' vr ro ao ws ris ais ') print 12,vlir,rlir,alir,wlis,rlis,alis print 119 119 format(1h ,' wv riv aiv ') print 12,wliv,rliv,aliv print 118 118 format(1h ,' vso rso aso ') print 12,vliso,rliso,aliso rlir= rlir*a13 rliv= rliv*a13 rlis= rlis*a13 rliso=rliso*a13 print*,' printout is in',nrmax,' steps of',real(step) *--------------------------------------------------------------------- do ii=1,nrmax r=ii*step pspr(ii)=ws(r,vlir,rlir,alir) pspi(ii)=ws(r,wliv,rliv,aliv)+wsd(r,wlis,rlis,alis) psps(ii)=wso(r,vliso,rliso,aliso) enddo endif if(inopt.eq.3) then *--------------------------------------------------------------------- * GDP08 potential for 3H dypang *--------------------------------------------------------------------- a=a1 ed=energy e=z1 ap=3.0d0 zp=1.0d0 call gdp08(ap,zp,a1,z1,energy) print 710,a print 701,e,ed 710 format(1h ,' DYPang et al 3H potentials for a = ',f5.1) 701 format(1h ,' z = ',f4.1,' at ',f5.1,' MeV triton energy ') rcd=1.30d0 print*,' Coulomb radius parameter = ',real(rcd) print 711 711 format(1h ,' vr ro ao wv riv aiv ') print 713,vd,rrd,ard,wd,rid,aid print 715 715 format(1h ,' ws ris ais ') print 713,wisd,risid,aisid 713 format(1h ,7f7.3) print 712 712 format(1h ,' vso rso aso ') print 713,vsod,rsord,asord print 714 714 format(1h ,' wso wrso waso ') print 713,wsod,rsoid,asoid endif *--------------------------------------------------------------------- return end *--------------------------------------------------------------------- subroutine helium(energy,a1,z1,step,nrmax) implicit real*8(a-h,o-z) character spfile*30,guff*10 real*8 funr(1500),funi(1500),rgrid(1500) common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd common/che3/pspr(900),pspi(900),psps(900),ihesp character form*12 *--------------------------------------------------------------------- * potential formfactor statement functions *--------------------------------------------------------------------- ws (r,vv,r0,aa)=-vv/(1.d0+dexp((r-r0)/aa)) wsd(r,ww,w0,wa)=-ww*4.d0*dexp((r-w0)/wa)/(1.+dexp((r-w0)/wa))**2 *--------------------------------------------------------------------- 890 print*,' [1] Bechetti-Greenlees (not well determined) ' print*,' see: ADNDT 17 (1976) p6 ' print*,' Potential B2 of Nucl Phys A190 (1972) 437 ' print*,' [2] Read Sao Paulo potential from file ' print*,' see: Reference ' print*,' [3] D.Y. Pang et al. GDP08 ' print*,' see: PRC 79 (2009) 024615 ' print*,' [4] C.T. Liang et al. ' print*,' see: JPG 36 (2009) 085104 ' print*,'----------------------------------------------------' ndim=1500 *--------------------------------------------------------------------- ihesp=0 read*,inopt if(inopt.lt.1.or.inopt.gt.4) go to 890 write(18,*) inopt print*,' >>>> ',inopt if(inopt.eq.1) then a=a1 ed=energy e=z1 an=(a-2.d0*e)/a a13=a**0.3333333333d0 vpr=151.9d0-0.17d0*ed+50.d0*an rr=1.20d0 ar=0.72d0 rpi=1.40d0 api=0.88d0 wvpi=41.7d0-0.33d0*ed+44.d0*an if(wvpi.lt.0.d0) wvpi=0.d0 wpi=0.d0 print 10,a print 101,e,ed 10 format(1h ,' bechetti greenlees 3he potentials for a = ',f5.1) 101 format(1h ,' z = ',f4.1,' at ',f6.2,' MeV 3He energy ') rcd=1.30d0 print*,' Coulomb radius parameter = ',real(rcd) print 111 111 format(1h ,' vr ro ao ws ri ai wv ') print 12,vpr,rr,ar,wpi,rpi,api,wvpi 12 format(1h ,7f7.3) vd=vpr rrd=rr ard=ar wd=wvpi rid=rpi aid=api wisd=wpi risid=rpi aisid=api vsod=2.5d0 rsord=1.20d0 asord=0.72d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 print 112 112 format(1h ,' vso rso aso ') print 12,vsod,rsord,asord endif if(inopt.eq.2) then *--------------------------------------------------------------------- * the externally read Sao Paulo potential option requested *--------------------------------------------------------------------- ihesp=1 print 29,a1 29 format(1h ,' Sao Paulo 3He potential for a = ',f5.1) rcd=1.25d0 print*,' Coulomb radius parameter = ',real(rcd) print*,' printout is in',nrmax,' steps of',real(step) vd=1.d0 rrd=99.d0 ard=1.d0 wd=1.d0 rid=99.d0 aid=1.d0 wisd=0.d0 risid=rid aisid=1.d0 vsod=0.d0 rsord=1.d0 asord=1.d0 wsod=0.d0 rsoid=1.d0 asoid=1.d0 form='(5e14.7)' *--------------------------------------------------------------------- print*,' filename with Sao Paulo potential ? ' read '(a)',spfile open(22,file=spfile,status='unknown') print '(a,a)',' >>>> ',spfile write(18,'(a)') spfile *--------------------------------------------------------------------- * read things from the external file on channel 22 * format is to be provided here (JAT 14/3/2008) *--------------------------------------------------------------------- read(22,'(a)') guff read(22,*) npts,spstep,spstart do ii=1,npts rgrid(ii)=spstart+(ii-1)*spstep read(22,*) funr(ii),funi(ii) * write(31,*)rgrid(ii),funr(ii),funi(ii) enddo rmax=rgrid(npts) *--------------------------------------------------------------------- * interpolate the potential to the internal working grid * c/i/so (nrmax points with step) first radial point at step *--------------------------------------------------------------------- do ii=1,nrmax r=ii*step if(r.lt.rmax) then pspr(ii)=terp(r,funr,rgrid,npts,ndim) pspi(ii)=terp(r,funi,rgrid,npts,ndim) else pspr(ii)=0.d0 pspi(ii)=0.d0 endif * diagnostic prints * write(30,*) r,pspr(ii),pspi(ii) enddo endif if(inopt.eq.3) then *--------------------------------------------------------------------- * GDP08 potential for 3He dypang *--------------------------------------------------------------------- a=a1 ed=energy e=z1 ap=3.0d0 zp=2.0d0 call gdp08(ap,zp,a1,z1,energy) print 710,a print 701,e,ed 710 format(1h ,' DYPang et al 3He potentials for a = ',f5.1) 701 format(1h ,' z = ',f4.1,' at ',f5.1,' MeV helion energy ') rcd=1.30d0 print*,' Coulomb radius parameter = ',real(rcd) print 711 711 format(1h ,' vr ro ao wv riv aiv ') print 713,vd,rrd,ard,wd,rid,aid print 715 715 format(1h ,' ws ris ais ') print 713,wisd,risid,aisid 713 format(1h ,7f7.3) print 712 712 format(1h ,' vso rso aso ') print 713,vsod,rsord,asord print 714 714 format(1h ,' wso wrso waso ') print 713,wsod,rsoid,asoid endif if(inopt.eq.4) then *--------------------------------------------------------------------- * 3He systematic potential of Liang Chun-Tian et al., JPG-2009 *--------------------------------------------------------------------- ihesp=1 do i=1,900 pspr(i)=0.d0 pspi(i)=0.d0 enddo a=a1 a13=a**0.3333333333d0 ed=energy e=z1 ap=3.0d0 zp=2.0d0 call liangchuntian(ap,zp,a1,z1,energy) rrrd=rrd*a13 rrid=rid*a13 rrisid=risid*a13 do ii=1,nrmax r=ii*step pspr(ii)=ws(r,vd,rrrd,ard) pspi(ii)=ws(r,wd,rrid,aid)+wsd(r,wisd,rrisid,aisid) enddo print 720,a print 701,e,ed 720 format(1h ,' CTLiang et al. 3He potentials for a = ',f5.1) * rcd=1.30d0 print*,' Coulomb radius parameter = ',real(rcd) print 711 print 713,vd,rrd,ard,wd,rid,aid print 715 print 713,wisd,risid,aisid print 712 print 713,vsod,rsord,asord print 714 print 713,wsod,rsoid,asoid vd=1.d0 rrd=99.d0 ard=1.d0 wd=1.d0 rid=99.d0 aid=1.d0 wisd=0.d0 risid=rid aisid=1.d0 endif *--------------------------------------------------------------------- return end *--------------------------------------------------------------------- * 3He systematic pot of Liang Chun-Tian et al., JPG 36 (2009) 085104 *--------------------------------------------------------------------- subroutine liangchuntian(ap,zp,at,zt,Einc) implicit real*8(a-h,o-z) real*8 AT, ZT, AP, ZP, at13, Einc real*8 vd,rrd,ard,wd,rid,aid,wisd,risid,aisid real*8 vsod,rsord,asord,wsod,rsoid,asoid,rcd common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd at13 = AT**(1./3.) vd = 118.36-0.2071*Einc + 6.3961e-5*Einc*Einc vd = vd+26.001*(AT-2.*ZT)/AT+0.5668*ZT/at13 rrd= 1.1657 + 0.0401/at13 ard= 0.6641 + 0.0305*at13 wd = -6.8871 + 0.3115*Einc -6.8096e-4*Einc*Einc rid= 1.4022+ 0.0418/at13 aid= 0.7732+ 0.0219*at13 wisd = 20.119-0.1626*Einc-5.4067*(AT-2.*ZT)/AT+1.2087*at13 risid= 1.1802+ 0.0587/at13 aisid= 0.6292+0.0657*at13 vsod = 2.0491d0+9.9804e-3*at13 rsord= 0.7211+0.0586/at13 asord= 0.7643 + 0.0535*at13 wsod = -1.1591d0 rsoid= rsord asoid= asord rcd = 1.289d0 return end *------------------------------------------------------------- subroutine gdp08(ap,zp,at,zt,Einc) implicit real*8(a-h,o-z) real*8 Wv, rrwv, aawv, Ws, rrws, aaws, V, rv, av real*8 VVso, rvso, avso, WWso, rwso, awso real*8 V0, VE, VT, VTE, R0, R0A, R0AP, A0, VC, R0AE,MDAE,MDA0 real*8 WV0,WVE, WVT,WVTE,RWV, RWVA,RWVP, AWV,WVC,WVE0,WVEW,AWVT real*8 WS0,WSE, WST,WSTE,RWS, RWSA,RWSP, AWS,WSC,WSE0,WSEW,AWST real*8 VSO,VSOE,RSO,RSOA,RSOP,ASO, VSOA, VSAP, RC0,RCA, RCAP, RC real*8 WSO,WSOE,RWO,RWOA,RWOP,AWO, WSOA, WSAP real*8 AT, ZT, AP, ZP, Einc, EC, Epot, Ecm, varpsilon real*8 MDA,MDB,MDC,VMD, PI, AT13, zero common/pot1/vd,rrd,ard,wd,rid,aid,wisd,risid,aisid common/pot2/vsod,rsord,asord,wsod,rsoid,asoid,rcd common/iunit/iunit common/GDP08Para/ & V0, VE, VT, VTE, R0, R0A, R0AP, A0, VC, R0AE,MDAE,MDA0, & WV0,WVE, WVT,WVTE,RWV, RWVA,RWVP, AWV,WVC,WVE0,WVEW,AWVT, & WS0,WSE, WST,WSTE,RWS, RWSA,RWSP, AWS,WSC,WSE0,WSEW,AWST, & VSO,VSOE,RSO,RSOA,RSOP,ASO, VSOA, VSAP, & WSO,WSOE,RWO,RWOA,RWOP,AWO, WSOA, WSAP, & RC0, RCA, RCAP PI=4.0d0*datan(1.0d0) call initGDP08 c real part V0=118.25d0 VE=-0.12512d0 R0=1.3007 R0A =-0.4816 A0 =0.8148 VC=1.0 c Wv WV0=38.481 RWV=1.3120 RWVA=-0.1290 AWV=0.8399 WVE0=156.09 WVEW=52.442 c Ws WS0=35.037 WST=34.181 RWS=1.3120 RWSA=-0.1290 AWS=0.8399 WSE0=30.755 WSEW=106.36 c Coulomb RC0=1.238 RCA=0.116 c isovector parameter if(ZP.EQ.2.) then varpsilon=(AT-2.0d0*ZT)/AT elseif(ZP.EQ.1.) then varpsilon=(2.0d0*ZT-AT)/AT else varpsilon=0.0d0 endif c Coulomb correction, asumming alpha=1.0 as in CH89 if(RCAP.EQ.0.0) RCAP=-1.0d0/3.0d0 Ecm=AT*Einc/(AT+AP) RC=RC0+RCA*AT**RCAP if(VC .EQ. 1.0) then EC =(1.73d0/RC)*ZT*ZP/AT**(1.d0/3.d0) else EC=0.0d0 endif Epot=Einc-EC AT13=AT**(1.0d0/3.0d0) zero=0.0d0 c real part V =V0 + VE*Epot + (VT+VTE*Epot)*varpsilon rv=R0 + (R0A+R0AE*Epot)/AT13 av=A0 c volume imag if(WVE0 .LE. 0.0) then Wv =(WV0+WVE*Epot) + (WVT+WVTE*Epot)*varpsilon else Wv =(WV0+WVT*varpsilon)/(1.0d0+dexp(-(Epot-WVE0)/WVEW)) endif rrwv= RWV + RWVA/AT13 aawv= AWV + AWVT*varpsilon c surface imag if(WSE0 .LE. 0.0) then Ws=(WS0+WSE*Epot) + (WST+WSTE*Epot)*varpsilon else Ws=(WS0+WST*varpsilon)/(1.0d0+dexp( (Epot-WSE0)/WSEW)) endif rrws= RWS + RWSA/AT13 aaws= AWS + AWST*varpsilon c spin-orbit real VVso=VSO + VSOE*Epot + VSOA*AT**VSAP rvso=RSO + RSOA*AT13 avso=ASO c spin-orbit imag WWso=WSO + WSOE*Epot + WSOA*AT**WSAP rwso=RWO + RWOA*AT13 awso=AWO c Coulomb radius RC=RC0 +RCA*AT**RCAP vd =V rrd =RV ard =AV wd =Wv rid =rrwv aid =aawv wisd=Ws risid= rrws aisid= aaws vsod=VVso rsord= rvso asord= avso wsod=WWso rsoid= rwso asoid= awso return end *------------------------------------------------------------- subroutine initGDP08 implicit none real*8 V0, VE, VT, VTE, R0, R0A, R0AP, A0, VC, R0AE,MDAE,MDA0 real*8 WV0,WVE, WVT,WVTE,RWV, RWVA,RWVP, AWV,WVC,WVE0,WVEW,AWVT real*8 WS0,WSE, WST,WSTE,RWS, RWSA,RWSP, AWS,WSC,WSE0,WSEW,AWST real*8 VSO,VSOE,RSO,RSOA,RSOP,ASO, VSOA, VSAP real*8 WSO,WSOE,RWO,RWOA,RWOP,AWO, WSOA, WSAP real*8 RC0,RCA, RCAP common/GDP08Para/ & V0, VE, VT, VTE, R0, R0A, R0AP, A0, VC, R0AE,MDAE,MDA0, & WV0,WVE, WVT,WVTE,RWV, RWVA,RWVP, AWV,WVC,WVE0,WVEW,AWVT, & WS0,WSE, WST,WSTE,RWS, RWSA,RWSP, AWS,WSC,WSE0,WSEW,AWST, & VSO,VSOE,RSO,RSOA,RSOP,ASO, VSOA, VSAP, & WSO,WSOE,RWO,RWOA,RWOP,AWO, WSOA, WSAP, & RC0, RCA, RCAP c ------------------ V0 = 0.0d0 VE = 0.0d0 VT = 0.0d0 VTE = 0.0d0 R0 = 0.0d0 R0A = 0.0d0 R0Ap= 0.0d0 A0 = 0.0d0 VC = 1.0d0 R0AE= 0.0d0 MDAE= 0.0d0 MDA0= 0.0d0 c ------------------ WV0 = 0.0d0 WVE = 0.0d0 WVT = 0.0d0 WVTE= 0.0d0 RWV = 0.0d0 RWVA= 0.0d0 RWVP= 0.0d0 AWV = 0.0d0 WVC = 1.0d0 WVE0= 0.0d0 WVEW= 0.0d0 AWVT= 0.0d0 c ------------------ WS0 = 0.0d0 WSE = 0.0d0 WST = 0.0d0 WSTE= 0.0d0 RWS = 0.0d0 RWSA= 0.0d0 RWSP= 0.0d0 AWS = 0.0d0 WSC = 1.0d0 WSE0= 0.0d0 WSEW= 0.0d0 AWST= 0.0d0 c ------------------ VSO = 0.0d0 VSOE= 0.0d0 RSO = 1.2d0 RSOA= 0.0d0 RSOP= 0.0d0 ASO = 0.6d0 VSOA= 0.0d0 VSAp= 0.0d0 c ------------------ WSO = 0.0d0 WSOE= 0.0d0 RWO = 1.2d0 RWOA= 0.0d0 RWOP= 0.0d0 AWO = 0.6d0 WSOA= 0.0d0 WSAp= 0.0d0 c ------------------ RC0 = 0.0d0 RCA = 0.0d0 RCAP= 0.0d0 return end *--------------------------------------------------------------------- subroutine jlm(potr,poti,nucleon,aa,zz,Elab,step,nrmax) * ------------------------------------------------------------ * JLM local density approximation (LDA) N+A potentials * JAT February 1999 - tested March 1999. * ------------------------------------------------------------ implicit real*8(a-h,o-z) common/density/rad(500),rhon(500),rhop(500),rhom(500) real*8 a(3,3),b(3,3),c(3,3),d(4,4),f(4,4),nn real*8 xrt(200),wrt(200),xmu(200),wmu(200) real*8 potr(900),poti(900) * real*8 gbden(401) character dname*12,guff*4 * character fmt*20 character nucleon,ans,nucl*12 common/arrays/a,b,c,d,f common /dcom/ rho0, rad0, diff, beta2, b2bar common/djlm/rlr,rli pi=4.d0*datan(1.d0) do i=1,900 potr(i)=0.d0 poti(i)=0.d0 enddo print*,' ---------------------------------------------------' print*,' JLM local density approximation nucleon potentials' print* * ------------------------------------------------------------ * print*,' Output file trailer for potentials:' * read '(a)',fname * open(17,file='jlm.'//fname,status='unknown') * open(22,file='density',status='unknown') * open(27,file='jlmf.'//fname,status='unknown') * print '(a,a)',' Output is to file: ','jlm.'//fname * ------------------------------------------------------------ * 16 print*,' neutron (n) or proton (p) optical potential' * read '(a)',nucleon * if(nucleon.ne.'n'.and.nucleon.ne.'p') goto 16 nuc=-1 nucl='proton' if(nucleon.eq.'n') then nuc=1 nucl='neutron' endif print '(a,2x,a)',' Optical potential for ',nucl * ------------------------------------------------------------ * print*,' Target mass A and charge Z ' * read*,aa,zz * print9,aa,zz nn=aa-zz aa13=aa**(1.d0/3.d0) if(nuc.eq.-1) rc=1.123d0*aa13+2.35d0/aa13-2.07d0/aa * print*,' Lab Energy (MeV) ' * read*,E * read*,Elab * print9,Elab * compute cm energy E=Elab*aa/(aa+1.d0) * print'(a,f10.4)',' incident cm energy (MeV) = ',E * ------------------------------------------------------------ * print*,' potential at radii: rmin,rmax,rstep ' * read*,rmin,rmax,rstep * ------------------------------------------------------------ rmin=0.d0 rmax=nrmax*step rstep=step 14 print*,' Uses the JLM parameterisation of Bauge ' * ------------------------------------------------------------ * print9,rmin,rmax,rstep 9 format(3f10.4) * 14 print*,' Choose JLM potential parameter set ' * print*,' 1) High energy set (>15 MeV) ' * print*,' 2) Low energy set (<15 MeV) ' * read*,iset * print*,iset * if(iset.ne.1.and.iset.ne.2) goto 14 iset=1 * if(Elab.lt.15.d0) iset=2 * 11 print*,' Version of local density approximation ' * print*,' 1) LDA (rx=rt)' * print*,' 2) LDA (rx=rp)' * print*,' 3) LDA (Mid-point) ******** ' * read*,ilda * print*,ilda * if(ilda.lt.1.or.ilda.gt.3) goto 11 print*,' Uses the mid-point LDA prescription ' ilda=3 17 print*,' Choose assumed target density ' print*,' 1) Negele (Fermi) form ' print*,' 2) Specify rms radius ' print*,' 3) Oscillator form ' print*,' 4) 3pF three parameter Fermi ' print*,' 5) read Alex Brown HF densities ' * print*,' 6) read other density ' read*,icho if(icho.lt.1.or.icho.gt.5) go to 17 print*,' >>>> ',icho write(18,*) icho if(abs(icho).gt.5) goto 17 if(icho.eq.2) then print*,' ------------------------------------------------------' print*,' input rms radius (fm) ' read*,rms print*,' >>>> ',rms write(18,*) rms print*,' ------------------------------------------------------' 18 print*,' 1) Gaussian density ' print*,' 2) Woods-Saxon density' read*,irms if(irms.lt.1.or.irms.gt.2) go to 18 print*,' >>>> ',irms write(18,*)irms if(irms.ne.1.and.irms.ne.2) goto 18 if(irms.eq.2) then diff=0.54d0 print*,' default diffuseness (0.54 fm) (y/n) ' read '(a)',ans print '(a,a)',' >>>> ',ans write(18,'(a)') ans if(ans.eq.'n') then print*,' enter diffuseness ' read*,diff print*,' >>>> ',diff write(18,*)diff endif call finder(aa,rms,rho0,rad0,diff) iden=3 print*,' -----------------------------------------------------' print*,' iden = 3: WooSax: rho0 = ',rho0 print*,' rad0 = ',rad0,' diff = ',diff else iden=2 gamma=sqrt(2.d0/3.d0)*rms rho0=aa/(sqrt(pi)*gamma)**3 print*,' -----------------------------------------------------' print*,' iden = 2: Gauss : gamma = ',gamma print*,' rho0 = ',rho0 endif else if(icho.eq.1) then * Negele Woods-Saxon parameters iden=1 diff=0.54d0 rad0=(0.978d0+0.0206d0*aa13)*aa13 rho0=3.d0*aa/(4.d0*pi*rad0**3*(1.d0+(pi*diff/rad0)**2)) vol=aa call volrms(vol,rms) print*,' -----------------------------------------------------' print*,' iden = 1: Negele: rho0 = ',rho0 print*,' rad0 = ',rad0,' diff = ',diff print*,' rms mass radius =',rms else if(icho.eq.3) then print*,' Input a and alfa values in ' print*,' (1+alfa*[r/a]**2)exp(-r**2/a**2) ' read*,rad0,diff print*,' >>>> ',rad0,diff write(18,*) rad0,diff iden=4 call finder2(aa,rms,rho0,rad0,diff) print*,' -----------------------------------------------------' print*,' iden = 4: Oscill: rho0 = ',rho0 print*,' a = ',rad0,' alfa = ',diff print*,' rho0 = ',rho0,' rms = ',rms else if(icho.eq.4) then print*,' Input rad, diff and w values in ' print*,' (1+w*[r/rad]**2)/(1+exp(r-rad)/diff) ' read*,rad0,diff,www print*,' >>>> ',rad0,diff,www write(18,*) rad0,diff,www iden=5 call finder3(aa,rms,rho0,rad0,diff,www) print*,' -----------------------------------------------------' print*,' iden = 5: 3pFermi: rho0 = ',rho0 print*,' rad = ',rad0,' diff = ',diff print*,' w = ',www print*,' rho0 = ',rho0,' rms = ',rms * ------------------------------------------------------------ * print to file for reading by smat * drin=0.05d0 * nval=401 * istart=0 * fmt='(4d19.8)' * write(22,10) fmt,drin,nval,istart * 10 format(a20,f10.4,2i10) * do iir=1,nval * rr=(iir-1)*drin * gbden(iir)=oscden(rr,rho0,rad0,diff) * write(19,*) rr,gbden(iir) * enddo * write(22,'(4(d19.8))') (gbden(iir),iir=1,nval) * ------------------------------------------------------------ else if(icho.eq.5.or.icho.eq.6) then * density is read from file iden=6 ijax=500 print*,' using read matter density ' print*,' -----------------------------------------------------' print*,' iden = 6: read matter density ' if(icho.eq.5) print*,' f(r)=Hartree-Fock density' if(icho.eq.6) print*,' f(r)=external density' print* print*,' file with required density is' read '(a)',dname print '(a)',' >>>> '//dname write(18,'(a)') dname open(19,file=dname,status='unknown') print* * following for reading of Hartree-Fock densities if(icho.eq.5)then rewind 19 ico=0 read(19,'(a)') guff read(19,'(a)') guff read(19,'(a)') guff do ijj=1,1000 read(19,*,end=707) rad(ijj),rhop(ijj),rhon(ijj),rhom(ijj) ico=ico+1 enddo 707 continue close(19) ival=ico drin=rad(2)-rad(1) print*,' number of read HF radii ',ival print*,' with step ',drin * ------------------------------------------------------------ * do ijj=1,ival * write(30,*) rad(ijj),rhom(ijj) * enddo * ------------------------------------------------------------ endif if(icho.eq.6)then rewind 19 ico=0 do ijj=1,1000 read(19,*,end=708) rad(ijj),rhom(ijj) ico=ico+1 enddo 708 continue close(19) ival=ico drin=rad(2)-rad(1) print*,' number of read radii ',ival print*,' with step ',drin * ------------------------------------------------------------ * do ijj=1,ival * write(31,*) rad(ijj),rhom(ijj) * enddo * ------------------------------------------------------------ endif endif print*,' -----------------------------------------------------' * ------------------------------------------------------------ * look up potential parameters call assign(iset) alpha=nuc*(nn-zz)/aa * ------------------------------------------------------------ * print*,' Maximum NN relative separation (rptmax) for folding' * read*,rptmax * ------------------------------------------------------------ rptmax=4.d0 * ------------------------------------------------------------ * print9,rptmax * print*,' Quadrature points: radial and cos(theta) integrals' * read*,mqr,mqmu * ------------------------------------------------------------ mqr=32 mqmu=48 * ------------------------------------------------------------ * print*,mqr,mqmu zero=0.d0 one=1.d0 * for integration over radius of target density call gauss(zero,rptmax,mqr,xrt,wrt) * for integration over cos(theta) call gauss(-one,one,mqmu,xmu,wmu) * ------------------------------------------------------------ * Gaussian effective interaction strength (for t=1.0 fm) * and for unit integrated strength * print*,' real and imaginary Gaussian folding ranges t' * read*,tr,ti * print9,tr,ti * ------------------------------------------------------------ tr=1.d0 ti=1.d0 * ------------------------------------------------------------ t2r=tr*tr t2i=ti*ti rmagr=1.d0/(sqrt(pi)*tr)**3 rmagi=1.d0/(sqrt(pi)*ti)**3 * ------------------------------------------------------------ print*,' real and imaginary potential scalings lambda ' if(rlr.lt.1.d-3.and.rli.lt.1.d-3) then print*,' systematics usually suggest 1.0 0.8 ' read*,rlr,rli print*,' >>>> ',rlr,rli write(18,*) rlr,rli print* else print*,' using ',rlr,rli print* endif * ------------------------------------------------------------ i=0 do rp=rstep,rmax+0.01d0,rstep i=i+1 potr(i)=0.d0 poti(i)=0.d0 rp2=rp*rp do imqr=1,mqr rpt=xrt(imqr) rpt2=rpt*rpt gg3r=g3(rmagr,t2r,rpt2)*rpt2 gg3i=g3(rmagi,t2i,rpt2)*rpt2 summr=0.d0 summi=0.d0 do imqmu=1,mqmu bval=rp*rpt*xmu(imqmu) rt2=rpt2+rp2-2.d0*bval rt=sqrt(rt2) if(ilda.eq.1) then rx=rt elseif(ilda.eq.2) then rx=rp elseif(ilda.eq.3) then rx=sqrt(rpt2/4.d0+rp2-bval) endif if(iden.eq.1) then rhot=woosax(rt,rho0,rad0,diff) rhox=woosax(rx,rho0,rad0,diff) elseif(iden.eq.2) then rhot=gauden(rt,rho0,gamma) rhox=gauden(rx,rho0,gamma) elseif(iden.eq.3) then rhot=woosax(rt,rho0,rad0,diff) rhox=woosax(rx,rho0,rad0,diff) elseif(iden.eq.4) then rhot=oscden(rt,rho0,rad0,diff) rhox=oscden(rx,rho0,rad0,diff) elseif(iden.eq.5) then rhot=fermi3(rt,rho0,rad0,diff,www) rhox=fermi3(rx,rho0,rad0,diff,www) elseif(iden.eq.6) then rhot=1.d-15 if(rt.lt.rad(ival)) rhot=terp(rt,rhom,rad,ival,ijax) rhox=1.d-15 if(rx.lt.rad(ival)) then rhoxn=terp(rx,rhon,rad,ival,ijax) rhoxp=terp(rx,rhop,rad,ival,ijax) rhox=rhoxn+rhoxp alpha=nuc*(rhoxn-rhoxp)/rhox * alpha=nuc*(nn-zz)/aa endif endif * if proton take care of Coulomb interaction Ecal=E if(nuc.eq.-1) then if(rx.ge.rc) then vc=1.44d0*zz/rx else vc=0.72d0*zz/rc*(3.d0-(rx/rc)**2) endif Ecal=E-vc endif call pots(Ecal,rhox,iset,V0,W0,V1,W1,rmtilde) summr=summr+wmu(imqmu)*rhot*(V0+alpha*V1)/rhox summi=summi+wmu(imqmu)*rhot*rmtilde*(W0+alpha*W1)/rhox enddo potr(i)=potr(i)+wrt(imqr)*summr*gg3r poti(i)=poti(i)+wrt(imqr)*summi*gg3i enddo potr(i)=2.d0*pi*potr(i)*rlr poti(i)=2.d0*pi*poti(i)*rli * print*,i * write(24,*) rp,potr(i),poti(i) enddo * ------------------------------------------------------------ * call print1(17,aa,zz,nuc,Elab) * call print2(17) * write(17,'(5(e14.7))') (potr(i),i=2,301) * call print2(17) * write(17,'(5(e14.7))') (poti(i),i=2,301) * ------------------------------------------------------------ * for cupid * ------------------------------------------------------------ * write(18,'(a)')' 31. 1.0 1.20 0.61 0. 0.0 ' * write(18,'(a)')'150.0 0.0' * write(18,'(5(e16.7))') (potr(i),i=2,151) * write(18,'(a)')' 31. 0.0 1.20 0.61 0. 1.0 ' * write(18,'(a)')'150.0 1.0' * write(18,'(5(e16.7))') (poti(i),i=2,151) * write(18,'(a)') ' 0' * ------------------------------------------------------------ * for fresco * ------------------------------------------------------------ * write(27,'(a)')'201 0.1 0.0' * write(27,'(5(e16.7))') (potr(i),i=1,201) * write(27,'(a)')'201 0.1 0.0' * write(27,'(5(e16.7))') (poti(i),i=1,201) * ------------------------------------------------------------ return end * ------------------------------------------------------------ subroutine pots(E,rho,iset,V0,W0,V1,W1,rmtilde) implicit real*8(a-h,o-z) real*8 a(3,3),b(3,3),c(3,3),d(4,4),f(4,4),ImN common/arrays/a,b,c,d,f ef=fermi(E,rho,iset) V0=0.d0 ReN=0.d0 rmtilde=0.d0 do i=1,3 do j=1,3 con=rho**i*E**(j-1) V0=V0+a(i,j)*con ReN=ReN+b(i,j)*con rmtilde=rmtilde+c(i,j)*con enddo enddo rmtilde=1.d0-rmtilde V0P=0.d0 do i=1,3 do j=2,3 con=(j-1)*rho**i*E**(j-2) V0P=V0P+a(i,j)*con enddo enddo rmstar=1.d0-V0P W0=0.d0 ImN=0.d0 do i=1,4 do j=1,4 con=rho**i*E**(j-1) W0=W0+d(i,j)*con ImN=ImN+f(i,j)*con enddo enddo c---------------------------------------------------------- * dd=100.d0 * if(iset.eq.1) dd=600.d0 * dd=625.d0 * changed according to Pang/Bauge 2011 c---------------------------------------------------------- dd=126.25d0 W0=W0/(1.d0+dd/(E-ef)**2) ImN=ImN/(1.d0+1.d0/(E-ef)) rmbar=rmstar/rmtilde V1=rmtilde*ReN W1=ImN/rmbar return end * ------------------------------------------------------------ subroutine assign(iset) implicit real*8(a-h,o-z) real*8 a(3,3),b(3,3),c(3,3),d(4,4),f(4,4) common/arrays/a,b,c,d,f c ------------------ a(1,1)=-0.9740d+3 a(1,2)= 0.1126d+2 a(1,3)=-0.4250d-1 a(2,1)= 0.7097d+4 a(2,2)=-0.1257d+3 a(2,3)= 0.5853d+0 a(3,1)=-0.1953d+5 a(3,2)= 0.4180d+3 a(3,3)=-0.2054d+1 c ------------------ b(1,1)= 0.3601d+3 b(1,2)=-0.5224d+1 b(1,3)= 0.2051d-1 b(2,1)=-0.2691d+4 b(2,2)= 0.5130d+2 b(2,3)=-0.2470d+0 b(3,1)= 0.7733d+4 b(3,2)=-0.1717d+3 b(3,3)= 0.8846d+0 c ------------------ c(1,1)= 0.4557d+1 c(1,2)=-0.5291d-2 c(1,3)= 0.6108d-5 c(2,1)=-0.2051d+1 c(2,2)=-0.4906d+0 c(2,3)= 0.1812d-2 c(3,1)=-0.6509d+2 c(3,2)= 0.3095d+1 c(3,3)=-0.1190d-1 go to 100 c ------------------ * if(iset.eq.1) then d(1,1)=-0.1483d+4 d(1,2)= 0.3718d+2 d(1,3)=-0.3549d+0 d(1,4)= 0.1119d-2 d(2,1)= 0.2988d+5 d(2,2)=-0.9318d+3 d(2,3)= 0.9591d+1 d(2,4)=-0.3160d-1 d(3,1)=-0.2128d+6 d(3,2)= 0.7209d+4 d(3,3)=-0.7752d+2 d(3,4)= 0.2611d+0 d(4,1)= 0.5125d+6 d(4,2)=-0.1796d+5 d(4,3)= 0.1980d+3 d(4,4)=-0.6753d+0 c ------------------ f(1,1)= 0.5461d+3 f(1,2)=-0.1120d+2 f(1,3)= 0.1065d+0 f(1,4)=-0.3541d-3 f(2,1)=-0.8471d+4 f(2,2)= 0.2300d+3 f(2,3)=-0.2439d+1 f(2,4)= 0.8544d-2 f(3,1)= 0.5172d+5 f(3,2)=-0.1520d+4 f(3,3)= 0.1717d+2 f(3,4)=-0.6211d-1 f(4,1)=-0.1140d+6 f(4,2)= 0.3543d+4 f(4,3)=-0.4169d+2 f(4,4)= 0.1537d+0 * else * These from JLM d(1,1)=-0.5138d+3 d(1,2)=-0.2985d+2 d(1,3)= 0.1452d+1 d(1,4)= 0.9428d-1 d(2,1)= 0.9078d+4 d(2,2)= 0.5757d+3 d(2,3)=-0.3435d+2 d(2,4)=-0.2310d+1 d(3,1)=-0.6192d+5 d(3,2)=-0.4155d+4 d(3,3)= 0.2657d+3 d(3,4)= 0.1882d+2 d(4,1)= 0.1516d+6 d(4,2)= 0.1037d+5 d(4,3)=-0.6748d+3 d(4,4)=-0.5014d+2 c ------------------ f(1,1)= 0.6597d+3 f(1,2)= 0.4509d+1 f(1,3)=-0.2383d+1 f(1,4)=-0.4324d-1 f(2,1)=-0.1263d+5 f(2,2)=-0.6572d+2 f(2,3)= 0.5866d+2 f(2,4)= 0.1348d+1 f(3,1)= 0.9428d+5 f(3,2)= 0.5972d+3 f(3,3)=-0.4923d+3 f(3,4)=-0.1295d+2 f(4,1)=-0.2453d+6 f(4,2)=-0.1800d+4 f(4,3)= 0.1358d+4 f(4,4)= 0.3836d+2 * These from Bauge (old, Bauge paper) d(1,1)=-0.6599d+3 d(1,2)= 0.1077d+2 d(1,3)=-0.7886d-1 d(1,4)= 0.1875d-3 d(2,1)= 0.1144d+5 d(2,2)=-0.2908d+3 d(2,3)= 0.2443d+1 d(2,4)=-0.6203d-2 d(3,1)=-0.7451d+5 d(3,2)= 0.2207d+4 d(3,3)=-0.1993d+2 d(3,4)= 0.5175d-1 d(4,1)= 0.1761d+6 d(4,2)=-0.5458d+4 d(4,3)= 0.5113d+2 d(4,4)=-0.1339d+0 c ------------------ f(1,1)= 0.4596d+3 f(1,2)=-0.6440d+1 f(1,3)= 0.4040d-1 f(1,4)=-0.9009d-4 f(2,1)=-0.7693d+4 f(2,2)= 0.1464d+3 f(2,3)=-0.1025d+1 f(2,4)= 0.2337d-2 f(3,1)= 0.5525d+5 f(3,2)=-0.1112d+4 f(3,3)= 0.7967d+1 f(3,4)=-0.1802d-1 f(4,1)=-0.1437d+6 f(4,2)= 0.3038d+4 f(4,3)=-0.2220d+2 f(4,4)= 0.5026d-1 100 continue c ------------------ c These from Bauge (from MOM code, Pang 2011) d(1,1)=-0.65986d+3 d(1,2)= 0.10768d+2 d(1,3)=-0.78863d-1 d(1,4)= 0.18755d-3 d(2,1)= 0.11437d+5 d(2,2)=-0.29076d+3 d(2,3)= 0.24430d+1 d(2,4)=-0.62028d-2 d(3,1)=-0.74505d+5 d(3,2)= 0.22068d+4 d(3,3)=-0.19926d+2 d(3,4)= 0.51754d-1 d(4,1)= 0.17609d+6 d(4,2)=-0.54579d+4 d(4,3)= 0.51127d+2 d(4,4)=-0.13386d+0 c ------------------ f(1,1)= 0.45959d+3 f(1,2)=-0.64399d+1 f(1,3)= 0.40403d-1 f(1,4)=-0.90086d-4 f(2,1)=-0.76929d+4 f(2,2)= 0.14639d+3 f(2,3)=-0.10244d+1 f(2,4)= 0.23367d-2 f(3,1)= 0.55250d+5 f(3,2)=-0.11121d+4 f(3,3)= 0.79667d+1 f(3,4)=-0.18008d-1 f(4,1)=-0.14373d+6 f(4,2)= 0.30382d+4 f(4,3)=-0.22202d+2 f(4,4)= 0.50258d-1 c ------------------ * endif return end c--------------------------------------------------------------- real*8 function fermi(E,rho,iset) implicit real*8(a-h,o-z) * Bauge modification PRC 58 page 1120 * E0=10.d0 * change accirding to Pang/Bauge 2011 E0=9.d0 ae=2.d0 fermih=rho*(-510.8d0+3222.d0*rho-6250.d0*rho*rho) fermil=-22.d0-rho*(298.52d0-3760.23d0*rho+ + 12345.82d0*rho*rho) fwt=1.d0/(1.d0+exp((E-E0)/ae)) fermi=fwt*fermil+(1.d0-fwt)*fermih return end c--------------------------------------------------------------- real*8 function woosax(r,rho0,rad0,diff) implicit real*8(a-h,o-z) con=(r-rad0)/diff woosax=rho0/(1.d0+exp(con)) return end c--------------------------------------------------------------- real*8 function fermi3(r,rho0,rad0,diff,www) implicit real*8(a-h,o-z) con=(r-rad0)/diff con1=(r/rad0)**2 fermi3=rho0*(1+www*con1)/(1.d0+exp(con)) return end c--------------------------------------------------------------- subroutine finder3(aa,rms,rho0,rad0,diff,www) implicit real*8(a-h,o-z) rho0=1.d0 call vol3pf(vol,rms,rho0,rad0,diff,www) rho0=aa/vol call vol3pf(vol,rms,rho0,rad0,diff,www) print 24, vol, rms 24 format(' Volume: ',f12.7,' rms ',f12.7) return end c--------------------------------------------------------------- real*8 function oscden(r,rho0,rad0,diff) implicit real*8(a-h,o-z) con=(r/rad0)**2 oscden=rho0*(1+diff*con)*exp(-con) return end c--------------------------------------------------------------- real*8 function gauden(r,rho0,gamma) implicit real*8(a-h,o-z) gauden=rho0*exp(-r*r/gamma/gamma) return end c--------------------------------------------------------------- real*8 function g3(rmag,t2,r2) implicit real*8(a-h,o-z) g3=rmag*exp(-r2/t2) return end c--------------------------------------------------------------- subroutine print1(icc,aa,zz,nuc,E) implicit real*8(a-h,o-z) zn=1.0 if(nuc.eq.1) zn=0.0 write(icc,'(f4.1,a,2f5.1)') zn,' 1.0',zz,aa write(icc,'(f5.1)') E write(icc,1) '0.005 16000 ' write(icc,1) '0. 30. 0.1 ' write(icc,1) '1.25 ' 1 format(a,a,a) return end c--------------------------------------------------------------- subroutine print2(icc) implicit real*8(a-h,o-z) write(icc,1) 'read ' write(icc,1) ' 300 0.100 ((5e14.7)) ' 1 format(a,a,a) return end c--------------------------------------------------------------- subroutine finder(aa,rms,rho0,rad0,diff) implicit real*8(a-h,o-z) common /dcom/ v0, r0, a0, beta2, b2bar pi=4.d0*datan(1.d0) c Woods-Saxon for quadrupole deformed nucleus (beta4 = 0) a0=diff beta2=0.d0 rwant=rms v0 = 0.13269d0 r0 = 1.1d0*aa**(1.d0/3.d0) b2bar = r0 * sqrt(5.d0/(4.d0*pi)) * beta2 call volrms(vol,rms) step = 0.05d0 r0 = r0 + step err = rwant -rms icount =0 10 call volrms(vol,rms2) err2 = rwant -rms2 if (abs(err2).gt.1.d-5) then icount = icount+1 write(6,*) 'radius',icount, rms2 rms = rms2 grad = (err2-err)/step err = err2 step = - err/grad r0 = r0 + step go to 10 end if call volrms(vol,rms) step = 0.05d0 v0 = v0 + step err = aa - vol icount =0 20 call volrms(vol2,rms) err2 = aa - vol2 if (abs(err2).gt.1.d-8) then icount = icount+1 write(6,*) 'depth',icount, vol2 vol = vol2 grad = (err2-err)/step err = err2 step = - err/grad v0 = v0 + step go to 20 end if call volrms(vol,rms) print* print 24, vol, rms 24 format('Volume: ',f12.7,' rms ',f12.7) print 25, v0, r0, a0, beta2 25 format('depth: ',f12.7,' radius ',f12.7,'\n', + 'diffuse: ',f12.7,' defm ',f12.7) print* rho0=v0 rad0=r0 return end c--------------------------------------------------------------- real*8 function den0(r) implicit real*8(a-h,o-z) common /dcom/ v0, r0, a0, beta2, b2bar e0 = 1.d0/(1.d0+exp((r-r0)/a0)) e1 = e0*(1.d0-e0)/a0 e2 = e1*(1.d0 - 2.d0*e0)/a0 e3 = e1*(1.d0-6.d0*e0+6.d0*e0*e0)/(a0*a0) den0 = v0*( e0 + b2bar*b2bar*e2/10.d0 + + b2bar*b2bar*b2bar*e3/105.d0 ) return end c------------------------------------------------------------- subroutine volrms(vol,rms) implicit real*8(a-h,o-z) pi=4.d0*datan(1.d0) h = 0.1d0 rmax = 20.d0 nval = int(rmax/h) + 1 if (mod(nval,3).ne.0) nval = nval+3 - mod(nval,3) sum = 0.d0 sumr2 = 0.d0 do i=0, nval r = i*h r2 = r*r v = den0(r) r2vs = r2*v*simpfac(i,nval) sum = sum + r2vs sumr2 = sumr2 + r2*r2vs end do sum = 4.d0 * pi * sum * (3.d0*h/8.d0) sumr2 = 4.d0 * pi * sumr2 * (3.d0*h/8.d0) vol = sum rms = sqrt(sumr2/sum) return end c----------------------------------------------------------- real*8 function simpfac(i,nstep) c convert degrees to radians implicit none integer i,nstep real*8 sfact if ((i.eq.0).or.(i.eq.nstep)) then sfact= 1.d0 else if (mod(i,3).eq.0) then sfact= 2.d0 else sfact=3.d0 end if simpfac =sfact return end c----------------------------------------------------------- subroutine gauss(a,b,npoint,xri,wri) implicit real*8(a-h,o-z) real*8 xg(200),wg(200),xri(200),wri(200) call setmgl(npoint,xg,wg) do j=1,npoint xri(j) = (a+b)/2.d0 + (b-a)/2.d0*xg(j) wri(j) = (b-a)/2.d0*wg(j) enddo return end c----------------------------------------------------------- subroutine setmgl( n, points, weight ) implicit real*8 ( a-h, o-z ) real*8 points(200), weight(200) real*8 poin16(300) pi = 4.d0*atan(1.d0) if (n.gt.200) write (1,50) 50 format(' setmlg call with too many points') m = ( n + 1 ) / 2 e1 = n * ( n + 1 ) do 1 i = 1, m t = ( 4*i - 1 ) * pi / ( 4*n + 2 ) x0 = ( 1.d0 - ( 1.d0 - 1.d0/n ) / ( 8.d0*n*n ) ) * cos(t) pkm1 = 1.d0 pk = x0 do 3 k = 2, n t1 = x0 * pk pkp1 = t1 - pkm1 - ( t1-pkm1 )/k + t1 pkm1 = pk pk = pkp1 3 continue den = 1.d0 - x0*x0 d1 = n * ( pkm1 - x0*pk ) dpn = d1 / den d2pn = ( 2.d0*x0*dpn - e1*pk ) / den d3pn = ( 4.d0*x0*d2pn + (2.d0-e1)*dpn ) / den d4pn = ( 6.d0*x0*d3pn + (6.d0-e1)*d2pn ) / den u = pk / dpn v = d2pn / dpn h = -u * ( 1.d0 + 0.5d0*u*(v+u*(v*v-u*d3pn/(3.d0*dpn)))) p = pk + h*(dpn+0.5d0*h*(d2pn+h/3.d0*(d3pn+0.25d0*h*d4pn))) dp = dpn + h*(d2pn+0.5d0*h*(d3pn+h*d4pn/3.d0)) h = h - p / dp poin16(i) = x0 + h fx = d1 - h*e1*(pk+0.5d0*h*(dpn+h/3.d0* 1 (d2pn+0.25d0*h*(d3pn+0.2d0*h*d4pn)))) weight(i) = 2.d0 * ( 1.d0 - poin16(i)*poin16(i)) / (fx*fx) 1 continue if ( m + m .gt. n ) poin16(m) = 0.d0 do 10 i = n/2 + 1, n poin16(i) = poin16( n + 1 - i ) weight(i) = weight( n + 1 - i ) poin16( n + 1 - i ) = -poin16( n + 1 - i ) 10 continue do 30 i=1,n 30 points(i)=poin16(i) return end c--------------------------------------------------------------- subroutine finder2(aa,rms,rho0,rad0,diff) implicit real*8(a-h,o-z) pi=4.d0*datan(1.d0) rho0=1.d0 call volosc(vol,rms,rho0,rad0,diff) rho0=aa/vol call volosc(vol,rms,rho0,rad0,diff) print 24, vol, rms 24 format(' Volume: ',f12.7,' rms ',f12.7) return end c------------------------------------------------------------- subroutine volosc(vol,rms,rho0,rad0,diff) implicit real*8(a-h,o-z) pi=4.d0*datan(1.d0) h = 0.1d0 rmax = 20.d0 nval = int(rmax/h) + 1 if (mod(nval,3).ne.0) nval = nval+3 - mod(nval,3) sum = 0.d0 sumr2 = 0.d0 do i=0, nval r = i*h r2 = r*r v=oscden(r,rho0,rad0,diff) r2vs = r2*v*simpfac(i,nval) sum = sum + r2vs sumr2 = sumr2 + r2*r2vs end do sum = 4.d0 * pi * sum * (3.d0*h/8.d0) sumr2 = 4.d0 * pi * sumr2 * (3.d0*h/8.d0) vol = sum rms = sqrt(sumr2/sum) return end c------------------------------------------------------------- subroutine vol3pf(vol,rms,rho0,rad0,diff,www) implicit real*8(a-h,o-z) pi=4.d0*datan(1.d0) h = 0.1d0 rmax = 20.d0 nval = int(rmax/h) + 1 if (mod(nval,3).ne.0) nval = nval+3 - mod(nval,3) sum = 0.d0 sumr2 = 0.d0 do i=0, nval r = i*h r2 = r*r v=fermi3(r,rho0,rad0,diff,www) r2vs = r2*v*simpfac(i,nval) sum = sum + r2vs sumr2 = sumr2 + r2*r2vs end do sum = 4.d0 * pi * sum * (3.d0*h/8.d0) sumr2 = 4.d0 * pi * sumr2 * (3.d0*h/8.d0) vol = sum rms = sqrt(sumr2/sum) return end c------------------------------------------------------------- real*8 function terp(r,fun,rgrid,npts,ndim) c------------------------------------------------------------------------------ c this function calculates, by interpolation, the value of a real c function at an arbitrary point r, when the value of the function c (stored in array fun) is known on a grid of points. The values of the c npts points at which the function is known is stored in array rgrid. c ndim is the externally defined dimensions of the arrays fun and rgrid c JAT routine of some vintage. c------------------------------------------------------------------------------ implicit double precision(a-h,o-z) real*8 fun(ndim),y1,y2,y3,y4,y5,y6 double precision rgrid(ndim) do 30 k=1,npts nst=0 if(rgrid(k).lt.r) goto 30 nst=max0(k-3,1) goto 33 30 continue 33 if(nst.gt.npts-5) nst=npts-5 x1=rgrid(nst+0) x2=rgrid(nst+1) x3=rgrid(nst+2) x4=rgrid(nst+3) x5=rgrid(nst+4) x6=rgrid(nst+5) y1=fun(nst+0) y2=fun(nst+1) y3=fun(nst+2) y4=fun(nst+3) y5=fun(nst+4) y6=fun(nst+5) pii1=(x1-x2)*(x1-x3)*(x1-x4)*(x1-x5)*(x1-x6) pii2=(x2-x1)*(x2-x3)*(x2-x4)*(x2-x5)*(x2-x6) pii3=(x3-x1)*(x3-x2)*(x3-x4)*(x3-x5)*(x3-x6) pii4=(x4-x1)*(x4-x2)*(x4-x3)*(x4-x5)*(x4-x6) pii5=(x5-x1)*(x5-x2)*(x5-x3)*(x5-x4)*(x5-x6) pii6=(x6-x1)*(x6-x2)*(x6-x3)*(x6-x4)*(x6-x5) 777 xd1=r-x1 xd2=r-x2 xd3=r-x3 xd4=r-x4 xd5=r-x5 xd6=r-x6 pi1= xd2*xd3*xd4*xd5*xd6 pi2= xd1*xd3*xd4*xd5*xd6 pi3= xd1*xd2*xd4*xd5*xd6 pi4= xd1*xd2*xd3*xd5*xd6 pi5= xd1*xd2*xd3*xd4*xd6 pi6= xd1*xd2*xd3*xd4*xd5 terp=y1*pi1/pii1+y2*pi2/pii2+y3*pi3/pii3+y4*pi4/pii4+ + y5*pi5/pii5+y6*pi6/pii6 return end *------------------------------------------------------------------------ subroutine av18wf *------------------------------------------------------------------------ * av18 wavefunction r-space - called once to set up function arrays * from routine folder if this is the wavefunction choice: ideutwf=4 *------------------------------------------------------------------------ implicit real*8(a-h,o-z) parameter (rmn=939.565d0,rmp=938.272d0, rmu=rmn*rmp/(rmn+rmp)) parameter (ed=-2.22452d0, h=0.01d0, hc=197.32696010352811d0) common/avstuff/uavs(1501),vavs(1501),uavd(1501),vavd(1501) common/avstuf2/uasp(1501),uadp(1501) c ------------------------------------------------------------------- data vavs/1501*0.0d0/,vavd/1501*0.0d0/ c s-state radial wave function: r=0 to 15 fm, steps of 0.01 fm data uavs/0.0d0, + 0.7920652E-03, 0.1588732E-02, 0.2394609E-02, 0.3214325E-02, + 0.4052529E-02, 0.4913901E-02, 0.5803156E-02, 0.6725043E-02, + 0.7684354E-02, 0.8685919E-02, 0.9734610E-02, 0.1083533E-01, + 0.1199303E-01, 0.1321268E-01, 0.1449927E-01, 0.1585780E-01, + 0.1729329E-01, 0.1881074E-01, 0.2041512E-01, 0.2211138E-01, + 0.2390440E-01, 0.2579898E-01, 0.2779984E-01, 0.2991158E-01, + 0.3213867E-01, 0.3448538E-01, 0.3695584E-01, 0.3955395E-01, + 0.4228335E-01, 0.4514745E-01, 0.4814936E-01, 0.5129187E-01, + 0.5457743E-01, 0.5800815E-01, 0.6158573E-01, 0.6531150E-01, + 0.6918633E-01, 0.7321068E-01, 0.7738455E-01, 0.8170749E-01, + 0.8617855E-01, 0.9079633E-01, 0.9555893E-01, 0.1004640E+00, + 0.1055086E+00, 0.1106896E+00, 0.1160030E+00, 0.1214447E+00, + 0.1270100E+00, 0.1326939E+00, 0.1384908E+00, 0.1443949E+00, + 0.1504000E+00, 0.1564997E+00, 0.1626871E+00, 0.1689552E+00, + 0.1752968E+00, 0.1817044E+00, 0.1881704E+00, 0.1946871E+00, + 0.2012467E+00, 0.2078415E+00, 0.2144635E+00, 0.2211049E+00, + 0.2277580E+00, 0.2344151E+00, 0.2410687E+00, 0.2477113E+00, + 0.2543357E+00, 0.2609349E+00, 0.2675021E+00, 0.2740307E+00, + 0.2805143E+00, 0.2869471E+00, 0.2933231E+00, 0.2996370E+00, + 0.3058836E+00, 0.3120581E+00, 0.3181560E+00, 0.3241731E+00, + 0.3301056E+00, 0.3359498E+00, 0.3417027E+00, 0.3473612E+00, + 0.3529229E+00, 0.3583853E+00, 0.3637465E+00, 0.3690047E+00, + 0.3741586E+00, 0.3792069E+00, 0.3841486E+00, 0.3889832E+00, + 0.3937100E+00, 0.3983290E+00, 0.4028399E+00, 0.4072429E+00, + 0.4115383E+00, 0.4157267E+00, 0.4198085E+00, 0.4237846E+00, + 0.4276559E+00, 0.4314232E+00, 0.4350879E+00, 0.4386510E+00, + 0.4421138E+00, 0.4454777E+00, 0.4487441E+00, 0.4519145E+00, + 0.4549904E+00, 0.4579734E+00, 0.4608651E+00, 0.4636671E+00, + 0.4663810E+00, 0.4690086E+00, 0.4715515E+00, 0.4740113E+00, + 0.4763899E+00, 0.4786888E+00, 0.4809097E+00, 0.4830544E+00, + 0.4851244E+00, 0.4871213E+00, 0.4890469E+00, 0.4909027E+00, + 0.4926903E+00, 0.4944113E+00, 0.4960671E+00, 0.4976594E+00, + 0.4991895E+00, 0.5006589E+00, 0.5020691E+00, 0.5034215E+00, + 0.5047174E+00, 0.5059581E+00, 0.5071451E+00, 0.5082795E+00, + 0.5093627E+00, 0.5103958E+00, 0.5113801E+00, 0.5123168E+00, + 0.5132069E+00, 0.5140517E+00, 0.5148521E+00, 0.5156093E+00, + 0.5163244E+00, 0.5169982E+00, 0.5176319E+00, 0.5182264E+00, + 0.5187826E+00, 0.5193014E+00, 0.5197838E+00, 0.5202307E+00, + 0.5206428E+00, 0.5210210E+00, 0.5213661E+00, 0.5216790E+00, + 0.5219604E+00, 0.5222110E+00, 0.5224316E+00, 0.5226229E+00, + 0.5227856E+00, 0.5229203E+00, 0.5230279E+00, 0.5231088E+00, + 0.5231638E+00, 0.5231934E+00, 0.5231983E+00, 0.5231790E+00, + 0.5231362E+00, 0.5230704E+00, 0.5229821E+00, 0.5228719E+00, + 0.5227403E+00, 0.5225878E+00, 0.5224149E+00, 0.5222221E+00, + 0.5220100E+00, 0.5217788E+00, 0.5215292E+00, 0.5212615E+00, + 0.5209762E+00, 0.5206737E+00, 0.5203544E+00, 0.5200188E+00, + 0.5196671E+00, 0.5192999E+00, 0.5189175E+00, 0.5185202E+00, + 0.5181085E+00, 0.5176826E+00, 0.5172430E+00, 0.5167899E+00, + 0.5163237E+00, 0.5158448E+00, 0.5153533E+00, 0.5148497E+00, + 0.5143342E+00, 0.5138072E+00, 0.5132689E+00, 0.5127196E+00, + 0.5121596E+00, 0.5115891E+00, 0.5110085E+00, 0.5104179E+00, + 0.5098177E+00, 0.5092080E+00, 0.5085892E+00, 0.5079614E+00, + 0.5073249E+00, 0.5066799E+00, 0.5060266E+00, 0.5053653E+00, + 0.5046962E+00, 0.5040194E+00, 0.5033352E+00, 0.5026438E+00, + 0.5019453E+00, 0.5012400E+00, 0.5005280E+00, 0.4998096E+00, + 0.4990848E+00, 0.4983539E+00, 0.4976171E+00, 0.4968744E+00, + 0.4961261E+00, 0.4953724E+00, 0.4946133E+00, 0.4938491E+00, + 0.4930799E+00, 0.4923058E+00, 0.4915269E+00, 0.4907435E+00, + 0.4899556E+00, 0.4891634E+00, 0.4883670E+00, 0.4875666E+00, + 0.4867622E+00, 0.4859540E+00, 0.4851421E+00, 0.4843266E+00, + 0.4835076E+00, 0.4826853E+00, 0.4818598E+00, 0.4810311E+00, + 0.4801994E+00, 0.4793648E+00, 0.4785273E+00, 0.4776871E+00, + 0.4768443E+00, 0.4759989E+00, 0.4751511E+00, 0.4743009E+00, + 0.4734484E+00, 0.4725938E+00, 0.4717370E+00, 0.4708782E+00, + 0.4700175E+00, 0.4691549E+00, 0.4682906E+00, 0.4674245E+00, + 0.4665568E+00, 0.4656875E+00, 0.4648167E+00, 0.4639445E+00, + 0.4630710E+00, 0.4621961E+00, 0.4613200E+00, 0.4604428E+00, + 0.4595644E+00, 0.4586850E+00, 0.4578047E+00, 0.4569233E+00, + 0.4560412E+00, 0.4551582E+00, 0.4542744E+00, 0.4533900E+00, + 0.4525049E+00, 0.4516191E+00, 0.4507329E+00, 0.4498461E+00, + 0.4489588E+00, 0.4480712E+00, 0.4471832E+00, 0.4462948E+00, + 0.4454062E+00, 0.4445173E+00, 0.4436282E+00, 0.4427390E+00, + 0.4418497E+00, 0.4409603E+00, 0.4400708E+00, 0.4391813E+00, + 0.4382919E+00, 0.4374025E+00, 0.4365133E+00, 0.4356242E+00, + 0.4347352E+00, 0.4338465E+00, 0.4329580E+00, 0.4320697E+00, + 0.4311818E+00, 0.4302942E+00, 0.4294069E+00, 0.4285200E+00, + 0.4276336E+00, 0.4267475E+00, 0.4258620E+00, 0.4249769E+00, + 0.4240923E+00, 0.4232083E+00, 0.4223249E+00, 0.4214420E+00, + 0.4205598E+00, 0.4196782E+00, 0.4187972E+00, 0.4179170E+00, + 0.4170374E+00, 0.4161586E+00, 0.4152805E+00, 0.4144031E+00, + 0.4135266E+00, 0.4126508E+00, 0.4117759E+00, 0.4109018E+00, + 0.4100285E+00, 0.4091561E+00, 0.4082847E+00, 0.4074141E+00, + 0.4065444E+00, 0.4056757E+00, 0.4048079E+00, 0.4039411E+00, + 0.4030753E+00, 0.4022105E+00, 0.4013467E+00, 0.4004839E+00, + 0.3996222E+00, 0.3987615E+00, 0.3979018E+00, 0.3970433E+00, + 0.3961858E+00, 0.3953294E+00, 0.3944742E+00, 0.3936201E+00, + 0.3927671E+00, 0.3919152E+00, 0.3910645E+00, 0.3902150E+00, + 0.3893666E+00, 0.3885195E+00, 0.3876735E+00, 0.3868287E+00, + 0.3859852E+00, 0.3851428E+00, 0.3843017E+00, 0.3834619E+00, + 0.3826232E+00, 0.3817859E+00, 0.3809498E+00, 0.3801150E+00, + 0.3792814E+00, 0.3784491E+00, 0.3776182E+00, 0.3767885E+00, + 0.3759601E+00, 0.3751331E+00, 0.3743073E+00, 0.3734829E+00, + 0.3726598E+00, 0.3718380E+00, 0.3710176E+00, 0.3701986E+00, + 0.3693809E+00, 0.3685645E+00, 0.3677495E+00, 0.3669359E+00, + 0.3661236E+00, 0.3653127E+00, 0.3645032E+00, 0.3636951E+00, + 0.3628884E+00, 0.3620830E+00, 0.3612791E+00, 0.3604766E+00, + 0.3596754E+00, 0.3588757E+00, 0.3580774E+00, 0.3572805E+00, + 0.3564850E+00, 0.3556909E+00, 0.3548983E+00, 0.3541070E+00, + 0.3533172E+00, 0.3525289E+00, 0.3517420E+00, 0.3509565E+00, + 0.3501724E+00, 0.3493898E+00, 0.3486086E+00, 0.3478289E+00, + 0.3470506E+00, 0.3462738E+00, 0.3454984E+00, 0.3447244E+00, + 0.3439520E+00, 0.3431809E+00, 0.3424114E+00, 0.3416433E+00, + 0.3408766E+00, 0.3401114E+00, 0.3393477E+00, 0.3385854E+00, + 0.3378246E+00, 0.3370653E+00, 0.3363074E+00, 0.3355510E+00, + 0.3347960E+00, 0.3340425E+00, 0.3332905E+00, 0.3325400E+00, + 0.3317909E+00, 0.3310433E+00, 0.3302971E+00, 0.3295525E+00, + 0.3288093E+00, 0.3280675E+00, 0.3273273E+00, 0.3265885E+00, + 0.3258512E+00, 0.3251153E+00, 0.3243809E+00, 0.3236480E+00, + 0.3229166E+00, 0.3221866E+00, 0.3214581E+00, 0.3207310E+00, + 0.3200055E+00, 0.3192814E+00, 0.3185587E+00, 0.3178376E+00, + 0.3171179E+00, 0.3163996E+00, 0.3156828E+00, 0.3149675E+00, + 0.3142537E+00, 0.3135413E+00, 0.3128304E+00, 0.3121209E+00, + 0.3114129E+00, 0.3107064E+00, 0.3100013E+00, 0.3092976E+00, + 0.3085955E+00, 0.3078948E+00, 0.3071955E+00, 0.3064977E+00, + 0.3058013E+00, 0.3051064E+00, 0.3044130E+00, 0.3037209E+00, + 0.3030304E+00, 0.3023413E+00, 0.3016536E+00, 0.3009674E+00, + 0.3002826E+00, 0.2995992E+00, 0.2989173E+00, 0.2982368E+00, + 0.2975578E+00, 0.2968802E+00, 0.2962040E+00, 0.2955293E+00, + 0.2948560E+00, 0.2941841E+00, 0.2935137E+00, 0.2928446E+00, + 0.2921770E+00, 0.2915108E+00, 0.2908461E+00, 0.2901827E+00, + 0.2895208E+00, 0.2888603E+00, 0.2882012E+00, 0.2875435E+00, + 0.2868872E+00, 0.2862324E+00, 0.2855789E+00, 0.2849269E+00, + 0.2842762E+00, 0.2836269E+00, 0.2829791E+00, 0.2823326E+00, + 0.2816876E+00, 0.2810439E+00, 0.2804016E+00, 0.2797607E+00, + 0.2791212E+00, 0.2784831E+00, 0.2778464E+00, 0.2772110E+00, + 0.2765770E+00, 0.2759444E+00, 0.2753132E+00, 0.2746834E+00, + 0.2740549E+00, 0.2734278E+00, 0.2728020E+00, 0.2721776E+00, + 0.2715546E+00, 0.2709330E+00, 0.2703127E+00, 0.2696937E+00, + 0.2690762E+00, 0.2684599E+00, 0.2678450E+00, 0.2672315E+00, + 0.2666193E+00, 0.2660085E+00, 0.2653990E+00, 0.2647908E+00, + 0.2641840E+00, 0.2635785E+00, 0.2629743E+00, 0.2623715E+00, + 0.2617700E+00, 0.2611698E+00, 0.2605709E+00, 0.2599734E+00, + 0.2593772E+00, 0.2587823E+00, 0.2581887E+00, 0.2575965E+00, + 0.2570055E+00, 0.2564158E+00, 0.2558275E+00, 0.2552405E+00, + 0.2546547E+00, 0.2540703E+00, 0.2534871E+00, 0.2529053E+00, + 0.2523247E+00, 0.2517454E+00, 0.2511674E+00, 0.2505907E+00, + 0.2500153E+00, 0.2494412E+00, 0.2488683E+00, 0.2482967E+00, + 0.2477264E+00, 0.2471574E+00, 0.2465896E+00, 0.2460231E+00, + 0.2454579E+00, 0.2448939E+00, 0.2443312E+00, 0.2437697E+00, + 0.2432095E+00, 0.2426505E+00, 0.2420928E+00, 0.2415364E+00, + 0.2409812E+00, 0.2404272E+00, 0.2398745E+00, 0.2393230E+00, + 0.2387727E+00, 0.2382237E+00, 0.2376759E+00, 0.2371293E+00, + 0.2365840E+00, 0.2360398E+00, 0.2354970E+00, 0.2349553E+00, + 0.2344148E+00, 0.2338756E+00, 0.2333375E+00, 0.2328007E+00, + 0.2322651E+00, 0.2317307E+00, 0.2311975E+00, 0.2306655E+00, + 0.2301346E+00, 0.2296050E+00, 0.2290766E+00, 0.2285494E+00, + 0.2280233E+00, 0.2274985E+00, 0.2269748E+00, 0.2264523E+00, + 0.2259310E+00, 0.2254108E+00, 0.2248919E+00, 0.2243741E+00, + 0.2238574E+00, 0.2233420E+00, 0.2228277E+00, 0.2223146E+00, + 0.2218026E+00, 0.2212918E+00, 0.2207821E+00, 0.2202736E+00, + 0.2197662E+00, 0.2192600E+00, 0.2187550E+00, 0.2182511E+00, + 0.2177483E+00, 0.2172466E+00, 0.2167461E+00, 0.2162468E+00, + 0.2157485E+00, 0.2152514E+00, 0.2147554E+00, 0.2142606E+00, + 0.2137669E+00, 0.2132742E+00, 0.2127827E+00, 0.2122924E+00, + 0.2118031E+00, 0.2113149E+00, 0.2108279E+00, 0.2103419E+00, + 0.2098571E+00, 0.2093734E+00, 0.2088907E+00, 0.2084092E+00, + 0.2079287E+00, 0.2074494E+00, 0.2069711E+00, 0.2064939E+00, + 0.2060178E+00, 0.2055428E+00, 0.2050689E+00, 0.2045961E+00, + 0.2041243E+00, 0.2036536E+00, 0.2031840E+00, 0.2027154E+00, + 0.2022479E+00, 0.2017815E+00, 0.2013161E+00, 0.2008518E+00, + 0.2003886E+00, 0.1999264E+00, 0.1994652E+00, 0.1990052E+00, + 0.1985461E+00, 0.1980881E+00, 0.1976312E+00, 0.1971753E+00, + 0.1967204E+00, 0.1962666E+00, 0.1958138E+00, 0.1953620E+00, + 0.1949113E+00, 0.1944616E+00, 0.1940130E+00, 0.1935653E+00, + 0.1931187E+00, 0.1926731E+00, 0.1922285E+00, 0.1917849E+00, + 0.1913424E+00, 0.1909008E+00, 0.1904603E+00, 0.1900208E+00, + 0.1895822E+00, 0.1891447E+00, 0.1887082E+00, 0.1882727E+00, + 0.1878381E+00, 0.1874046E+00, 0.1869721E+00, 0.1865405E+00, + 0.1861100E+00, 0.1856804E+00, 0.1852518E+00, 0.1848242E+00, + 0.1843975E+00, 0.1839719E+00, 0.1835472E+00, 0.1831235E+00, + 0.1827007E+00, 0.1822789E+00, 0.1818581E+00, 0.1814383E+00, + 0.1810194E+00, 0.1806015E+00, 0.1801845E+00, 0.1797685E+00, + 0.1793534E+00, 0.1789393E+00, 0.1785262E+00, 0.1781140E+00, + 0.1777027E+00, 0.1772924E+00, 0.1768830E+00, 0.1764745E+00, + 0.1760670E+00, 0.1756604E+00, 0.1752548E+00, 0.1748501E+00, + 0.1744463E+00, 0.1740435E+00, 0.1736415E+00, 0.1732405E+00, + 0.1728404E+00, 0.1724412E+00, 0.1720430E+00, 0.1716456E+00, + 0.1712492E+00, 0.1708537E+00, 0.1704591E+00, 0.1700654E+00, + 0.1696726E+00, 0.1692807E+00, 0.1688897E+00, 0.1684996E+00, + 0.1681103E+00, 0.1677220E+00, 0.1673346E+00, 0.1669481E+00, + 0.1665624E+00, 0.1661777E+00, 0.1657938E+00, 0.1654108E+00, + 0.1650287E+00, 0.1646474E+00, 0.1642671E+00, 0.1638876E+00, + 0.1635090E+00, 0.1631312E+00, 0.1627544E+00, 0.1623784E+00, + 0.1620032E+00, 0.1616289E+00, 0.1612555E+00, 0.1608829E+00, + 0.1605112E+00, 0.1601404E+00, 0.1597704E+00, 0.1594012E+00, + 0.1590329E+00, 0.1586655E+00, 0.1582989E+00, 0.1579331E+00, + 0.1575682E+00, 0.1572041E+00, 0.1568409E+00, 0.1564784E+00, + 0.1561169E+00, 0.1557561E+00, 0.1553962E+00, 0.1550371E+00, + 0.1546789E+00, 0.1543214E+00, 0.1539648E+00, 0.1536090E+00, + 0.1532540E+00, 0.1528999E+00, 0.1525465E+00, 0.1521940E+00, + 0.1518423E+00, 0.1514914E+00, 0.1511413E+00, 0.1507920E+00, + 0.1504435E+00, 0.1500958E+00, 0.1497489E+00, 0.1494028E+00, + 0.1490576E+00, 0.1487131E+00, 0.1483694E+00, 0.1480264E+00, + 0.1476843E+00, 0.1473430E+00, 0.1470024E+00, 0.1466627E+00, + 0.1463237E+00, 0.1459855E+00, 0.1456481E+00, 0.1453114E+00, + 0.1449756E+00, 0.1446405E+00, 0.1443062E+00, 0.1439726E+00, + 0.1436398E+00, 0.1433078E+00, 0.1429766E+00, 0.1426461E+00, + 0.1423163E+00, 0.1419874E+00, 0.1416592E+00, 0.1413317E+00, + 0.1410050E+00, 0.1406791E+00, 0.1403539E+00, 0.1400294E+00, + 0.1397058E+00, 0.1393828E+00, 0.1390606E+00, 0.1387391E+00, + 0.1384184E+00, 0.1380984E+00, 0.1377792E+00, 0.1374607E+00, + 0.1371429E+00, 0.1368259E+00, 0.1365096E+00, 0.1361940E+00, + 0.1358791E+00, 0.1355650E+00, 0.1352516E+00, 0.1349389E+00, + 0.1346270E+00, 0.1343157E+00, 0.1340052E+00, 0.1336954E+00, + 0.1333863E+00, 0.1330779E+00, 0.1327703E+00, 0.1324633E+00, + 0.1321571E+00, 0.1318515E+00, 0.1315467E+00, 0.1312425E+00, + 0.1309391E+00, 0.1306364E+00, 0.1303343E+00, 0.1300330E+00, + 0.1297324E+00, 0.1294324E+00, 0.1291332E+00, 0.1288346E+00, + 0.1285367E+00, 0.1282395E+00, 0.1279430E+00, 0.1276472E+00, + 0.1273521E+00, 0.1270576E+00, 0.1267638E+00, 0.1264707E+00, + 0.1261783E+00, 0.1258866E+00, 0.1255955E+00, 0.1253051E+00, + 0.1250154E+00, 0.1247263E+00, 0.1244379E+00, 0.1241502E+00, + 0.1238631E+00, 0.1235767E+00, 0.1232910E+00, 0.1230059E+00, + 0.1227214E+00, 0.1224377E+00, 0.1221546E+00, 0.1218721E+00, + 0.1215903E+00, 0.1213091E+00, 0.1210286E+00, 0.1207488E+00, + 0.1204696E+00, 0.1201910E+00, 0.1199131E+00, 0.1196358E+00, + 0.1193591E+00, 0.1190831E+00, 0.1188078E+00, 0.1185330E+00, + 0.1182589E+00, 0.1179855E+00, 0.1177126E+00, 0.1174404E+00, + 0.1171688E+00, 0.1168979E+00, 0.1166276E+00, 0.1163579E+00, + 0.1160888E+00, 0.1158203E+00, 0.1155525E+00, 0.1152853E+00, + 0.1150187E+00, 0.1147527E+00, 0.1144873E+00, 0.1142226E+00, + 0.1139584E+00, 0.1136949E+00, 0.1134320E+00, 0.1131696E+00, + 0.1129079E+00, 0.1126468E+00, 0.1123863E+00, 0.1121264E+00, + 0.1118671E+00, 0.1116084E+00, 0.1113503E+00, 0.1110928E+00, + 0.1108359E+00, 0.1105795E+00, 0.1103238E+00, 0.1100687E+00, + 0.1098141E+00, 0.1095602E+00, 0.1093068E+00, 0.1090540E+00, + 0.1088018E+00, 0.1085502E+00, 0.1082991E+00, 0.1080487E+00, + 0.1077988E+00, 0.1075495E+00, 0.1073007E+00, 0.1070526E+00, + 0.1068050E+00, 0.1065580E+00, 0.1063115E+00, 0.1060657E+00, + 0.1058204E+00, 0.1055756E+00, 0.1053315E+00, 0.1050879E+00, + 0.1048448E+00, 0.1046023E+00, 0.1043604E+00, 0.1041190E+00, + 0.1038782E+00, 0.1036380E+00, 0.1033983E+00, 0.1031592E+00, + 0.1029206E+00, 0.1026825E+00, 0.1024451E+00, 0.1022081E+00, + 0.1019717E+00, 0.1017359E+00, 0.1015006E+00, 0.1012658E+00, + 0.1010316E+00, 0.1007979E+00, 0.1005648E+00, 0.1003322E+00, + 0.1001002E+00, 0.9986865E-01, 0.9963767E-01, 0.9940722E-01, + 0.9917730E-01, 0.9894792E-01, 0.9871906E-01, 0.9849073E-01, + 0.9826293E-01, 0.9803566E-01, 0.9780892E-01, 0.9758269E-01, + 0.9735699E-01, 0.9713181E-01, 0.9690716E-01, 0.9668302E-01, + 0.9645940E-01, 0.9623629E-01, 0.9601370E-01, 0.9579163E-01, + 0.9557007E-01, 0.9534902E-01, 0.9512848E-01, 0.9490846E-01, + 0.9468894E-01, 0.9446993E-01, 0.9425142E-01, 0.9403342E-01, + 0.9381592E-01, 0.9359893E-01, 0.9338244E-01, 0.9316645E-01, + 0.9295095E-01, 0.9273596E-01, 0.9252146E-01, 0.9230746E-01, + 0.9209395E-01, 0.9188094E-01, 0.9166842E-01, 0.9145639E-01, + 0.9124485E-01, 0.9103380E-01, 0.9082324E-01, 0.9061316E-01, + 0.9040357E-01, 0.9019447E-01, 0.8998584E-01, 0.8977770E-01, + 0.8957004E-01, 0.8936287E-01, 0.8915617E-01, 0.8894994E-01, + 0.8874420E-01, 0.8853893E-01, 0.8833413E-01, 0.8812981E-01, + 0.8792596E-01, 0.8772259E-01, 0.8751968E-01, 0.8731724E-01, + 0.8711527E-01, 0.8691377E-01, 0.8671273E-01, 0.8651215E-01, + 0.8631205E-01, 0.8611240E-01, 0.8591321E-01, 0.8571449E-01, + 0.8551622E-01, 0.8531842E-01, 0.8512107E-01, 0.8492418E-01, + 0.8472774E-01, 0.8453175E-01, 0.8433622E-01, 0.8414114E-01, + 0.8394652E-01, 0.8375234E-01, 0.8355861E-01, 0.8336533E-01, + 0.8317250E-01, 0.8298011E-01, 0.8278817E-01, 0.8259667E-01, + 0.8240561E-01, 0.8221500E-01, 0.8202482E-01, 0.8183509E-01, + 0.8164579E-01, 0.8145694E-01, 0.8126852E-01, 0.8108053E-01, + 0.8089298E-01, 0.8070586E-01, 0.8051918E-01, 0.8033293E-01, + 0.8014710E-01, 0.7996171E-01, 0.7977675E-01, 0.7959221E-01, + 0.7940810E-01, 0.7922442E-01, 0.7904116E-01, 0.7885833E-01, + 0.7867591E-01, 0.7849392E-01, 0.7831235E-01, 0.7813120E-01, + 0.7795047E-01, 0.7777016E-01, 0.7759026E-01, 0.7741078E-01, + 0.7723172E-01, 0.7705307E-01, 0.7687483E-01, 0.7669701E-01, + 0.7651959E-01, 0.7634259E-01, 0.7616599E-01, 0.7598981E-01, + 0.7581403E-01, 0.7563865E-01, 0.7546369E-01, 0.7528913E-01, + 0.7511497E-01, 0.7494121E-01, 0.7476786E-01, 0.7459490E-01, + 0.7442235E-01, 0.7425020E-01, 0.7407844E-01, 0.7390708E-01, + 0.7373612E-01, 0.7356555E-01, 0.7339538E-01, 0.7322560E-01, + 0.7305621E-01, 0.7288722E-01, 0.7271862E-01, 0.7255040E-01, + 0.7238258E-01, 0.7221514E-01, 0.7204809E-01, 0.7188143E-01, + 0.7171515E-01, 0.7154925E-01, 0.7138374E-01, 0.7121862E-01, + 0.7105387E-01, 0.7088951E-01, 0.7072552E-01, 0.7056192E-01, + 0.7039869E-01, 0.7023584E-01, 0.7007337E-01, 0.6991128E-01, + 0.6974955E-01, 0.6958821E-01, 0.6942723E-01, 0.6926663E-01, + 0.6910640E-01, 0.6894654E-01, 0.6878705E-01, 0.6862793E-01, + 0.6846917E-01, 0.6831079E-01, 0.6815277E-01, 0.6799511E-01, + 0.6783782E-01, 0.6768090E-01, 0.6752433E-01, 0.6736813E-01, + 0.6721229E-01, 0.6705681E-01, 0.6690169E-01, 0.6674693E-01, + 0.6659253E-01, 0.6643848E-01, 0.6628479E-01, 0.6613146E-01, + 0.6597848E-01, 0.6582585E-01, 0.6567358E-01, 0.6552166E-01, + 0.6537009E-01, 0.6521887E-01, 0.6506800E-01, 0.6491748E-01, + 0.6476731E-01, 0.6461749E-01, 0.6446801E-01, 0.6431888E-01, + 0.6417009E-01, 0.6402165E-01, 0.6387355E-01, 0.6372579E-01, + 0.6357837E-01, 0.6343130E-01, 0.6328456E-01, 0.6313817E-01, + 0.6299211E-01, 0.6284639E-01, 0.6270101E-01, 0.6255597E-01, + 0.6241126E-01, 0.6226688E-01, 0.6212284E-01, 0.6197913E-01, + 0.6183575E-01, 0.6169271E-01, 0.6155000E-01, 0.6140761E-01, + 0.6126556E-01, 0.6112384E-01, 0.6098244E-01, 0.6084137E-01, + 0.6070062E-01, 0.6056020E-01, 0.6042011E-01, 0.6028034E-01, + 0.6014089E-01, 0.6000177E-01, 0.5986297E-01, 0.5972449E-01, + 0.5958633E-01, 0.5944849E-01, 0.5931096E-01, 0.5917376E-01, + 0.5903687E-01, 0.5890030E-01, 0.5876405E-01, 0.5862811E-01, + 0.5849248E-01, 0.5835717E-01, 0.5822217E-01, 0.5808749E-01, + 0.5795311E-01, 0.5781905E-01, 0.5768530E-01, 0.5755185E-01, + 0.5741872E-01, 0.5728589E-01, 0.5715337E-01, 0.5702115E-01, + 0.5688925E-01, 0.5675764E-01, 0.5662635E-01, 0.5649535E-01, + 0.5636466E-01, 0.5623427E-01, 0.5610418E-01, 0.5597440E-01, + 0.5584491E-01, 0.5571572E-01, 0.5558683E-01, 0.5545824E-01, + 0.5532995E-01, 0.5520195E-01, 0.5507425E-01, 0.5494685E-01, + 0.5481974E-01, 0.5469292E-01, 0.5456640E-01, 0.5444017E-01, + 0.5431423E-01, 0.5418859E-01, 0.5406323E-01, 0.5393817E-01, + 0.5381339E-01, 0.5368890E-01, 0.5356470E-01, 0.5344079E-01, + 0.5331716E-01, 0.5319382E-01, 0.5307077E-01, 0.5294800E-01, + 0.5282551E-01, 0.5270331E-01, 0.5258139E-01, 0.5245975E-01, + 0.5233839E-01, 0.5221732E-01, 0.5209652E-01, 0.5197600E-01, + 0.5185576E-01, 0.5173580E-01, 0.5161612E-01, 0.5149672E-01, + 0.5137759E-01, 0.5125873E-01, 0.5114016E-01, 0.5102185E-01, + 0.5090382E-01, 0.5078606E-01, 0.5066858E-01, 0.5055136E-01, + 0.5043442E-01, 0.5031775E-01, 0.5020135E-01, 0.5008521E-01, + 0.4996935E-01, 0.4985375E-01, 0.4973842E-01, 0.4962336E-01, + 0.4950857E-01, 0.4939404E-01, 0.4927977E-01, 0.4916577E-01, + 0.4905203E-01, 0.4893856E-01, 0.4882535E-01, 0.4871240E-01, + 0.4859971E-01, 0.4848728E-01, 0.4837511E-01, 0.4826320E-01, + 0.4815155E-01, 0.4804016E-01, 0.4792903E-01, 0.4781815E-01, + 0.4770753E-01, 0.4759717E-01, 0.4748706E-01, 0.4737721E-01, + 0.4726761E-01, 0.4715826E-01, 0.4704917E-01, 0.4694032E-01, + 0.4683173E-01, 0.4672340E-01, 0.4661531E-01, 0.4650747E-01, + 0.4639988E-01, 0.4629254E-01, 0.4618545E-01, 0.4607861E-01, + 0.4597201E-01, 0.4586566E-01, 0.4575956E-01, 0.4565370E-01, + 0.4554809E-01, 0.4544272E-01, 0.4533760E-01, 0.4523271E-01, + 0.4512807E-01, 0.4502368E-01, 0.4491952E-01, 0.4481561E-01, + 0.4471193E-01, 0.4460850E-01, 0.4450530E-01, 0.4440234E-01, + 0.4429963E-01, 0.4419715E-01, 0.4409490E-01, 0.4399289E-01, + 0.4389112E-01, 0.4378959E-01, 0.4368829E-01, 0.4358722E-01, + 0.4348639E-01, 0.4338579E-01, 0.4328542E-01, 0.4318528E-01, + 0.4308538E-01, 0.4298571E-01, 0.4288627E-01, 0.4278706E-01, + 0.4268808E-01, 0.4258932E-01, 0.4249080E-01, 0.4239250E-01, + 0.4229443E-01, 0.4219659E-01, 0.4209897E-01, 0.4200158E-01, + 0.4190442E-01, 0.4180748E-01, 0.4171076E-01, 0.4161427E-01, + 0.4151800E-01, 0.4142195E-01, 0.4132613E-01, 0.4123053E-01, + 0.4113515E-01, 0.4103999E-01, 0.4094505E-01, 0.4085033E-01, + 0.4075582E-01, 0.4066154E-01, 0.4056748E-01, 0.4047363E-01, + 0.4038000E-01, 0.4028658E-01, 0.4019339E-01, 0.4010040E-01, + 0.4000764E-01, 0.3991508E-01, 0.3982275E-01, 0.3973062E-01, + 0.3963871E-01, 0.3954701E-01, 0.3945552E-01, 0.3936425E-01, + 0.3927319E-01, 0.3918233E-01, 0.3909169E-01, 0.3900126E-01, + 0.3891103E-01, 0.3882102E-01, 0.3873121E-01, 0.3864161E-01, + 0.3855222E-01, 0.3846303E-01, 0.3837405E-01, 0.3828528E-01, + 0.3819671E-01, 0.3810835E-01, 0.3802019E-01, 0.3793223E-01, + 0.3784448E-01, 0.3775693E-01, 0.3766959E-01, 0.3758244E-01, + 0.3749550E-01, 0.3740876E-01, 0.3732222E-01, 0.3723588E-01, + 0.3714974E-01, 0.3706380E-01, 0.3697806E-01, 0.3689251E-01, + 0.3680717E-01, 0.3672202E-01, 0.3663707E-01, 0.3655231E-01, + 0.3646775E-01, 0.3638339E-01, 0.3629922E-01, 0.3621525E-01, + 0.3613147E-01, 0.3604788E-01, 0.3596449E-01, 0.3588129E-01, + 0.3579828E-01, 0.3571547E-01, 0.3563284E-01, 0.3555041E-01, + 0.3546817E-01, 0.3538612E-01, 0.3530426E-01, 0.3522259E-01, + 0.3514110E-01, 0.3505981E-01, 0.3497870E-01, 0.3489778E-01, + 0.3481705E-01, 0.3473651E-01, 0.3465615E-01, 0.3457598E-01, + 0.3449599E-01, 0.3441619E-01, 0.3433657E-01, 0.3425714E-01, + 0.3417789E-01, 0.3409882E-01, 0.3401994E-01, 0.3394123E-01, + 0.3386272E-01, 0.3378438E-01, 0.3370622E-01, 0.3362825E-01, + 0.3355045E-01, 0.3347284E-01, 0.3339540E-01, 0.3331815E-01, + 0.3324107E-01, 0.3316417E-01, 0.3308745E-01, 0.3301090E-01, + 0.3293454E-01, 0.3285835E-01, 0.3278233E-01, 0.3270650E-01, + 0.3263083E-01, 0.3255535E-01, 0.3248003E-01, 0.3240489E-01, + 0.3232993E-01, 0.3225514E-01, 0.3218052E-01, 0.3210607E-01, + 0.3203180E-01, 0.3195770E-01, 0.3188377E-01, 0.3181001E-01, + 0.3173642E-01, 0.3166300E-01, 0.3158975E-01, 0.3151667E-01, + 0.3144376E-01, 0.3137102E-01, 0.3129845E-01, 0.3122605E-01, + 0.3115381E-01, 0.3108174E-01, 0.3100983E-01, 0.3093810E-01, + 0.3086652E-01, 0.3079512E-01, 0.3072388E-01, 0.3065280E-01, + 0.3058189E-01, 0.3051114E-01, 0.3044056E-01, 0.3037014E-01, + 0.3029988E-01, 0.3022978E-01, 0.3015985E-01, 0.3009008E-01, + 0.3002047E-01, 0.2995102E-01, 0.2988173E-01, 0.2981261E-01, + 0.2974364E-01, 0.2967483E-01, 0.2960618E-01, 0.2953769E-01, + 0.2946936E-01, 0.2940118E-01, 0.2933317E-01, 0.2926531E-01, + 0.2919761E-01, 0.2913006E-01, 0.2906267E-01, 0.2899544E-01, + 0.2892836E-01, 0.2886144E-01, 0.2879467E-01, 0.2872806E-01, + 0.2866160E-01, 0.2859529E-01, 0.2852914E-01, 0.2846314E-01, + 0.2839730E-01, 0.2833160E-01, 0.2826606E-01, 0.2820067E-01, + 0.2813543E-01, 0.2807034E-01, 0.2800541E-01, 0.2794062E-01, + 0.2787598E-01, 0.2781149E-01, 0.2774716E-01, 0.2768297E-01, + 0.2761892E-01, 0.2755503E-01, 0.2749129E-01, 0.2742769E-01/ c ------------------------------------------------------------------- c d-state radial wave function: r=0 to 15 fm, steps of 0.01 fm data uavd/0.0d0, + 0.5404087E-06, 0.4249015E-05, 0.1410349E-04, 0.3290019E-04, + 0.6328127E-04, 0.1077597E-03, 0.1687417E-03, 0.2485474E-03, + 0.3494285E-03, 0.4735840E-03, 0.6231737E-03, 0.8003291E-03, + 0.1007162E-02, 0.1245774E-02, 0.1518254E-02, 0.1826691E-02, + 0.2173166E-02, 0.2559756E-02, 0.2988529E-02, 0.3461540E-02, + 0.3980826E-02, 0.4548396E-02, 0.5166226E-02, 0.5836246E-02, + 0.6560331E-02, 0.7340290E-02, 0.8177850E-02, 0.9074650E-02, + 0.1003222E-01, 0.1105198E-01, 0.1213520E-01, 0.1328303E-01, + 0.1449645E-01, 0.1577626E-01, 0.1712311E-01, 0.1853744E-01, + 0.2001948E-01, 0.2156928E-01, 0.2318665E-01, 0.2487119E-01, + 0.2662228E-01, 0.2843906E-01, 0.3032046E-01, 0.3226518E-01, + 0.3427167E-01, 0.3633819E-01, 0.3846279E-01, 0.4064327E-01, + 0.4287728E-01, 0.4516226E-01, 0.4749548E-01, 0.4987402E-01, + 0.5229486E-01, 0.5475479E-01, 0.5725052E-01, 0.5977863E-01, + 0.6233563E-01, 0.6491795E-01, 0.6752197E-01, 0.7014403E-01, + 0.7278045E-01, 0.7542753E-01, 0.7808161E-01, 0.8073905E-01, + 0.8339623E-01, 0.8604960E-01, 0.8869570E-01, 0.9133112E-01, + 0.9395255E-01, 0.9655680E-01, 0.9914078E-01, 0.1017015E+00, + 0.1042362E+00, 0.1067420E+00, 0.1092165E+00, 0.1116573E+00, + 0.1140620E+00, 0.1164284E+00, 0.1187548E+00, 0.1210391E+00, + 0.1232798E+00, 0.1254753E+00, 0.1276242E+00, 0.1297253E+00, + 0.1317774E+00, 0.1337797E+00, 0.1357313E+00, 0.1376314E+00, + 0.1394796E+00, 0.1412754E+00, 0.1430184E+00, 0.1447084E+00, + 0.1463452E+00, 0.1479289E+00, 0.1494595E+00, 0.1509372E+00, + 0.1523621E+00, 0.1537347E+00, 0.1550552E+00, 0.1563242E+00, + 0.1575420E+00, 0.1587094E+00, 0.1598268E+00, 0.1608950E+00, + 0.1619146E+00, 0.1628864E+00, 0.1638111E+00, 0.1646896E+00, + 0.1655226E+00, 0.1663110E+00, 0.1670556E+00, 0.1677574E+00, + 0.1684172E+00, 0.1690358E+00, 0.1696143E+00, 0.1701536E+00, + 0.1706544E+00, 0.1711178E+00, 0.1715447E+00, 0.1719359E+00, + 0.1722924E+00, 0.1726150E+00, 0.1729047E+00, 0.1731623E+00, + 0.1733887E+00, 0.1735848E+00, 0.1737514E+00, 0.1738894E+00, + 0.1739995E+00, 0.1740827E+00, 0.1741396E+00, 0.1741711E+00, + 0.1741779E+00, 0.1741609E+00, 0.1741207E+00, 0.1740580E+00, + 0.1739736E+00, 0.1738682E+00, 0.1737424E+00, 0.1735970E+00, + 0.1734325E+00, 0.1732496E+00, 0.1730489E+00, 0.1728310E+00, + 0.1725965E+00, 0.1723459E+00, 0.1720799E+00, 0.1717990E+00, + 0.1715036E+00, 0.1711944E+00, 0.1708718E+00, 0.1705363E+00, + 0.1701883E+00, 0.1698284E+00, 0.1694569E+00, 0.1690744E+00, + 0.1686812E+00, 0.1682778E+00, 0.1678645E+00, 0.1674417E+00, + 0.1670098E+00, 0.1665692E+00, 0.1661203E+00, 0.1656633E+00, + 0.1651986E+00, 0.1647266E+00, 0.1642475E+00, 0.1637616E+00, + 0.1632693E+00, 0.1627708E+00, 0.1622664E+00, 0.1617564E+00, + 0.1612410E+00, 0.1607205E+00, 0.1601952E+00, 0.1596652E+00, + 0.1591308E+00, 0.1585923E+00, 0.1580497E+00, 0.1575035E+00, + 0.1569536E+00, 0.1564005E+00, 0.1558441E+00, 0.1552848E+00, + 0.1547227E+00, 0.1541580E+00, 0.1535908E+00, 0.1530213E+00, + 0.1524497E+00, 0.1518760E+00, 0.1513006E+00, 0.1507234E+00, + 0.1501447E+00, 0.1495645E+00, 0.1489830E+00, 0.1484004E+00, + 0.1478167E+00, 0.1472321E+00, 0.1466466E+00, 0.1460605E+00, + 0.1454737E+00, 0.1448864E+00, 0.1442987E+00, 0.1437107E+00, + 0.1431225E+00, 0.1425341E+00, 0.1419457E+00, 0.1413574E+00, + 0.1407691E+00, 0.1401811E+00, 0.1395933E+00, 0.1390059E+00, + 0.1384189E+00, 0.1378324E+00, 0.1372465E+00, 0.1366611E+00, + 0.1360765E+00, 0.1354926E+00, 0.1349095E+00, 0.1343272E+00, + 0.1337459E+00, 0.1331655E+00, 0.1325861E+00, 0.1320078E+00, + 0.1314305E+00, 0.1308544E+00, 0.1302796E+00, 0.1297059E+00, + 0.1291335E+00, 0.1285624E+00, 0.1279927E+00, 0.1274244E+00, + 0.1268574E+00, 0.1262920E+00, 0.1257280E+00, 0.1251655E+00, + 0.1246046E+00, 0.1240452E+00, 0.1234875E+00, 0.1229314E+00, + 0.1223769E+00, 0.1218241E+00, 0.1212730E+00, 0.1207236E+00, + 0.1201760E+00, 0.1196301E+00, 0.1190860E+00, 0.1185438E+00, + 0.1180033E+00, 0.1174647E+00, 0.1169279E+00, 0.1163930E+00, + 0.1158600E+00, 0.1153288E+00, 0.1147996E+00, 0.1142723E+00, + 0.1137470E+00, 0.1132236E+00, 0.1127021E+00, 0.1121826E+00, + 0.1116651E+00, 0.1111496E+00, 0.1106361E+00, 0.1101246E+00, + 0.1096151E+00, 0.1091076E+00, 0.1086021E+00, 0.1080987E+00, + 0.1075973E+00, 0.1070979E+00, 0.1066006E+00, 0.1061053E+00, + 0.1056121E+00, 0.1051209E+00, 0.1046318E+00, 0.1041448E+00, + 0.1036598E+00, 0.1031769E+00, 0.1026961E+00, 0.1022173E+00, + 0.1017406E+00, 0.1012660E+00, 0.1007935E+00, 0.1003230E+00, + 0.9985458E-01, 0.9938824E-01, 0.9892397E-01, 0.9846177E-01, + 0.9800164E-01, 0.9754358E-01, 0.9708758E-01, 0.9663365E-01, + 0.9618177E-01, 0.9573196E-01, 0.9528420E-01, 0.9483849E-01, + 0.9439483E-01, 0.9395322E-01, 0.9351365E-01, 0.9307613E-01, + 0.9264064E-01, 0.9220718E-01, 0.9177575E-01, 0.9134634E-01, + 0.9091895E-01, 0.9049358E-01, 0.9007022E-01, 0.8964887E-01, + 0.8922951E-01, 0.8881215E-01, 0.8839679E-01, 0.8798341E-01, + 0.8757201E-01, 0.8716258E-01, 0.8675512E-01, 0.8634963E-01, + 0.8594609E-01, 0.8554451E-01, 0.8514487E-01, 0.8474717E-01, + 0.8435141E-01, 0.8395757E-01, 0.8356566E-01, 0.8317566E-01, + 0.8278757E-01, 0.8240138E-01, 0.8201708E-01, 0.8163468E-01, + 0.8125415E-01, 0.8087551E-01, 0.8049873E-01, 0.8012381E-01, + 0.7975075E-01, 0.7937953E-01, 0.7901016E-01, 0.7864262E-01, + 0.7827691E-01, 0.7791302E-01, 0.7755094E-01, 0.7719066E-01, + 0.7683219E-01, 0.7647550E-01, 0.7612060E-01, 0.7576747E-01, + 0.7541612E-01, 0.7506652E-01, 0.7471868E-01, 0.7437259E-01, + 0.7402824E-01, 0.7368562E-01, 0.7334472E-01, 0.7300554E-01, + 0.7266807E-01, 0.7233231E-01, 0.7199824E-01, 0.7166585E-01, + 0.7133515E-01, 0.7100612E-01, 0.7067875E-01, 0.7035304E-01, + 0.7002898E-01, 0.6970656E-01, 0.6938578E-01, 0.6906662E-01, + 0.6874909E-01, 0.6843316E-01, 0.6811884E-01, 0.6780612E-01, + 0.6749499E-01, 0.6718544E-01, 0.6687746E-01, 0.6657106E-01, + 0.6626621E-01, 0.6596291E-01, 0.6566116E-01, 0.6536095E-01, + 0.6506226E-01, 0.6476510E-01, 0.6446945E-01, 0.6417532E-01, + 0.6388268E-01, 0.6359153E-01, 0.6330187E-01, 0.6301369E-01, + 0.6272698E-01, 0.6244173E-01, 0.6215794E-01, 0.6187560E-01, + 0.6159470E-01, 0.6131523E-01, 0.6103720E-01, 0.6076058E-01, + 0.6048537E-01, 0.6021157E-01, 0.5993917E-01, 0.5966816E-01, + 0.5939854E-01, 0.5913029E-01, 0.5886341E-01, 0.5859790E-01, + 0.5833374E-01, 0.5807094E-01, 0.5780947E-01, 0.5754934E-01, + 0.5729054E-01, 0.5703306E-01, 0.5677689E-01, 0.5652203E-01, + 0.5626848E-01, 0.5601622E-01, 0.5576524E-01, 0.5551555E-01, + 0.5526713E-01, 0.5501998E-01, 0.5477408E-01, 0.5452945E-01, + 0.5428606E-01, 0.5404391E-01, 0.5380299E-01, 0.5356331E-01, + 0.5332484E-01, 0.5308759E-01, 0.5285155E-01, 0.5261671E-01, + 0.5238306E-01, 0.5215060E-01, 0.5191933E-01, 0.5168924E-01, + 0.5146031E-01, 0.5123255E-01, 0.5100594E-01, 0.5078049E-01, + 0.5055618E-01, 0.5033301E-01, 0.5011098E-01, 0.4989007E-01, + 0.4967028E-01, 0.4945161E-01, 0.4923405E-01, 0.4901759E-01, + 0.4880222E-01, 0.4858795E-01, 0.4837476E-01, 0.4816266E-01, + 0.4795162E-01, 0.4774166E-01, 0.4753275E-01, 0.4732490E-01, + 0.4711810E-01, 0.4691235E-01, 0.4670763E-01, 0.4650395E-01, + 0.4630130E-01, 0.4609967E-01, 0.4589905E-01, 0.4569945E-01, + 0.4550085E-01, 0.4530325E-01, 0.4510664E-01, 0.4491103E-01, + 0.4471640E-01, 0.4452274E-01, 0.4433007E-01, 0.4413835E-01, + 0.4394760E-01, 0.4375781E-01, 0.4356897E-01, 0.4338108E-01, + 0.4319412E-01, 0.4300811E-01, 0.4282302E-01, 0.4263887E-01, + 0.4245563E-01, 0.4227331E-01, 0.4209190E-01, 0.4191139E-01, + 0.4173179E-01, 0.4155308E-01, 0.4137527E-01, 0.4119834E-01, + 0.4102229E-01, 0.4084712E-01, 0.4067282E-01, 0.4049939E-01, + 0.4032682E-01, 0.4015511E-01, 0.3998425E-01, 0.3981424E-01, + 0.3964507E-01, 0.3947674E-01, 0.3930925E-01, 0.3914258E-01, + 0.3897674E-01, 0.3881172E-01, 0.3864752E-01, 0.3848413E-01, + 0.3832154E-01, 0.3815976E-01, 0.3799878E-01, 0.3783859E-01, + 0.3767919E-01, 0.3752058E-01, 0.3736275E-01, 0.3720569E-01, + 0.3704941E-01, 0.3689389E-01, 0.3673914E-01, 0.3658515E-01, + 0.3643191E-01, 0.3627943E-01, 0.3612769E-01, 0.3597669E-01, + 0.3582644E-01, 0.3567692E-01, 0.3552813E-01, 0.3538007E-01, + 0.3523273E-01, 0.3508611E-01, 0.3494021E-01, 0.3479501E-01, + 0.3465053E-01, 0.3450674E-01, 0.3436366E-01, 0.3422128E-01, + 0.3407958E-01, 0.3393857E-01, 0.3379825E-01, 0.3365861E-01, + 0.3351965E-01, 0.3338136E-01, 0.3324374E-01, 0.3310678E-01, + 0.3297049E-01, 0.3283485E-01, 0.3269987E-01, 0.3256555E-01, + 0.3243187E-01, 0.3229883E-01, 0.3216644E-01, 0.3203468E-01, + 0.3190356E-01, 0.3177307E-01, 0.3164320E-01, 0.3151396E-01, + 0.3138534E-01, 0.3125733E-01, 0.3112994E-01, 0.3100316E-01, + 0.3087699E-01, 0.3075142E-01, 0.3062645E-01, 0.3050208E-01, + 0.3037830E-01, 0.3025511E-01, 0.3013251E-01, 0.3001049E-01, + 0.2988905E-01, 0.2976820E-01, 0.2964791E-01, 0.2952820E-01, + 0.2940906E-01, 0.2929048E-01, 0.2917247E-01, 0.2905501E-01, + 0.2893811E-01, 0.2882176E-01, 0.2870597E-01, 0.2859072E-01, + 0.2847602E-01, 0.2836185E-01, 0.2824823E-01, 0.2813514E-01, + 0.2802258E-01, 0.2791056E-01, 0.2779906E-01, 0.2768809E-01, + 0.2757763E-01, 0.2746770E-01, 0.2735828E-01, 0.2724937E-01, + 0.2714098E-01, 0.2703309E-01, 0.2692571E-01, 0.2681882E-01, + 0.2671244E-01, 0.2660656E-01, 0.2650117E-01, 0.2639627E-01, + 0.2629186E-01, 0.2618793E-01, 0.2608449E-01, 0.2598153E-01, + 0.2587905E-01, 0.2577704E-01, 0.2567551E-01, 0.2557445E-01, + 0.2547386E-01, 0.2537373E-01, 0.2527407E-01, 0.2517486E-01, + 0.2507612E-01, 0.2497783E-01, 0.2487999E-01, 0.2478261E-01, + 0.2468567E-01, 0.2458919E-01, 0.2449314E-01, 0.2439754E-01, + 0.2430237E-01, 0.2420765E-01, 0.2411335E-01, 0.2401949E-01, + 0.2392606E-01, 0.2383306E-01, 0.2374048E-01, 0.2364833E-01, + 0.2355660E-01, 0.2346528E-01, 0.2337439E-01, 0.2328391E-01, + 0.2319384E-01, 0.2310417E-01, 0.2301492E-01, 0.2292608E-01, + 0.2283763E-01, 0.2274959E-01, 0.2266195E-01, 0.2257471E-01, + 0.2248786E-01, 0.2240140E-01, 0.2231534E-01, 0.2222966E-01, + 0.2214437E-01, 0.2205947E-01, 0.2197495E-01, 0.2189081E-01, + 0.2180705E-01, 0.2172366E-01, 0.2164065E-01, 0.2155802E-01, + 0.2147575E-01, 0.2139386E-01, 0.2131233E-01, 0.2123117E-01, + 0.2115037E-01, 0.2106993E-01, 0.2098985E-01, 0.2091013E-01, + 0.2083077E-01, 0.2075176E-01, 0.2067310E-01, 0.2059480E-01, + 0.2051684E-01, 0.2043923E-01, 0.2036196E-01, 0.2028504E-01, + 0.2020846E-01, 0.2013222E-01, 0.2005631E-01, 0.1998075E-01, + 0.1990552E-01, 0.1983062E-01, 0.1975605E-01, 0.1968181E-01, + 0.1960790E-01, 0.1953431E-01, 0.1946105E-01, 0.1938811E-01, + 0.1931550E-01, 0.1924320E-01, 0.1917122E-01, 0.1909956E-01, + 0.1902821E-01, 0.1895717E-01, 0.1888645E-01, 0.1881604E-01, + 0.1874593E-01, 0.1867613E-01, 0.1860664E-01, 0.1853744E-01, + 0.1846856E-01, 0.1839997E-01, 0.1833168E-01, 0.1826369E-01, + 0.1819599E-01, 0.1812859E-01, 0.1806148E-01, 0.1799466E-01, + 0.1792813E-01, 0.1786189E-01, 0.1779594E-01, 0.1773028E-01, + 0.1766489E-01, 0.1759979E-01, 0.1753497E-01, 0.1747044E-01, + 0.1740618E-01, 0.1734219E-01, 0.1727849E-01, 0.1721505E-01, + 0.1715189E-01, 0.1708900E-01, 0.1702639E-01, 0.1696404E-01, + 0.1690195E-01, 0.1684014E-01, 0.1677859E-01, 0.1671730E-01, + 0.1665627E-01, 0.1659551E-01, 0.1653500E-01, 0.1647476E-01, + 0.1641477E-01, 0.1635503E-01, 0.1629555E-01, 0.1623633E-01, + 0.1617735E-01, 0.1611863E-01, 0.1606016E-01, 0.1600193E-01, + 0.1594395E-01, 0.1588622E-01, 0.1582873E-01, 0.1577148E-01, + 0.1571448E-01, 0.1565772E-01, 0.1560119E-01, 0.1554491E-01, + 0.1548886E-01, 0.1543305E-01, 0.1537747E-01, 0.1532213E-01, + 0.1526702E-01, 0.1521215E-01, 0.1515750E-01, 0.1510308E-01, + 0.1504889E-01, 0.1499493E-01, 0.1494119E-01, 0.1488768E-01, + 0.1483439E-01, 0.1478133E-01, 0.1472848E-01, 0.1467586E-01, + 0.1462346E-01, 0.1457127E-01, 0.1451930E-01, 0.1446755E-01, + 0.1441602E-01, 0.1436469E-01, 0.1431358E-01, 0.1426269E-01, + 0.1421200E-01, 0.1416152E-01, 0.1411126E-01, 0.1406120E-01, + 0.1401134E-01, 0.1396170E-01, 0.1391226E-01, 0.1386302E-01, + 0.1381399E-01, 0.1376515E-01, 0.1371652E-01, 0.1366809E-01, + 0.1361986E-01, 0.1357183E-01, 0.1352399E-01, 0.1347635E-01, + 0.1342890E-01, 0.1338165E-01, 0.1333460E-01, 0.1328773E-01, + 0.1324106E-01, 0.1319458E-01, 0.1314829E-01, 0.1310218E-01, + 0.1305627E-01, 0.1301054E-01, 0.1296500E-01, 0.1291964E-01, + 0.1287447E-01, 0.1282948E-01, 0.1278467E-01, 0.1274005E-01, + 0.1269561E-01, 0.1265134E-01, 0.1260726E-01, 0.1256335E-01, + 0.1251963E-01, 0.1247607E-01, 0.1243270E-01, 0.1238950E-01, + 0.1234647E-01, 0.1230362E-01, 0.1226094E-01, 0.1221843E-01, + 0.1217610E-01, 0.1213393E-01, 0.1209193E-01, 0.1205010E-01, + 0.1200844E-01, 0.1196695E-01, 0.1192562E-01, 0.1188446E-01, + 0.1184346E-01, 0.1180262E-01, 0.1176195E-01, 0.1172144E-01, + 0.1168110E-01, 0.1164091E-01, 0.1160089E-01, 0.1156102E-01, + 0.1152131E-01, 0.1148176E-01, 0.1144237E-01, 0.1140313E-01, + 0.1136405E-01, 0.1132513E-01, 0.1128635E-01, 0.1124774E-01, + 0.1120927E-01, 0.1117096E-01, 0.1113280E-01, 0.1109479E-01, + 0.1105692E-01, 0.1101921E-01, 0.1098165E-01, 0.1094424E-01, + 0.1090697E-01, 0.1086985E-01, 0.1083287E-01, 0.1079604E-01, + 0.1075936E-01, 0.1072282E-01, 0.1068642E-01, 0.1065016E-01, + 0.1061405E-01, 0.1057808E-01, 0.1054225E-01, 0.1050655E-01, + 0.1047100E-01, 0.1043559E-01, 0.1040031E-01, 0.1036518E-01, + 0.1033018E-01, 0.1029531E-01, 0.1026058E-01, 0.1022599E-01, + 0.1019153E-01, 0.1015720E-01, 0.1012301E-01, 0.1008895E-01, + 0.1005502E-01, 0.1002123E-01, 0.9987562E-02, 0.9954027E-02, + 0.9920621E-02, 0.9887344E-02, 0.9854196E-02, 0.9821175E-02, + 0.9788282E-02, 0.9755516E-02, 0.9722875E-02, 0.9690361E-02, + 0.9657971E-02, 0.9625706E-02, 0.9593564E-02, 0.9561546E-02, + 0.9529651E-02, 0.9497878E-02, 0.9466227E-02, 0.9434697E-02, + 0.9403288E-02, 0.9371998E-02, 0.9340829E-02, 0.9309778E-02, + 0.9278846E-02, 0.9248031E-02, 0.9217334E-02, 0.9186754E-02, + 0.9156291E-02, 0.9125943E-02, 0.9095711E-02, 0.9065593E-02, + 0.9035590E-02, 0.9005701E-02, 0.8975925E-02, 0.8946262E-02, + 0.8916711E-02, 0.8887272E-02, 0.8857945E-02, 0.8828728E-02, + 0.8799622E-02, 0.8770625E-02, 0.8741738E-02, 0.8712960E-02, + 0.8684290E-02, 0.8655729E-02, 0.8627275E-02, 0.8598927E-02, + 0.8570687E-02, 0.8542552E-02, 0.8514523E-02, 0.8486600E-02, + 0.8458781E-02, 0.8431066E-02, 0.8403455E-02, 0.8375947E-02, + 0.8348543E-02, 0.8321240E-02, 0.8294040E-02, 0.8266941E-02, + 0.8239944E-02, 0.8213047E-02, 0.8186250E-02, 0.8159553E-02, + 0.8132956E-02, 0.8106457E-02, 0.8080057E-02, 0.8053755E-02, + 0.8027551E-02, 0.8001444E-02, 0.7975434E-02, 0.7949520E-02, + 0.7923702E-02, 0.7897980E-02, 0.7872353E-02, 0.7846821E-02, + 0.7821383E-02, 0.7796039E-02, 0.7770789E-02, 0.7745632E-02, + 0.7720567E-02, 0.7695595E-02, 0.7670715E-02, 0.7645926E-02, + 0.7621229E-02, 0.7596622E-02, 0.7572106E-02, 0.7547680E-02, + 0.7523343E-02, 0.7499096E-02, 0.7474938E-02, 0.7450868E-02, + 0.7426886E-02, 0.7402992E-02, 0.7379185E-02, 0.7355465E-02, + 0.7331832E-02, 0.7308285E-02, 0.7284824E-02, 0.7261449E-02, + 0.7238159E-02, 0.7214953E-02, 0.7191832E-02, 0.7168795E-02, + 0.7145842E-02, 0.7122972E-02, 0.7100186E-02, 0.7077482E-02, + 0.7054860E-02, 0.7032320E-02, 0.7009862E-02, 0.6987486E-02, + 0.6965190E-02, 0.6942975E-02, 0.6920840E-02, 0.6898785E-02, + 0.6876810E-02, 0.6854914E-02, 0.6833097E-02, 0.6811359E-02, + 0.6789699E-02, 0.6768117E-02, 0.6746613E-02, 0.6725186E-02, + 0.6703835E-02, 0.6682562E-02, 0.6661365E-02, 0.6640244E-02, + 0.6619199E-02, 0.6598229E-02, 0.6577335E-02, 0.6556515E-02, + 0.6535769E-02, 0.6515098E-02, 0.6494501E-02, 0.6473977E-02, + 0.6453527E-02, 0.6433149E-02, 0.6412844E-02, 0.6392612E-02, + 0.6372452E-02, 0.6352363E-02, 0.6332346E-02, 0.6312400E-02, + 0.6292525E-02, 0.6272720E-02, 0.6252986E-02, 0.6233322E-02, + 0.6213728E-02, 0.6194203E-02, 0.6174747E-02, 0.6155360E-02, + 0.6136042E-02, 0.6116792E-02, 0.6097610E-02, 0.6078496E-02, + 0.6059449E-02, 0.6040470E-02, 0.6021558E-02, 0.6002712E-02, + 0.5983932E-02, 0.5965219E-02, 0.5946572E-02, 0.5927990E-02, + 0.5909473E-02, 0.5891022E-02, 0.5872635E-02, 0.5854313E-02, + 0.5836056E-02, 0.5817862E-02, 0.5799732E-02, 0.5781665E-02, + 0.5763662E-02, 0.5745722E-02, 0.5727844E-02, 0.5710029E-02, + 0.5692277E-02, 0.5674586E-02, 0.5656957E-02, 0.5639389E-02, + 0.5621883E-02, 0.5604438E-02, 0.5587053E-02, 0.5569729E-02, + 0.5552465E-02, 0.5535262E-02, 0.5518118E-02, 0.5501033E-02, + 0.5484008E-02, 0.5467042E-02, 0.5450135E-02, 0.5433286E-02, + 0.5416496E-02, 0.5399764E-02, 0.5383090E-02, 0.5366474E-02, + 0.5349914E-02, 0.5333413E-02, 0.5316968E-02, 0.5300580E-02, + 0.5284248E-02, 0.5267973E-02, 0.5251754E-02, 0.5235591E-02, + 0.5219484E-02, 0.5203431E-02, 0.5187435E-02, 0.5171493E-02, + 0.5155606E-02, 0.5139773E-02, 0.5123995E-02, 0.5108271E-02, + 0.5092601E-02, 0.5076984E-02, 0.5061422E-02, 0.5045912E-02, + 0.5030455E-02, 0.5015052E-02, 0.4999701E-02, 0.4984402E-02, + 0.4969156E-02, 0.4953962E-02, 0.4938820E-02, 0.4923729E-02, + 0.4908690E-02, 0.4893702E-02, 0.4878765E-02, 0.4863879E-02, + 0.4849043E-02, 0.4834258E-02, 0.4819523E-02, 0.4804839E-02, + 0.4790204E-02, 0.4775619E-02, 0.4761083E-02, 0.4746597E-02, + 0.4732159E-02, 0.4717771E-02, 0.4703431E-02, 0.4689140E-02, + 0.4674898E-02, 0.4660703E-02, 0.4646556E-02, 0.4632457E-02, + 0.4618406E-02, 0.4604402E-02, 0.4590446E-02, 0.4576536E-02, + 0.4562673E-02, 0.4548857E-02, 0.4535088E-02, 0.4521365E-02, + 0.4507688E-02, 0.4494057E-02, 0.4480472E-02, 0.4466932E-02, + 0.4453438E-02, 0.4439989E-02, 0.4426585E-02, 0.4413226E-02, + 0.4399912E-02, 0.4386643E-02, 0.4373418E-02, 0.4360237E-02, + 0.4347100E-02, 0.4334008E-02, 0.4320959E-02, 0.4307953E-02, + 0.4294991E-02, 0.4282072E-02, 0.4269197E-02, 0.4256364E-02, + 0.4243574E-02, 0.4230826E-02, 0.4218121E-02, 0.4205459E-02, + 0.4192838E-02, 0.4180259E-02, 0.4167723E-02, 0.4155227E-02, + 0.4142774E-02, 0.4130361E-02, 0.4117990E-02, 0.4105660E-02, + 0.4093370E-02, 0.4081122E-02, 0.4068914E-02, 0.4056746E-02, + 0.4044619E-02, 0.4032531E-02, 0.4020484E-02, 0.4008476E-02, + 0.3996508E-02, 0.3984580E-02, 0.3972691E-02, 0.3960841E-02, + 0.3949030E-02, 0.3937258E-02, 0.3925525E-02, 0.3913831E-02, + 0.3902175E-02, 0.3890557E-02, 0.3878977E-02, 0.3867436E-02, + 0.3855932E-02, 0.3844467E-02, 0.3833038E-02, 0.3821648E-02, + 0.3810294E-02, 0.3798978E-02, 0.3787699E-02, 0.3776457E-02, + 0.3765252E-02, 0.3754083E-02, 0.3742951E-02, 0.3731855E-02, + 0.3720796E-02, 0.3709773E-02, 0.3698785E-02, 0.3687834E-02, + 0.3676918E-02, 0.3666038E-02, 0.3655193E-02, 0.3644384E-02, + 0.3633609E-02, 0.3622870E-02, 0.3612166E-02, 0.3601497E-02, + 0.3590862E-02, 0.3580262E-02, 0.3569696E-02, 0.3559165E-02, + 0.3548667E-02, 0.3538204E-02, 0.3527775E-02, 0.3517379E-02, + 0.3507018E-02, 0.3496689E-02, 0.3486395E-02, 0.3476133E-02, + 0.3465905E-02, 0.3455710E-02, 0.3445547E-02, 0.3435418E-02, + 0.3425321E-02, 0.3415257E-02, 0.3405225E-02, 0.3395226E-02, + 0.3385259E-02, 0.3375324E-02, 0.3365421E-02, 0.3355550E-02, + 0.3345711E-02, 0.3335903E-02, 0.3326127E-02, 0.3316382E-02, + 0.3306669E-02, 0.3296987E-02, 0.3287335E-02, 0.3277715E-02, + 0.3268126E-02, 0.3258568E-02, 0.3249040E-02, 0.3239542E-02, + 0.3230075E-02, 0.3220639E-02, 0.3211232E-02, 0.3201856E-02, + 0.3192510E-02, 0.3183193E-02, 0.3173907E-02, 0.3164650E-02, + 0.3155422E-02, 0.3146224E-02, 0.3137055E-02, 0.3127916E-02, + 0.3118806E-02, 0.3109724E-02, 0.3100672E-02, 0.3091648E-02, + 0.3082654E-02, 0.3073687E-02, 0.3064750E-02, 0.3055840E-02, + 0.3046960E-02, 0.3038107E-02, 0.3029282E-02, 0.3020485E-02, + 0.3011717E-02, 0.3002976E-02, 0.2994263E-02, 0.2985577E-02, + 0.2976919E-02, 0.2968288E-02, 0.2959685E-02, 0.2951109E-02, + 0.2942560E-02, 0.2934038E-02, 0.2925543E-02, 0.2917075E-02, + 0.2908633E-02, 0.2900218E-02, 0.2891830E-02, 0.2883468E-02, + 0.2875133E-02, 0.2866824E-02, 0.2858541E-02, 0.2850284E-02, + 0.2842053E-02, 0.2833848E-02, 0.2825669E-02, 0.2817515E-02, + 0.2809387E-02, 0.2801285E-02, 0.2793208E-02, 0.2785157E-02, + 0.2777131E-02, 0.2769130E-02, 0.2761154E-02, 0.2753203E-02, + 0.2745277E-02, 0.2737376E-02, 0.2729500E-02, 0.2721648E-02, + 0.2713821E-02, 0.2706018E-02, 0.2698240E-02, 0.2690486E-02, + 0.2682756E-02, 0.2675051E-02, 0.2667369E-02, 0.2659712E-02, + 0.2652078E-02, 0.2644469E-02, 0.2636883E-02, 0.2629320E-02, + 0.2621781E-02, 0.2614266E-02, 0.2606774E-02, 0.2599305E-02, + 0.2591860E-02, 0.2584438E-02, 0.2577039E-02, 0.2569663E-02, + 0.2562309E-02, 0.2554979E-02, 0.2547672E-02, 0.2540387E-02, + 0.2533124E-02, 0.2525885E-02, 0.2518667E-02, 0.2511472E-02, + 0.2504300E-02, 0.2497149E-02, 0.2490021E-02, 0.2482915E-02, + 0.2475831E-02, 0.2468768E-02, 0.2461728E-02, 0.2454709E-02, + 0.2447712E-02, 0.2440737E-02, 0.2433783E-02, 0.2426850E-02, + 0.2419939E-02, 0.2413050E-02, 0.2406181E-02, 0.2399334E-02, + 0.2392508E-02, 0.2385703E-02, 0.2378919E-02, 0.2372155E-02, + 0.2365413E-02, 0.2358691E-02, 0.2351990E-02, 0.2345310E-02, + 0.2338650E-02, 0.2332010E-02, 0.2325391E-02, 0.2318792E-02, + 0.2312214E-02, 0.2305656E-02, 0.2299117E-02, 0.2292599E-02, + 0.2286101E-02, 0.2279623E-02, 0.2273164E-02, 0.2266726E-02, + 0.2260307E-02, 0.2253908E-02, 0.2247528E-02, 0.2241168E-02, + 0.2234827E-02, 0.2228506E-02, 0.2222203E-02, 0.2215921E-02, + 0.2209657E-02, 0.2203413E-02, 0.2197187E-02, 0.2190981E-02, + 0.2184793E-02, 0.2178624E-02, 0.2172474E-02, 0.2166343E-02, + 0.2160231E-02, 0.2154137E-02, 0.2148061E-02, 0.2142005E-02, + 0.2135966E-02, 0.2129946E-02, 0.2123944E-02, 0.2117961E-02, + 0.2111995E-02, 0.2106048E-02, 0.2100119E-02, 0.2094208E-02, + 0.2088314E-02, 0.2082439E-02, 0.2076581E-02, 0.2070741E-02, + 0.2064919E-02, 0.2059115E-02, 0.2053328E-02, 0.2047558E-02, + 0.2041806E-02, 0.2036072E-02, 0.2030354E-02, 0.2024654E-02, + 0.2018972E-02, 0.2013306E-02, 0.2007657E-02, 0.2002026E-02, + 0.1996412E-02, 0.1990814E-02, 0.1985233E-02, 0.1979670E-02, + 0.1974123E-02, 0.1968592E-02, 0.1963079E-02, 0.1957582E-02, + 0.1952101E-02, 0.1946637E-02, 0.1941190E-02, 0.1935758E-02, + 0.1930344E-02, 0.1924945E-02, 0.1919563E-02, 0.1914196E-02, + 0.1908846E-02, 0.1903512E-02, 0.1898194E-02, 0.1892892E-02, + 0.1887606E-02, 0.1882336E-02, 0.1877082E-02, 0.1871843E-02, + 0.1866620E-02, 0.1861412E-02, 0.1856221E-02, 0.1851044E-02, + 0.1845884E-02, 0.1840738E-02, 0.1835608E-02, 0.1830494E-02, + 0.1825394E-02, 0.1820310E-02, 0.1815241E-02, 0.1810188E-02, + 0.1805149E-02, 0.1800125E-02, 0.1795117E-02, 0.1790123E-02, + 0.1785144E-02, 0.1780180E-02, 0.1775231E-02, 0.1770297E-02, + 0.1765377E-02, 0.1760472E-02, 0.1755581E-02, 0.1750705E-02, + 0.1745844E-02, 0.1740997E-02, 0.1736164E-02, 0.1731346E-02, + 0.1726542E-02, 0.1721753E-02, 0.1716977E-02, 0.1712216E-02, + 0.1707469E-02, 0.1702736E-02, 0.1698017E-02, 0.1693312E-02, + 0.1688621E-02, 0.1683944E-02, 0.1679281E-02, 0.1674631E-02, + 0.1669996E-02, 0.1665374E-02, 0.1660765E-02, 0.1656171E-02, + 0.1651590E-02, 0.1647022E-02, 0.1642468E-02, 0.1637928E-02, + 0.1633401E-02, 0.1628887E-02, 0.1624387E-02, 0.1619900E-02, + 0.1615426E-02, 0.1610965E-02, 0.1606518E-02, 0.1602083E-02, + 0.1597662E-02, 0.1593254E-02, 0.1588858E-02, 0.1584476E-02, + 0.1580107E-02, 0.1575750E-02, 0.1571406E-02, 0.1567075E-02, + 0.1562757E-02, 0.1558452E-02, 0.1554159E-02, 0.1549879E-02, + 0.1545611E-02, 0.1541356E-02, 0.1537113E-02, 0.1532883E-02, + 0.1528665E-02, 0.1524460E-02, 0.1520267E-02, 0.1516086E-02, + 0.1511918E-02, 0.1507762E-02, 0.1503618E-02, 0.1499486E-02, + 0.1495366E-02, 0.1491258E-02, 0.1487162E-02, 0.1483079E-02, + 0.1479007E-02, 0.1474947E-02, 0.1470899E-02, 0.1466863E-02, + 0.1462839E-02, 0.1458826E-02, 0.1454825E-02, 0.1450836E-02/ c ------------------------------------------------------------ c derivative of s-state wave function data uasp/0.7937903E-01, + 0.7937903E-01, 0.8006949E-01, 0.8122170E-01, 0.8283769E-01, + 0.8492012E-01, 0.8747218E-01, 0.9049745E-01, 0.9399978E-01, + 0.9798318E-01, 0.1024517E+00, 0.1074091E+00, 0.1128592E+00, + 0.1188050E+00, 0.1252492E+00, 0.1321935E+00, 0.1396387E+00, + 0.1475846E+00, 0.1560296E+00, 0.1649706E+00, 0.1744030E+00, + 0.1843203E+00, 0.1947140E+00, 0.2055736E+00, 0.2168864E+00, + 0.2286373E+00, 0.2408088E+00, 0.2533809E+00, 0.2663312E+00, + 0.2796346E+00, 0.2932635E+00, 0.3071879E+00, 0.3213751E+00, + 0.3357902E+00, 0.3503961E+00, 0.3651535E+00, 0.3800212E+00, + 0.3949563E+00, 0.4099142E+00, 0.4248492E+00, 0.4397145E+00, + 0.4544627E+00, 0.4690457E+00, 0.4834156E+00, 0.4975242E+00, + 0.5113243E+00, 0.5247691E+00, 0.5378130E+00, 0.5504120E+00, + 0.5625236E+00, 0.5741074E+00, 0.5851253E+00, 0.5955415E+00, + 0.6053231E+00, 0.6144402E+00, 0.6228659E+00, 0.6305766E+00, + 0.6375519E+00, 0.6437751E+00, 0.6492330E+00, 0.6539157E+00, + 0.6578171E+00, 0.6609344E+00, 0.6632684E+00, 0.6648231E+00, + 0.6656059E+00, 0.6656271E+00, 0.6649001E+00, 0.6634410E+00, + 0.6612683E+00, 0.6584031E+00, 0.6548686E+00, 0.6506899E+00, + 0.6458935E+00, 0.6405079E+00, 0.6345624E+00, 0.6280874E+00, + 0.6211142E+00, 0.6136745E+00, 0.6058004E+00, 0.5975243E+00, + 0.5888782E+00, 0.5798943E+00, 0.5706041E+00, 0.5610387E+00, + 0.5512287E+00, 0.5412036E+00, 0.5309922E+00, 0.5206223E+00, + 0.5101206E+00, 0.4995128E+00, 0.4888233E+00, 0.4780752E+00, + 0.4672906E+00, 0.4564902E+00, 0.4456934E+00, 0.4349184E+00, + 0.4241820E+00, 0.4135001E+00, 0.4028870E+00, 0.3923560E+00, + 0.3819192E+00, 0.3715877E+00, 0.3613713E+00, 0.3512791E+00, + 0.3413188E+00, 0.3314975E+00, 0.3218214E+00, 0.3122956E+00, + 0.3029247E+00, 0.2937124E+00, 0.2846618E+00, 0.2757754E+00, + 0.2670550E+00, 0.2585018E+00, 0.2501168E+00, 0.2419002E+00, + 0.2338519E+00, 0.2259716E+00, 0.2182583E+00, 0.2107111E+00, + 0.2033284E+00, 0.1961088E+00, 0.1890503E+00, 0.1821509E+00, + 0.1754085E+00, 0.1688206E+00, 0.1623848E+00, 0.1560986E+00, + 0.1499593E+00, 0.1439641E+00, 0.1381104E+00, 0.1323953E+00, + 0.1268161E+00, 0.1213697E+00, 0.1160535E+00, 0.1108645E+00, + 0.1058000E+00, 0.1008571E+00, 0.9603301E-01, 0.9132500E-01, + 0.8673035E-01, 0.8224636E-01, 0.7787041E-01, 0.7359989E-01, + 0.6943226E-01, 0.6536502E-01, 0.6139572E-01, 0.5752197E-01, + 0.5374143E-01, 0.5005180E-01, 0.4645086E-01, 0.4293641E-01, + 0.3950634E-01, 0.3615856E-01, 0.3289106E-01, 0.2970186E-01, + 0.2658905E-01, 0.2355075E-01, 0.2058514E-01, 0.1769046E-01, + 0.1486498E-01, 0.1210703E-01, 0.9414958E-02, 0.6787192E-02, + 0.4222181E-02, 0.1718422E-02,-0.7255480E-03,-0.3111152E-02, +-0.5439776E-02,-0.7712768E-02,-0.9931439E-02,-0.1209707E-01, +-0.1421089E-01,-0.1627413E-01,-0.1828795E-01,-0.2025350E-01, +-0.2217191E-01,-0.2404425E-01,-0.2587159E-01,-0.2765496E-01, +-0.2939536E-01,-0.3109379E-01,-0.3275118E-01,-0.3436847E-01, +-0.3594658E-01,-0.3748638E-01,-0.3898874E-01,-0.4045451E-01, +-0.4188450E-01,-0.4327951E-01,-0.4464033E-01,-0.4596772E-01, +-0.4726243E-01,-0.4852518E-01,-0.4975668E-01,-0.5095763E-01, +-0.5212870E-01,-0.5327056E-01,-0.5438385E-01,-0.5546920E-01, +-0.5652722E-01,-0.5755853E-01,-0.5856370E-01,-0.5954331E-01, +-0.6049793E-01,-0.6142810E-01,-0.6233436E-01,-0.6321723E-01, +-0.6407723E-01,-0.6491485E-01,-0.6573059E-01,-0.6652493E-01, +-0.6729833E-01,-0.6805125E-01,-0.6878414E-01,-0.6949743E-01, +-0.7019156E-01,-0.7086694E-01,-0.7152398E-01,-0.7216308E-01, +-0.7278464E-01,-0.7338903E-01,-0.7397663E-01,-0.7454780E-01, +-0.7510291E-01,-0.7564231E-01,-0.7616633E-01,-0.7667531E-01, +-0.7716959E-01,-0.7764947E-01,-0.7811527E-01,-0.7856731E-01, +-0.7900587E-01,-0.7943126E-01,-0.7984376E-01,-0.8024365E-01, +-0.8063120E-01,-0.8100669E-01,-0.8137038E-01,-0.8172251E-01, +-0.8206336E-01,-0.8239315E-01,-0.8271214E-01,-0.8302055E-01, +-0.8331862E-01,-0.8360657E-01,-0.8388463E-01,-0.8415300E-01, +-0.8441190E-01,-0.8466153E-01,-0.8490210E-01,-0.8513381E-01, +-0.8535684E-01,-0.8557138E-01,-0.8577763E-01,-0.8597576E-01, +-0.8616594E-01,-0.8634835E-01,-0.8652316E-01,-0.8669054E-01, +-0.8685064E-01,-0.8700363E-01,-0.8714965E-01,-0.8728887E-01, +-0.8742143E-01,-0.8754747E-01,-0.8766713E-01,-0.8778056E-01, +-0.8788789E-01,-0.8798925E-01,-0.8808478E-01,-0.8817459E-01, +-0.8825882E-01,-0.8833759E-01,-0.8841101E-01,-0.8847920E-01, +-0.8854227E-01,-0.8860034E-01,-0.8865352E-01,-0.8870191E-01, +-0.8874562E-01,-0.8878474E-01,-0.8881939E-01,-0.8884965E-01, +-0.8887562E-01,-0.8889740E-01,-0.8891508E-01,-0.8892874E-01, +-0.8893847E-01,-0.8894437E-01,-0.8894651E-01,-0.8894498E-01, +-0.8893986E-01,-0.8893122E-01,-0.8891914E-01,-0.8890370E-01, +-0.8888498E-01,-0.8886303E-01,-0.8883795E-01,-0.8880978E-01, +-0.8877861E-01,-0.8874450E-01,-0.8870751E-01,-0.8866770E-01, +-0.8862515E-01,-0.8857990E-01,-0.8853202E-01,-0.8848157E-01, +-0.8842861E-01,-0.8837318E-01,-0.8831535E-01,-0.8825516E-01, +-0.8819268E-01,-0.8812795E-01,-0.8806102E-01,-0.8799194E-01, +-0.8792077E-01,-0.8784754E-01,-0.8777230E-01,-0.8769510E-01, +-0.8761598E-01,-0.8753499E-01,-0.8745217E-01,-0.8736756E-01, +-0.8728120E-01,-0.8719313E-01,-0.8710339E-01,-0.8701201E-01, +-0.8691905E-01,-0.8682452E-01,-0.8672847E-01,-0.8663094E-01, +-0.8653195E-01,-0.8643155E-01,-0.8632976E-01,-0.8622662E-01, +-0.8612215E-01,-0.8601640E-01,-0.8590939E-01,-0.8580115E-01, +-0.8569170E-01,-0.8558109E-01,-0.8546933E-01,-0.8535646E-01, +-0.8524250E-01,-0.8512747E-01,-0.8501141E-01,-0.8489434E-01, +-0.8477628E-01,-0.8465726E-01,-0.8453730E-01,-0.8441642E-01, +-0.8429466E-01,-0.8417202E-01,-0.8404854E-01,-0.8392423E-01, +-0.8379912E-01,-0.8367322E-01,-0.8354656E-01,-0.8341916E-01, +-0.8329103E-01,-0.8316220E-01,-0.8303268E-01,-0.8290250E-01, +-0.8277167E-01,-0.8264020E-01,-0.8250812E-01,-0.8237544E-01, +-0.8224218E-01,-0.8210836E-01,-0.8197399E-01,-0.8183908E-01, +-0.8170366E-01,-0.8156774E-01,-0.8143133E-01,-0.8129444E-01, +-0.8115710E-01,-0.8101931E-01,-0.8088109E-01,-0.8074246E-01, +-0.8060342E-01,-0.8046399E-01,-0.8032418E-01,-0.8018400E-01, +-0.8004347E-01,-0.7990260E-01,-0.7976139E-01,-0.7961987E-01, +-0.7947804E-01,-0.7933592E-01,-0.7919350E-01,-0.7905082E-01, +-0.7890786E-01,-0.7876466E-01,-0.7862121E-01,-0.7847752E-01, +-0.7833361E-01,-0.7818948E-01,-0.7804515E-01,-0.7790062E-01, +-0.7775590E-01,-0.7761101E-01,-0.7746594E-01,-0.7732071E-01, +-0.7717532E-01,-0.7702979E-01,-0.7688412E-01,-0.7673832E-01, +-0.7659240E-01,-0.7644636E-01,-0.7630022E-01,-0.7615397E-01, +-0.7600764E-01,-0.7586121E-01,-0.7571471E-01,-0.7556813E-01, +-0.7542148E-01,-0.7527478E-01,-0.7512802E-01,-0.7498122E-01, +-0.7483437E-01,-0.7468749E-01,-0.7454058E-01,-0.7439365E-01, +-0.7424669E-01,-0.7409973E-01,-0.7395276E-01,-0.7380578E-01, +-0.7365881E-01,-0.7351185E-01,-0.7336490E-01,-0.7321797E-01, +-0.7307106E-01,-0.7292418E-01,-0.7277734E-01,-0.7263053E-01, +-0.7248376E-01,-0.7233704E-01,-0.7219037E-01,-0.7204375E-01, +-0.7189719E-01,-0.7175070E-01,-0.7160427E-01,-0.7145791E-01, +-0.7131163E-01,-0.7116542E-01,-0.7101930E-01,-0.7087326E-01, +-0.7072731E-01,-0.7058145E-01,-0.7043569E-01,-0.7029003E-01, +-0.7014447E-01,-0.6999902E-01,-0.6985367E-01,-0.6970844E-01, +-0.6956332E-01,-0.6941832E-01,-0.6927345E-01,-0.6912869E-01, +-0.6898406E-01,-0.6883956E-01,-0.6869520E-01,-0.6855096E-01, +-0.6840687E-01,-0.6826291E-01,-0.6811910E-01,-0.6797543E-01, +-0.6783190E-01,-0.6768853E-01,-0.6754531E-01,-0.6740224E-01, +-0.6725932E-01,-0.6711657E-01,-0.6697397E-01,-0.6683154E-01, +-0.6668927E-01,-0.6654717E-01,-0.6640524E-01,-0.6626347E-01, +-0.6612188E-01,-0.6598046E-01,-0.6583922E-01,-0.6569815E-01, +-0.6555727E-01,-0.6541656E-01,-0.6527603E-01,-0.6513569E-01, +-0.6499554E-01,-0.6485557E-01,-0.6471579E-01,-0.6457620E-01, +-0.6443680E-01,-0.6429759E-01,-0.6415858E-01,-0.6401976E-01, +-0.6388114E-01,-0.6374272E-01,-0.6360449E-01,-0.6346647E-01, +-0.6332865E-01,-0.6319103E-01,-0.6305361E-01,-0.6291640E-01, +-0.6277939E-01,-0.6264260E-01,-0.6250601E-01,-0.6236963E-01, +-0.6223345E-01,-0.6209750E-01,-0.6196175E-01,-0.6182621E-01, +-0.6169089E-01,-0.6155578E-01,-0.6142089E-01,-0.6128622E-01, +-0.6115176E-01,-0.6101752E-01,-0.6088350E-01,-0.6074970E-01, +-0.6061612E-01,-0.6048276E-01,-0.6034962E-01,-0.6021670E-01, +-0.6008400E-01,-0.5995153E-01,-0.5981929E-01,-0.5968726E-01, +-0.5955546E-01,-0.5942389E-01,-0.5929255E-01,-0.5916143E-01, +-0.5903054E-01,-0.5889987E-01,-0.5876944E-01,-0.5863923E-01, +-0.5850925E-01,-0.5837951E-01,-0.5824999E-01,-0.5812070E-01, +-0.5799164E-01,-0.5786282E-01,-0.5773422E-01,-0.5760586E-01, +-0.5747773E-01,-0.5734983E-01,-0.5722217E-01,-0.5709474E-01, +-0.5696754E-01,-0.5684057E-01,-0.5671384E-01,-0.5658734E-01, +-0.5646108E-01,-0.5633505E-01,-0.5620926E-01,-0.5608370E-01, +-0.5595838E-01,-0.5583329E-01,-0.5570844E-01,-0.5558382E-01, +-0.5545944E-01,-0.5533530E-01,-0.5521139E-01,-0.5508772E-01, +-0.5496428E-01,-0.5484108E-01,-0.5471812E-01,-0.5459539E-01, +-0.5447290E-01,-0.5435065E-01,-0.5422864E-01,-0.5410686E-01, +-0.5398531E-01,-0.5386401E-01,-0.5374294E-01,-0.5362211E-01, +-0.5350151E-01,-0.5338116E-01,-0.5326103E-01,-0.5314115E-01, +-0.5302150E-01,-0.5290209E-01,-0.5278292E-01,-0.5266398E-01, +-0.5254528E-01,-0.5242682E-01,-0.5230859E-01,-0.5219060E-01, +-0.5207285E-01,-0.5195533E-01,-0.5183805E-01,-0.5172100E-01, +-0.5160420E-01,-0.5148762E-01,-0.5137129E-01,-0.5125518E-01, +-0.5113932E-01,-0.5102369E-01,-0.5090829E-01,-0.5079313E-01, +-0.5067821E-01,-0.5056352E-01,-0.5044906E-01,-0.5033484E-01, +-0.5022086E-01,-0.5010711E-01,-0.4999359E-01,-0.4988030E-01, +-0.4976725E-01,-0.4965444E-01,-0.4954186E-01,-0.4942951E-01, +-0.4931739E-01,-0.4920551E-01,-0.4909385E-01,-0.4898243E-01, +-0.4887125E-01,-0.4876029E-01,-0.4864957E-01,-0.4853908E-01, +-0.4842882E-01,-0.4831879E-01,-0.4820899E-01,-0.4809942E-01, +-0.4799008E-01,-0.4788097E-01,-0.4777210E-01,-0.4766345E-01, +-0.4755503E-01,-0.4744684E-01,-0.4733888E-01,-0.4723114E-01, +-0.4712364E-01,-0.4701636E-01,-0.4690931E-01,-0.4680249E-01, +-0.4669590E-01,-0.4658953E-01,-0.4648339E-01,-0.4637747E-01, +-0.4627178E-01,-0.4616632E-01,-0.4606108E-01,-0.4595607E-01, +-0.4585128E-01,-0.4574672E-01,-0.4564238E-01,-0.4553826E-01, +-0.4543437E-01,-0.4533071E-01,-0.4522726E-01,-0.4512404E-01, +-0.4502104E-01,-0.4491826E-01,-0.4481570E-01,-0.4471337E-01, +-0.4461126E-01,-0.4450936E-01,-0.4440769E-01,-0.4430624E-01, +-0.4420501E-01,-0.4410399E-01,-0.4400320E-01,-0.4390262E-01, +-0.4380227E-01,-0.4370213E-01,-0.4360221E-01,-0.4350251E-01, +-0.4340302E-01,-0.4330375E-01,-0.4320470E-01,-0.4310586E-01, +-0.4300724E-01,-0.4290884E-01,-0.4281064E-01,-0.4271267E-01, +-0.4261491E-01,-0.4251736E-01,-0.4242003E-01,-0.4232291E-01, +-0.4222600E-01,-0.4212931E-01,-0.4203282E-01,-0.4193655E-01, +-0.4184050E-01,-0.4174465E-01,-0.4164901E-01,-0.4155359E-01, +-0.4145837E-01,-0.4136336E-01,-0.4126857E-01,-0.4117398E-01, +-0.4107960E-01,-0.4098543E-01,-0.4089147E-01,-0.4079771E-01, +-0.4070417E-01,-0.4061082E-01,-0.4051769E-01,-0.4042476E-01, +-0.4033204E-01,-0.4023952E-01,-0.4014721E-01,-0.4005510E-01, +-0.3996320E-01,-0.3987150E-01,-0.3978001E-01,-0.3968871E-01, +-0.3959762E-01,-0.3950674E-01,-0.3941605E-01,-0.3932557E-01, +-0.3923529E-01,-0.3914521E-01,-0.3905533E-01,-0.3896565E-01, +-0.3887617E-01,-0.3878689E-01,-0.3869780E-01,-0.3860892E-01, +-0.3852024E-01,-0.3843175E-01,-0.3834346E-01,-0.3825537E-01, +-0.3816747E-01,-0.3807978E-01,-0.3799227E-01,-0.3790497E-01, +-0.3781786E-01,-0.3773094E-01,-0.3764422E-01,-0.3755769E-01, +-0.3747136E-01,-0.3738522E-01,-0.3729927E-01,-0.3721352E-01, +-0.3712796E-01,-0.3704259E-01,-0.3695741E-01,-0.3687242E-01, +-0.3678763E-01,-0.3670302E-01,-0.3661861E-01,-0.3653438E-01, +-0.3645034E-01,-0.3636650E-01,-0.3628284E-01,-0.3619937E-01, +-0.3611609E-01,-0.3603299E-01,-0.3595008E-01,-0.3586736E-01, +-0.3578483E-01,-0.3570248E-01,-0.3562031E-01,-0.3553834E-01, +-0.3545654E-01,-0.3537494E-01,-0.3529351E-01,-0.3521227E-01, +-0.3513121E-01,-0.3505034E-01,-0.3496965E-01,-0.3488914E-01, +-0.3480881E-01,-0.3472867E-01,-0.3464870E-01,-0.3456892E-01, +-0.3448931E-01,-0.3440989E-01,-0.3433065E-01,-0.3425158E-01, +-0.3417270E-01,-0.3409399E-01,-0.3401546E-01,-0.3393711E-01, +-0.3385894E-01,-0.3378094E-01,-0.3370312E-01,-0.3362548E-01, +-0.3354801E-01,-0.3347072E-01,-0.3339360E-01,-0.3331666E-01, +-0.3323990E-01,-0.3316330E-01,-0.3308688E-01,-0.3301064E-01, +-0.3293457E-01,-0.3285867E-01,-0.3278294E-01,-0.3270738E-01, +-0.3263200E-01,-0.3255679E-01,-0.3248175E-01,-0.3240688E-01, +-0.3233218E-01,-0.3225765E-01,-0.3218328E-01,-0.3210909E-01, +-0.3203507E-01,-0.3196121E-01,-0.3188753E-01,-0.3181401E-01, +-0.3174066E-01,-0.3166747E-01,-0.3159445E-01,-0.3152160E-01, +-0.3144892E-01,-0.3137639E-01,-0.3130404E-01,-0.3123185E-01, +-0.3115982E-01,-0.3108796E-01,-0.3101626E-01,-0.3094473E-01, +-0.3087336E-01,-0.3080215E-01,-0.3073110E-01,-0.3066022E-01, +-0.3058949E-01,-0.3051893E-01,-0.3044853E-01,-0.3037829E-01, +-0.3030821E-01,-0.3023829E-01,-0.3016853E-01,-0.3009893E-01, +-0.3002949E-01,-0.2996021E-01,-0.2989108E-01,-0.2982212E-01, +-0.2975331E-01,-0.2968466E-01,-0.2961616E-01,-0.2954782E-01, +-0.2947964E-01,-0.2941161E-01,-0.2934374E-01,-0.2927603E-01, +-0.2920846E-01,-0.2914106E-01,-0.2907380E-01,-0.2900671E-01, +-0.2893976E-01,-0.2887297E-01,-0.2880633E-01,-0.2873984E-01, +-0.2867351E-01,-0.2860732E-01,-0.2854129E-01,-0.2847541E-01, +-0.2840968E-01,-0.2834410E-01,-0.2827867E-01,-0.2821340E-01, +-0.2814827E-01,-0.2808329E-01,-0.2801845E-01,-0.2795377E-01, +-0.2788924E-01,-0.2782485E-01,-0.2776061E-01,-0.2769652E-01, +-0.2763257E-01,-0.2756877E-01,-0.2750512E-01,-0.2744161E-01, +-0.2737825E-01,-0.2731504E-01,-0.2725196E-01,-0.2718904E-01, +-0.2712626E-01,-0.2706362E-01,-0.2700112E-01,-0.2693877E-01, +-0.2687656E-01,-0.2681450E-01,-0.2675258E-01,-0.2669079E-01, +-0.2662916E-01,-0.2656766E-01,-0.2650630E-01,-0.2644508E-01, +-0.2638401E-01,-0.2632307E-01,-0.2626228E-01,-0.2620162E-01, +-0.2614111E-01,-0.2608073E-01,-0.2602049E-01,-0.2596039E-01, +-0.2590043E-01,-0.2584060E-01,-0.2578091E-01,-0.2572136E-01, +-0.2566195E-01,-0.2560267E-01,-0.2554353E-01,-0.2548453E-01, +-0.2542566E-01,-0.2536692E-01,-0.2530832E-01,-0.2524986E-01, +-0.2519153E-01,-0.2513333E-01,-0.2507527E-01,-0.2501734E-01, +-0.2495955E-01,-0.2490188E-01,-0.2484435E-01,-0.2478695E-01, +-0.2472969E-01,-0.2467255E-01,-0.2461555E-01,-0.2455868E-01, +-0.2450194E-01,-0.2444533E-01,-0.2438885E-01,-0.2433249E-01, +-0.2427627E-01,-0.2422018E-01,-0.2416422E-01,-0.2410838E-01, +-0.2405268E-01,-0.2399710E-01,-0.2394165E-01,-0.2388633E-01, +-0.2383113E-01,-0.2377607E-01,-0.2372113E-01,-0.2366631E-01, +-0.2361162E-01,-0.2355706E-01,-0.2350262E-01,-0.2344831E-01, +-0.2339413E-01,-0.2334006E-01,-0.2328613E-01,-0.2323231E-01, +-0.2317862E-01,-0.2312506E-01,-0.2307161E-01,-0.2301830E-01, +-0.2296510E-01,-0.2291202E-01,-0.2285907E-01,-0.2280624E-01, +-0.2275353E-01,-0.2270095E-01,-0.2264848E-01,-0.2259614E-01, +-0.2254391E-01,-0.2249181E-01,-0.2243982E-01,-0.2238796E-01, +-0.2233621E-01,-0.2228459E-01,-0.2223308E-01,-0.2218169E-01, +-0.2213042E-01,-0.2207927E-01,-0.2202824E-01,-0.2197732E-01, +-0.2192652E-01,-0.2187584E-01,-0.2182528E-01,-0.2177483E-01, +-0.2172450E-01,-0.2167428E-01,-0.2162418E-01,-0.2157419E-01, +-0.2152432E-01,-0.2147457E-01,-0.2142493E-01,-0.2137540E-01, +-0.2132599E-01,-0.2127669E-01,-0.2122751E-01,-0.2117844E-01, +-0.2112948E-01,-0.2108064E-01,-0.2103191E-01,-0.2098329E-01, +-0.2093478E-01,-0.2088638E-01,-0.2083810E-01,-0.2078993E-01, +-0.2074186E-01,-0.2069391E-01,-0.2064607E-01,-0.2059834E-01, +-0.2055072E-01,-0.2050321E-01,-0.2045581E-01,-0.2040852E-01, +-0.2036134E-01,-0.2031427E-01,-0.2026730E-01,-0.2022044E-01, +-0.2017370E-01,-0.2012706E-01,-0.2008052E-01,-0.2003410E-01, +-0.1998778E-01,-0.1994157E-01,-0.1989546E-01,-0.1984946E-01, +-0.1980357E-01,-0.1975779E-01,-0.1971210E-01,-0.1966653E-01, +-0.1962106E-01,-0.1957569E-01,-0.1953043E-01,-0.1948528E-01, +-0.1944022E-01,-0.1939528E-01,-0.1935043E-01,-0.1930569E-01, +-0.1926105E-01,-0.1921652E-01,-0.1917209E-01,-0.1912776E-01, +-0.1908353E-01,-0.1903940E-01,-0.1899538E-01,-0.1895146E-01, +-0.1890764E-01,-0.1886392E-01,-0.1882030E-01,-0.1877678E-01, +-0.1873337E-01,-0.1869005E-01,-0.1864683E-01,-0.1860372E-01, +-0.1856070E-01,-0.1851778E-01,-0.1847496E-01,-0.1843224E-01, +-0.1838962E-01,-0.1834710E-01,-0.1830467E-01,-0.1826234E-01, +-0.1822012E-01,-0.1817798E-01,-0.1813595E-01,-0.1809401E-01, +-0.1805217E-01,-0.1801043E-01,-0.1796878E-01,-0.1792723E-01, +-0.1788577E-01,-0.1784441E-01,-0.1780315E-01,-0.1776198E-01, +-0.1772090E-01,-0.1767992E-01,-0.1763904E-01,-0.1759825E-01, +-0.1755755E-01,-0.1751695E-01,-0.1747644E-01,-0.1743603E-01, +-0.1739571E-01,-0.1735548E-01,-0.1731534E-01,-0.1727530E-01, +-0.1723535E-01,-0.1719549E-01,-0.1715573E-01,-0.1711605E-01, +-0.1707647E-01,-0.1703698E-01,-0.1699758E-01,-0.1695827E-01, +-0.1691905E-01,-0.1687993E-01,-0.1684089E-01,-0.1680194E-01, +-0.1676309E-01,-0.1672432E-01,-0.1668564E-01,-0.1664705E-01, +-0.1660856E-01,-0.1657015E-01,-0.1653182E-01,-0.1649359E-01, +-0.1645545E-01,-0.1641739E-01,-0.1637942E-01,-0.1634154E-01, +-0.1630375E-01,-0.1626604E-01,-0.1622842E-01,-0.1619089E-01, +-0.1615345E-01,-0.1611609E-01,-0.1607882E-01,-0.1604163E-01, +-0.1600453E-01,-0.1596752E-01,-0.1593059E-01,-0.1589374E-01, +-0.1585698E-01,-0.1582031E-01,-0.1578372E-01,-0.1574722E-01, +-0.1571080E-01,-0.1567446E-01,-0.1563821E-01,-0.1560204E-01, +-0.1556596E-01,-0.1552996E-01,-0.1549404E-01,-0.1545820E-01, +-0.1542245E-01,-0.1538678E-01,-0.1535119E-01,-0.1531569E-01, +-0.1528027E-01,-0.1524493E-01,-0.1520967E-01,-0.1517449E-01, +-0.1513939E-01,-0.1510438E-01,-0.1506944E-01,-0.1503459E-01, +-0.1499982E-01,-0.1496512E-01,-0.1493051E-01,-0.1489598E-01, +-0.1486152E-01,-0.1482715E-01,-0.1479286E-01,-0.1475864E-01, +-0.1472451E-01,-0.1469045E-01,-0.1465647E-01,-0.1462257E-01, +-0.1458875E-01,-0.1455501E-01,-0.1452135E-01,-0.1448776E-01, +-0.1445425E-01,-0.1442082E-01,-0.1438746E-01,-0.1435419E-01, +-0.1432098E-01,-0.1428786E-01,-0.1425481E-01,-0.1422184E-01, +-0.1418895E-01,-0.1415613E-01,-0.1412339E-01,-0.1409072E-01, +-0.1405813E-01,-0.1402561E-01,-0.1399317E-01,-0.1396080E-01, +-0.1392851E-01,-0.1389630E-01,-0.1386415E-01,-0.1383209E-01, +-0.1380009E-01,-0.1376817E-01,-0.1373633E-01,-0.1370456E-01, +-0.1367286E-01,-0.1364123E-01,-0.1360968E-01,-0.1357820E-01, +-0.1354679E-01,-0.1351546E-01,-0.1348420E-01,-0.1345301E-01, +-0.1342189E-01,-0.1339084E-01,-0.1335987E-01,-0.1332897E-01, +-0.1329814E-01,-0.1326738E-01,-0.1323669E-01,-0.1320607E-01, +-0.1317553E-01,-0.1314505E-01,-0.1311464E-01,-0.1308431E-01, +-0.1305404E-01,-0.1302385E-01,-0.1299372E-01,-0.1296367E-01, +-0.1293368E-01,-0.1290377E-01,-0.1287392E-01,-0.1284414E-01, +-0.1281443E-01,-0.1278479E-01,-0.1275522E-01,-0.1272571E-01, +-0.1269628E-01,-0.1266691E-01,-0.1263761E-01,-0.1260838E-01, +-0.1257921E-01,-0.1255012E-01,-0.1252109E-01,-0.1249212E-01, +-0.1246323E-01,-0.1243440E-01,-0.1240564E-01,-0.1237694E-01, +-0.1234831E-01,-0.1231975E-01,-0.1229125E-01,-0.1226282E-01, +-0.1223445E-01,-0.1220615E-01,-0.1217792E-01,-0.1214975E-01, +-0.1212165E-01,-0.1209361E-01,-0.1206563E-01,-0.1203772E-01, +-0.1200988E-01,-0.1198210E-01,-0.1195438E-01,-0.1192673E-01, +-0.1189914E-01,-0.1187161E-01,-0.1184415E-01,-0.1181676E-01, +-0.1178942E-01,-0.1176215E-01,-0.1173494E-01,-0.1170780E-01, +-0.1168072E-01,-0.1165370E-01,-0.1162674E-01,-0.1159984E-01, +-0.1157301E-01,-0.1154624E-01,-0.1151953E-01,-0.1149289E-01, +-0.1146630E-01,-0.1143978E-01,-0.1141332E-01,-0.1138691E-01, +-0.1136057E-01,-0.1133429E-01,-0.1130808E-01,-0.1128192E-01, +-0.1125582E-01,-0.1122978E-01,-0.1120381E-01,-0.1117789E-01, +-0.1115203E-01,-0.1112624E-01,-0.1110050E-01,-0.1107482E-01, +-0.1104920E-01,-0.1102364E-01,-0.1099814E-01,-0.1097270E-01, +-0.1094732E-01,-0.1092200E-01,-0.1089673E-01,-0.1087153E-01, +-0.1084638E-01,-0.1082129E-01,-0.1079626E-01,-0.1077128E-01, +-0.1074636E-01,-0.1072151E-01,-0.1069670E-01,-0.1067196E-01, +-0.1064727E-01,-0.1062264E-01,-0.1059807E-01,-0.1057356E-01, +-0.1054910E-01,-0.1052469E-01,-0.1050035E-01,-0.1047606E-01, +-0.1045182E-01,-0.1042765E-01,-0.1040353E-01,-0.1037946E-01, +-0.1035545E-01,-0.1033149E-01,-0.1030760E-01,-0.1028375E-01, +-0.1025996E-01,-0.1023623E-01,-0.1021255E-01,-0.1018893E-01, +-0.1016536E-01,-0.1014184E-01,-0.1011838E-01,-0.1009497E-01, +-0.1007162E-01,-0.1004832E-01,-0.1002508E-01,-0.1000189E-01, +-0.9978751E-02,-0.9955668E-02,-0.9932638E-02,-0.9909661E-02, +-0.9886737E-02,-0.9863866E-02,-0.9841049E-02,-0.9818284E-02, +-0.9795571E-02,-0.9772912E-02,-0.9750304E-02,-0.9727749E-02, +-0.9705246E-02,-0.9682795E-02,-0.9660396E-02,-0.9638049E-02, +-0.9615754E-02,-0.9593510E-02,-0.9571317E-02,-0.9549176E-02, +-0.9527086E-02,-0.9505047E-02,-0.9483060E-02,-0.9461123E-02, +-0.9439236E-02,-0.9417401E-02,-0.9395616E-02,-0.9373881E-02, +-0.9352196E-02,-0.9330562E-02,-0.9308978E-02,-0.9287444E-02, +-0.9265959E-02,-0.9244524E-02,-0.9223139E-02,-0.9201803E-02, +-0.9180517E-02,-0.9159279E-02,-0.9138091E-02,-0.9116952E-02, +-0.9095862E-02,-0.9074821E-02,-0.9053828E-02,-0.9032884E-02, +-0.9011988E-02,-0.8991140E-02,-0.8970341E-02,-0.8949590E-02, +-0.8928887E-02,-0.8908232E-02,-0.8887624E-02,-0.8867065E-02, +-0.8846552E-02,-0.8826088E-02,-0.8805670E-02,-0.8785300E-02, +-0.8764977E-02,-0.8744701E-02,-0.8724472E-02,-0.8704289E-02, +-0.8684153E-02,-0.8664064E-02,-0.8644022E-02,-0.8624025E-02, +-0.8604075E-02,-0.8584171E-02,-0.8564314E-02,-0.8544502E-02, +-0.8524736E-02,-0.8505015E-02,-0.8485340E-02,-0.8465711E-02, +-0.8446127E-02,-0.8426589E-02,-0.8407095E-02,-0.8387647E-02, +-0.8368244E-02,-0.8348885E-02,-0.8329572E-02,-0.8310303E-02, +-0.8291078E-02,-0.8271899E-02,-0.8252763E-02,-0.8233672E-02, +-0.8214625E-02,-0.8195622E-02,-0.8176662E-02,-0.8157747E-02, +-0.8138876E-02,-0.8120048E-02,-0.8101263E-02,-0.8082523E-02, +-0.8063825E-02,-0.8045171E-02,-0.8026560E-02,-0.8007992E-02, +-0.7989467E-02,-0.7970984E-02,-0.7952545E-02,-0.7934148E-02, +-0.7915794E-02,-0.7897482E-02,-0.7879212E-02,-0.7860985E-02, +-0.7842800E-02,-0.7824657E-02,-0.7806556E-02,-0.7788497E-02, +-0.7770480E-02,-0.7752504E-02,-0.7734570E-02,-0.7716677E-02, +-0.7698826E-02,-0.7681016E-02,-0.7663247E-02,-0.7645520E-02, +-0.7627833E-02,-0.7610187E-02,-0.7592582E-02,-0.7575018E-02, +-0.7557495E-02,-0.7540012E-02,-0.7522569E-02,-0.7505167E-02, +-0.7487805E-02,-0.7470483E-02,-0.7453201E-02,-0.7435959E-02, +-0.7418758E-02,-0.7401595E-02,-0.7384473E-02,-0.7367390E-02, +-0.7350347E-02,-0.7333343E-02,-0.7316379E-02,-0.7299453E-02, +-0.7282567E-02,-0.7265720E-02,-0.7248912E-02,-0.7232143E-02, +-0.7215412E-02,-0.7198721E-02,-0.7182067E-02,-0.7165453E-02, +-0.7148877E-02,-0.7132339E-02,-0.7115839E-02,-0.7099378E-02, +-0.7082955E-02,-0.7066569E-02,-0.7050222E-02,-0.7033912E-02, +-0.7017640E-02,-0.7001406E-02,-0.6985209E-02,-0.6969050E-02, +-0.6952928E-02,-0.6936844E-02,-0.6920796E-02,-0.6904786E-02, +-0.6888813E-02,-0.6872877E-02,-0.6856977E-02,-0.6841115E-02, +-0.6825289E-02,-0.6809500E-02,-0.6793747E-02,-0.6778031E-02, +-0.6762351E-02,-0.6746707E-02,-0.6731100E-02,-0.6715528E-02, +-0.6699993E-02,-0.6684493E-02,-0.6669030E-02,-0.6653602E-02, +-0.6638210E-02,-0.6622853E-02,-0.6607532E-02,-0.6592247E-02, +-0.6576997E-02,-0.6561782E-02,-0.6546602E-02,-0.6531457E-02, +-0.6516348E-02,-0.6501273E-02,-0.6486233E-02,-0.6471228E-02, +-0.6456258E-02,-0.6441322E-02,-0.6426421E-02,-0.6411555E-02, +-0.6396722E-02,-0.6381925E-02,-0.6367161E-02,-0.6352432E-02/ c ------------------------------------------------------------ c derivative of d-state wave function data uadp/0.1739843E-03, + 0.1739843E-03, 0.6421329E-03, 0.1398629E-02, 0.2426725E-02, + 0.3712279E-02, 0.5243528E-02, 0.7010854E-02, 0.9006557E-02, + 0.1122462E-01, 0.1366046E-01, 0.1631075E-01, 0.1917313E-01, + 0.2224603E-01, 0.2552848E-01, 0.2901982E-01, 0.3271960E-01, + 0.3662735E-01, 0.4074237E-01, 0.4506362E-01, 0.4958954E-01, + 0.5431787E-01, 0.5924557E-01, 0.6436868E-01, 0.6968221E-01, + 0.7518004E-01, 0.8085488E-01, 0.8669817E-01, 0.9270007E-01, + 0.9884943E-01, 0.1051338E+00, 0.1115393E+00, 0.1180511E+00, + 0.1246526E+00, 0.1313266E+00, 0.1380545E+00, 0.1448167E+00, + 0.1515929E+00, 0.1583619E+00, 0.1651019E+00, 0.1717907E+00, + 0.1784057E+00, 0.1849242E+00, 0.1913234E+00, 0.1975808E+00, + 0.2036742E+00, 0.2095817E+00, 0.2152823E+00, 0.2207558E+00, + 0.2259827E+00, 0.2309449E+00, 0.2356252E+00, 0.2400079E+00, + 0.2440788E+00, 0.2478250E+00, 0.2512353E+00, 0.2543000E+00, + 0.2570112E+00, 0.2593627E+00, 0.2613498E+00, 0.2629696E+00, + 0.2642210E+00, 0.2651041E+00, 0.2656211E+00, 0.2657754E+00, + 0.2655719E+00, 0.2650168E+00, 0.2641177E+00, 0.2628834E+00, + 0.2613236E+00, 0.2594492E+00, 0.2572718E+00, 0.2548040E+00, + 0.2520588E+00, 0.2490499E+00, 0.2457915E+00, 0.2422981E+00, + 0.2385844E+00, 0.2346653E+00, 0.2305559E+00, 0.2262712E+00, + 0.2218261E+00, 0.2172353E+00, 0.2125134E+00, 0.2076746E+00, + 0.2027330E+00, 0.1977021E+00, 0.1925950E+00, 0.1874243E+00, + 0.1822024E+00, 0.1769409E+00, 0.1716509E+00, 0.1663432E+00, + 0.1610277E+00, 0.1557141E+00, 0.1504112E+00, 0.1451275E+00, + 0.1398708E+00, 0.1346485E+00, 0.1294674E+00, 0.1243337E+00, + 0.1192531E+00, 0.1142310E+00, 0.1092721E+00, 0.1043807E+00, + 0.9956078E-01, 0.9481580E-01, 0.9014882E-01, 0.8556255E-01, + 0.8105933E-01, 0.7664115E-01, 0.7230970E-01, 0.6806637E-01, + 0.6391224E-01, 0.5984817E-01, 0.5587475E-01, 0.5199234E-01, + 0.4820110E-01, 0.4450100E-01, 0.4089182E-01, 0.3737319E-01, + 0.3394457E-01, 0.3060531E-01, 0.2735461E-01, 0.2419159E-01, + 0.2111524E-01, 0.1812448E-01, 0.1521815E-01, 0.1239500E-01, + 0.9653732E-02, 0.6993009E-02, 0.4411429E-02, 0.1907558E-02, +-0.5200681E-03,-0.2872942E-02,-0.5152576E-02,-0.7360498E-02, +-0.9498243E-02,-0.1156736E-01,-0.1356939E-01,-0.1550588E-01, +-0.1737836E-01,-0.1918838E-01,-0.2093746E-01,-0.2262710E-01, +-0.2425880E-01,-0.2583404E-01,-0.2735428E-01,-0.2882095E-01, +-0.3023549E-01,-0.3159928E-01,-0.3291369E-01,-0.3418009E-01, +-0.3539979E-01,-0.3657409E-01,-0.3770427E-01,-0.3879157E-01, +-0.3983722E-01,-0.4084241E-01,-0.4180830E-01,-0.4273604E-01, +-0.4362675E-01,-0.4448150E-01,-0.4530136E-01,-0.4608737E-01, +-0.4684054E-01,-0.4756184E-01,-0.4825223E-01,-0.4891266E-01, +-0.4954402E-01,-0.5014720E-01,-0.5072306E-01,-0.5127244E-01, +-0.5179614E-01,-0.5229496E-01,-0.5276967E-01,-0.5322101E-01, +-0.5364970E-01,-0.5405646E-01,-0.5444197E-01,-0.5480689E-01, +-0.5515186E-01,-0.5547752E-01,-0.5578447E-01,-0.5607329E-01, +-0.5634457E-01,-0.5659885E-01,-0.5683668E-01,-0.5705857E-01, +-0.5726505E-01,-0.5745659E-01,-0.5763367E-01,-0.5779676E-01, +-0.5794630E-01,-0.5808273E-01,-0.5820647E-01,-0.5831794E-01, +-0.5841752E-01,-0.5850560E-01,-0.5858255E-01,-0.5864874E-01, +-0.5870451E-01,-0.5875021E-01,-0.5878617E-01,-0.5881269E-01, +-0.5883011E-01,-0.5883870E-01,-0.5883877E-01,-0.5883059E-01, +-0.5881445E-01,-0.5879060E-01,-0.5875930E-01,-0.5872081E-01, +-0.5867536E-01,-0.5862319E-01,-0.5856452E-01,-0.5849958E-01, +-0.5842858E-01,-0.5835172E-01,-0.5826922E-01,-0.5818126E-01, +-0.5808803E-01,-0.5798971E-01,-0.5788650E-01,-0.5777854E-01, +-0.5766603E-01,-0.5754910E-01,-0.5742794E-01,-0.5730268E-01, +-0.5717348E-01,-0.5704047E-01,-0.5690381E-01,-0.5676362E-01, +-0.5662004E-01,-0.5647319E-01,-0.5632320E-01,-0.5617019E-01, +-0.5601427E-01,-0.5585556E-01,-0.5569417E-01,-0.5553020E-01, +-0.5536376E-01,-0.5519495E-01,-0.5502387E-01,-0.5485061E-01, +-0.5467526E-01,-0.5449791E-01,-0.5431865E-01,-0.5413756E-01, +-0.5395473E-01,-0.5377023E-01,-0.5358414E-01,-0.5339654E-01, +-0.5320750E-01,-0.5301708E-01,-0.5282536E-01,-0.5263240E-01, +-0.5243827E-01,-0.5224303E-01,-0.5204675E-01,-0.5184947E-01, +-0.5165125E-01,-0.5145216E-01,-0.5125225E-01,-0.5105157E-01, +-0.5085016E-01,-0.5064809E-01,-0.5044539E-01,-0.5024212E-01, +-0.5003831E-01,-0.4983402E-01,-0.4962928E-01,-0.4942414E-01, +-0.4921863E-01,-0.4901280E-01,-0.4880669E-01,-0.4860032E-01, +-0.4839374E-01,-0.4818698E-01,-0.4798007E-01,-0.4777305E-01, +-0.4756595E-01,-0.4735879E-01,-0.4715161E-01,-0.4694444E-01, +-0.4673730E-01,-0.4653023E-01,-0.4632324E-01,-0.4611636E-01, +-0.4590962E-01,-0.4570304E-01,-0.4549665E-01,-0.4529046E-01, +-0.4508450E-01,-0.4487879E-01,-0.4467335E-01,-0.4446820E-01, +-0.4426336E-01,-0.4405885E-01,-0.4385468E-01,-0.4365088E-01, +-0.4344745E-01,-0.4324442E-01,-0.4304180E-01,-0.4283960E-01, +-0.4263785E-01,-0.4243655E-01,-0.4223572E-01,-0.4203537E-01, +-0.4183552E-01,-0.4163617E-01,-0.4143735E-01,-0.4123905E-01, +-0.4104130E-01,-0.4084409E-01,-0.4064745E-01,-0.4045138E-01, +-0.4025590E-01,-0.4006100E-01,-0.3986670E-01,-0.3967302E-01, +-0.3947994E-01,-0.3928750E-01,-0.3909568E-01,-0.3890451E-01, +-0.3871398E-01,-0.3852410E-01,-0.3833488E-01,-0.3814633E-01, +-0.3795845E-01,-0.3777124E-01,-0.3758472E-01,-0.3739888E-01, +-0.3721373E-01,-0.3702929E-01,-0.3684554E-01,-0.3666249E-01, +-0.3648016E-01,-0.3629854E-01,-0.3611763E-01,-0.3593745E-01, +-0.3575798E-01,-0.3557925E-01,-0.3540124E-01,-0.3522396E-01, +-0.3504741E-01,-0.3487160E-01,-0.3469653E-01,-0.3452220E-01, +-0.3434861E-01,-0.3417576E-01,-0.3400365E-01,-0.3383230E-01, +-0.3366168E-01,-0.3349182E-01,-0.3332271E-01,-0.3315434E-01, +-0.3298673E-01,-0.3281987E-01,-0.3265376E-01,-0.3248840E-01, +-0.3232379E-01,-0.3215994E-01,-0.3199684E-01,-0.3183449E-01, +-0.3167289E-01,-0.3151204E-01,-0.3135195E-01,-0.3119260E-01, +-0.3103401E-01,-0.3087617E-01,-0.3071907E-01,-0.3056272E-01, +-0.3040712E-01,-0.3025227E-01,-0.3009816E-01,-0.2994480E-01, +-0.2979218E-01,-0.2964030E-01,-0.2948916E-01,-0.2933876E-01, +-0.2918910E-01,-0.2904018E-01,-0.2889199E-01,-0.2874453E-01, +-0.2859781E-01,-0.2845181E-01,-0.2830654E-01,-0.2816200E-01, +-0.2801819E-01,-0.2787509E-01,-0.2773272E-01,-0.2759107E-01, +-0.2745013E-01,-0.2730991E-01,-0.2717040E-01,-0.2703160E-01, +-0.2689351E-01,-0.2675612E-01,-0.2661944E-01,-0.2648346E-01, +-0.2634818E-01,-0.2621360E-01,-0.2607972E-01,-0.2594652E-01, +-0.2581402E-01,-0.2568220E-01,-0.2555107E-01,-0.2542062E-01, +-0.2529085E-01,-0.2516176E-01,-0.2503334E-01,-0.2490560E-01, +-0.2477852E-01,-0.2465212E-01,-0.2452638E-01,-0.2440130E-01, +-0.2427688E-01,-0.2415312E-01,-0.2403001E-01,-0.2390755E-01, +-0.2378575E-01,-0.2366459E-01,-0.2354407E-01,-0.2342420E-01, +-0.2330496E-01,-0.2318636E-01,-0.2306839E-01,-0.2295105E-01, +-0.2283434E-01,-0.2271825E-01,-0.2260279E-01,-0.2248794E-01, +-0.2237371E-01,-0.2226009E-01,-0.2214709E-01,-0.2203469E-01, +-0.2192290E-01,-0.2181171E-01,-0.2170112E-01,-0.2159112E-01, +-0.2148172E-01,-0.2137291E-01,-0.2126469E-01,-0.2115706E-01, +-0.2105000E-01,-0.2094353E-01,-0.2083763E-01,-0.2073231E-01, +-0.2062756E-01,-0.2052338E-01,-0.2041977E-01,-0.2031672E-01, +-0.2021423E-01,-0.2011229E-01,-0.2001091E-01,-0.1991009E-01, +-0.1980981E-01,-0.1971008E-01,-0.1961089E-01,-0.1951225E-01, +-0.1941414E-01,-0.1931657E-01,-0.1921953E-01,-0.1912302E-01, +-0.1902704E-01,-0.1893159E-01,-0.1883665E-01,-0.1874224E-01, +-0.1864834E-01,-0.1855495E-01,-0.1846208E-01,-0.1836971E-01, +-0.1827785E-01,-0.1818650E-01,-0.1809564E-01,-0.1800529E-01, +-0.1791542E-01,-0.1782605E-01,-0.1773718E-01,-0.1764878E-01, +-0.1756088E-01,-0.1747345E-01,-0.1738650E-01,-0.1730004E-01, +-0.1721404E-01,-0.1712852E-01,-0.1704347E-01,-0.1695888E-01, +-0.1687476E-01,-0.1679110E-01,-0.1670790E-01,-0.1662515E-01, +-0.1654286E-01,-0.1646103E-01,-0.1637964E-01,-0.1629870E-01, +-0.1621820E-01,-0.1613814E-01,-0.1605853E-01,-0.1597935E-01, +-0.1590060E-01,-0.1582229E-01,-0.1574441E-01,-0.1566695E-01, +-0.1558992E-01,-0.1551331E-01,-0.1543713E-01,-0.1536136E-01, +-0.1528600E-01,-0.1521106E-01,-0.1513653E-01,-0.1506241E-01, +-0.1498870E-01,-0.1491539E-01,-0.1484248E-01,-0.1476997E-01, +-0.1469786E-01,-0.1462614E-01,-0.1455482E-01,-0.1448389E-01, +-0.1441334E-01,-0.1434318E-01,-0.1427341E-01,-0.1420402E-01, +-0.1413500E-01,-0.1406637E-01,-0.1399811E-01,-0.1393022E-01, +-0.1386271E-01,-0.1379556E-01,-0.1372878E-01,-0.1366237E-01, +-0.1359631E-01,-0.1353062E-01,-0.1346529E-01,-0.1340031E-01, +-0.1333569E-01,-0.1327142E-01,-0.1320750E-01,-0.1314393E-01, +-0.1308071E-01,-0.1301783E-01,-0.1295529E-01,-0.1289310E-01, +-0.1283124E-01,-0.1276972E-01,-0.1270853E-01,-0.1264768E-01, +-0.1258715E-01,-0.1252696E-01,-0.1246709E-01,-0.1240755E-01, +-0.1234833E-01,-0.1228943E-01,-0.1223086E-01,-0.1217260E-01, +-0.1211465E-01,-0.1205702E-01,-0.1199970E-01,-0.1194270E-01, +-0.1188600E-01,-0.1182960E-01,-0.1177352E-01,-0.1171773E-01, +-0.1166225E-01,-0.1160707E-01,-0.1155218E-01,-0.1149759E-01, +-0.1144330E-01,-0.1138930E-01,-0.1133559E-01,-0.1128217E-01, +-0.1122904E-01,-0.1117619E-01,-0.1112363E-01,-0.1107135E-01, +-0.1101935E-01,-0.1096763E-01,-0.1091619E-01,-0.1086503E-01, +-0.1081414E-01,-0.1076352E-01,-0.1071318E-01,-0.1066311E-01, +-0.1061330E-01,-0.1056376E-01,-0.1051449E-01,-0.1046547E-01, +-0.1041673E-01,-0.1036824E-01,-0.1032001E-01,-0.1027204E-01, +-0.1022432E-01,-0.1017686E-01,-0.1012966E-01,-0.1008270E-01, +-0.1003600E-01,-0.9989541E-02,-0.9943333E-02,-0.9897370E-02, +-0.9851651E-02,-0.9806176E-02,-0.9760942E-02,-0.9715948E-02, +-0.9671194E-02,-0.9626676E-02,-0.9582395E-02,-0.9538349E-02, +-0.9494536E-02,-0.9450954E-02,-0.9407604E-02,-0.9364483E-02, +-0.9321589E-02,-0.9278923E-02,-0.9236481E-02,-0.9194264E-02, +-0.9152269E-02,-0.9110496E-02,-0.9068943E-02,-0.9027608E-02, +-0.8986492E-02,-0.8945591E-02,-0.8904906E-02,-0.8864435E-02, +-0.8824176E-02,-0.8784128E-02,-0.8744291E-02,-0.8704662E-02, +-0.8665241E-02,-0.8626027E-02,-0.8587018E-02,-0.8548213E-02, +-0.8509611E-02,-0.8471210E-02,-0.8433010E-02,-0.8395010E-02, +-0.8357208E-02,-0.8319603E-02,-0.8282194E-02,-0.8244980E-02, +-0.8207959E-02,-0.8171131E-02,-0.8134495E-02,-0.8098049E-02, +-0.8061792E-02,-0.8025724E-02,-0.7989842E-02,-0.7954147E-02, +-0.7918636E-02,-0.7883310E-02,-0.7848166E-02,-0.7813204E-02, +-0.7778423E-02,-0.7743821E-02,-0.7709398E-02,-0.7675153E-02, +-0.7641084E-02,-0.7607191E-02,-0.7573472E-02,-0.7539927E-02, +-0.7506554E-02,-0.7473354E-02,-0.7440323E-02,-0.7407462E-02, +-0.7374770E-02,-0.7342246E-02,-0.7309888E-02,-0.7277696E-02, +-0.7245669E-02,-0.7213805E-02,-0.7182105E-02,-0.7150566E-02, +-0.7119189E-02,-0.7087972E-02,-0.7056914E-02,-0.7026014E-02, +-0.6995271E-02,-0.6964686E-02,-0.6934255E-02,-0.6903980E-02, +-0.6873858E-02,-0.6843889E-02,-0.6814072E-02,-0.6784407E-02, +-0.6754892E-02,-0.6725526E-02,-0.6696309E-02,-0.6667240E-02, +-0.6638318E-02,-0.6609542E-02,-0.6580911E-02,-0.6552424E-02, +-0.6524082E-02,-0.6495882E-02,-0.6467824E-02,-0.6439907E-02, +-0.6412131E-02,-0.6384494E-02,-0.6356997E-02,-0.6329637E-02, +-0.6302414E-02,-0.6275328E-02,-0.6248378E-02,-0.6221562E-02, +-0.6194881E-02,-0.6168333E-02,-0.6141918E-02,-0.6115635E-02, +-0.6089483E-02,-0.6063461E-02,-0.6037569E-02,-0.6011806E-02, +-0.5986172E-02,-0.5960664E-02,-0.5935284E-02,-0.5910029E-02, +-0.5884900E-02,-0.5859896E-02,-0.5835016E-02,-0.5810258E-02, +-0.5785624E-02,-0.5761111E-02,-0.5736720E-02,-0.5712449E-02, +-0.5688298E-02,-0.5664266E-02,-0.5640353E-02,-0.5616557E-02, +-0.5592879E-02,-0.5569317E-02,-0.5545871E-02,-0.5522541E-02, +-0.5499325E-02,-0.5476222E-02,-0.5453234E-02,-0.5430358E-02, +-0.5407594E-02,-0.5384941E-02,-0.5362399E-02,-0.5339968E-02, +-0.5317646E-02,-0.5295433E-02,-0.5273328E-02,-0.5251331E-02, +-0.5229442E-02,-0.5207659E-02,-0.5185981E-02,-0.5164410E-02, +-0.5142943E-02,-0.5121580E-02,-0.5100321E-02,-0.5079165E-02, +-0.5058112E-02,-0.5037161E-02,-0.5016311E-02,-0.4995561E-02, +-0.4974913E-02,-0.4954363E-02,-0.4933913E-02,-0.4913562E-02, +-0.4893309E-02,-0.4873153E-02,-0.4853094E-02,-0.4833132E-02, +-0.4813266E-02,-0.4793495E-02,-0.4773819E-02,-0.4754237E-02, +-0.4734750E-02,-0.4715355E-02,-0.4696054E-02,-0.4676844E-02, +-0.4657727E-02,-0.4638701E-02,-0.4619766E-02,-0.4600921E-02, +-0.4582166E-02,-0.4563500E-02,-0.4544923E-02,-0.4526434E-02, +-0.4508034E-02,-0.4489721E-02,-0.4471494E-02,-0.4453354E-02, +-0.4435301E-02,-0.4417332E-02,-0.4399449E-02,-0.4381651E-02, +-0.4363936E-02,-0.4346305E-02,-0.4328758E-02,-0.4311293E-02, +-0.4293911E-02,-0.4276610E-02,-0.4259391E-02,-0.4242253E-02, +-0.4225196E-02,-0.4208218E-02,-0.4191321E-02,-0.4174502E-02, +-0.4157763E-02,-0.4141102E-02,-0.4124519E-02,-0.4108013E-02, +-0.4091585E-02,-0.4075234E-02,-0.4058958E-02,-0.4042759E-02, +-0.4026636E-02,-0.4010587E-02,-0.3994613E-02,-0.3978714E-02, +-0.3962888E-02,-0.3947136E-02,-0.3931457E-02,-0.3915851E-02, +-0.3900317E-02,-0.3884856E-02,-0.3869465E-02,-0.3854146E-02, +-0.3838898E-02,-0.3823721E-02,-0.3808613E-02,-0.3793575E-02, +-0.3778607E-02,-0.3763707E-02,-0.3748876E-02,-0.3734114E-02, +-0.3719419E-02,-0.3704792E-02,-0.3690231E-02,-0.3675738E-02, +-0.3661311E-02,-0.3646951E-02,-0.3632656E-02,-0.3618426E-02, +-0.3604262E-02,-0.3590162E-02,-0.3576127E-02,-0.3562155E-02, +-0.3548248E-02,-0.3534403E-02,-0.3520622E-02,-0.3506904E-02, +-0.3493248E-02,-0.3479654E-02,-0.3466122E-02,-0.3452651E-02, +-0.3439241E-02,-0.3425892E-02,-0.3412603E-02,-0.3399375E-02, +-0.3386206E-02,-0.3373097E-02,-0.3360047E-02,-0.3347056E-02, +-0.3334124E-02,-0.3321250E-02,-0.3308434E-02,-0.3295675E-02, +-0.3282974E-02,-0.3270330E-02,-0.3257743E-02,-0.3245212E-02, +-0.3232738E-02,-0.3220319E-02,-0.3207956E-02,-0.3195649E-02, +-0.3183396E-02,-0.3171198E-02,-0.3159055E-02,-0.3146966E-02, +-0.3134930E-02,-0.3122949E-02,-0.3111021E-02,-0.3099145E-02, +-0.3087323E-02,-0.3075553E-02,-0.3063836E-02,-0.3052170E-02, +-0.3040557E-02,-0.3028994E-02,-0.3017483E-02,-0.3006023E-02, +-0.2994614E-02,-0.2983255E-02,-0.2971946E-02,-0.2960687E-02, +-0.2949478E-02,-0.2938318E-02,-0.2927207E-02,-0.2916146E-02, +-0.2905133E-02,-0.2894168E-02,-0.2883251E-02,-0.2872383E-02, +-0.2861562E-02,-0.2850789E-02,-0.2840062E-02,-0.2829383E-02, +-0.2818751E-02,-0.2808164E-02,-0.2797625E-02,-0.2787131E-02, +-0.2776683E-02,-0.2766280E-02,-0.2755923E-02,-0.2745611E-02, +-0.2735344E-02,-0.2725122E-02,-0.2714943E-02,-0.2704809E-02, +-0.2694719E-02,-0.2684673E-02,-0.2674670E-02,-0.2664711E-02, +-0.2654795E-02,-0.2644921E-02,-0.2635091E-02,-0.2625302E-02, +-0.2615556E-02,-0.2605852E-02,-0.2596190E-02,-0.2586570E-02, +-0.2576990E-02,-0.2567453E-02,-0.2557955E-02,-0.2548499E-02, +-0.2539084E-02,-0.2529708E-02,-0.2520373E-02,-0.2511078E-02, +-0.2501823E-02,-0.2492608E-02,-0.2483431E-02,-0.2474295E-02, +-0.2465196E-02,-0.2456137E-02,-0.2447117E-02,-0.2438135E-02, +-0.2429191E-02,-0.2420285E-02,-0.2411417E-02,-0.2402587E-02, +-0.2393794E-02,-0.2385038E-02,-0.2376320E-02,-0.2367639E-02, +-0.2358994E-02,-0.2350386E-02,-0.2341814E-02,-0.2333279E-02, +-0.2324779E-02,-0.2316316E-02,-0.2307888E-02,-0.2299496E-02, +-0.2291139E-02,-0.2282817E-02,-0.2274531E-02,-0.2266279E-02, +-0.2258061E-02,-0.2249878E-02,-0.2241730E-02,-0.2233616E-02, +-0.2225536E-02,-0.2217489E-02,-0.2209476E-02,-0.2201497E-02, +-0.2193551E-02,-0.2185639E-02,-0.2177759E-02,-0.2169912E-02, +-0.2162098E-02,-0.2154317E-02,-0.2146567E-02,-0.2138850E-02, +-0.2131166E-02,-0.2123512E-02,-0.2115891E-02,-0.2108302E-02, +-0.2100744E-02,-0.2093217E-02,-0.2085721E-02,-0.2078256E-02, +-0.2070822E-02,-0.2063419E-02,-0.2056047E-02,-0.2048705E-02, +-0.2041393E-02,-0.2034111E-02,-0.2026859E-02,-0.2019638E-02, +-0.2012446E-02,-0.2005283E-02,-0.1998150E-02,-0.1991046E-02, +-0.1983972E-02,-0.1976926E-02,-0.1969909E-02,-0.1962921E-02, +-0.1955961E-02,-0.1949031E-02,-0.1942128E-02,-0.1935253E-02, +-0.1928407E-02,-0.1921588E-02,-0.1914797E-02,-0.1908034E-02, +-0.1901299E-02,-0.1894591E-02,-0.1887910E-02,-0.1881256E-02, +-0.1874629E-02,-0.1868030E-02,-0.1861457E-02,-0.1854910E-02, +-0.1848390E-02,-0.1841897E-02,-0.1835429E-02,-0.1828988E-02, +-0.1822573E-02,-0.1816184E-02,-0.1809820E-02,-0.1803483E-02, +-0.1797170E-02,-0.1790883E-02,-0.1784622E-02,-0.1778386E-02, +-0.1772174E-02,-0.1765988E-02,-0.1759827E-02,-0.1753690E-02, +-0.1747578E-02,-0.1741490E-02,-0.1735427E-02,-0.1729388E-02, +-0.1723373E-02,-0.1717382E-02,-0.1711415E-02,-0.1705472E-02, +-0.1699552E-02,-0.1693656E-02,-0.1687784E-02,-0.1681935E-02, +-0.1676109E-02,-0.1670307E-02,-0.1664527E-02,-0.1658771E-02, +-0.1653037E-02,-0.1647326E-02,-0.1641638E-02,-0.1635972E-02, +-0.1630329E-02,-0.1624708E-02,-0.1619109E-02,-0.1613532E-02, +-0.1607977E-02,-0.1602445E-02,-0.1596934E-02,-0.1591445E-02, +-0.1585977E-02,-0.1580531E-02,-0.1575107E-02,-0.1569704E-02, +-0.1564322E-02,-0.1558961E-02,-0.1553621E-02,-0.1548302E-02, +-0.1543004E-02,-0.1537727E-02,-0.1532470E-02,-0.1527234E-02, +-0.1522019E-02,-0.1516823E-02,-0.1511649E-02,-0.1506494E-02, +-0.1501359E-02,-0.1496245E-02,-0.1491150E-02,-0.1486075E-02, +-0.1481020E-02,-0.1475985E-02,-0.1470969E-02,-0.1465973E-02, +-0.1460996E-02,-0.1456038E-02,-0.1451099E-02,-0.1446180E-02, +-0.1441280E-02,-0.1436398E-02,-0.1431536E-02,-0.1426692E-02, +-0.1421867E-02,-0.1417061E-02,-0.1412273E-02,-0.1407504E-02, +-0.1402753E-02,-0.1398020E-02,-0.1393306E-02,-0.1388610E-02, +-0.1383932E-02,-0.1379272E-02,-0.1374630E-02,-0.1370005E-02, +-0.1365399E-02,-0.1360809E-02,-0.1356238E-02,-0.1351684E-02, +-0.1347147E-02,-0.1342628E-02,-0.1338126E-02,-0.1333641E-02, +-0.1329174E-02,-0.1324723E-02,-0.1320289E-02,-0.1315873E-02, +-0.1311473E-02,-0.1307090E-02,-0.1302723E-02,-0.1298374E-02, +-0.1294040E-02,-0.1289723E-02,-0.1285423E-02,-0.1281139E-02, +-0.1276871E-02,-0.1272619E-02,-0.1268383E-02,-0.1264164E-02, +-0.1259960E-02,-0.1255772E-02,-0.1251601E-02,-0.1247445E-02, +-0.1243304E-02,-0.1239179E-02,-0.1235070E-02,-0.1230976E-02, +-0.1226897E-02,-0.1222834E-02,-0.1218786E-02,-0.1214754E-02, +-0.1210736E-02,-0.1206734E-02,-0.1202747E-02,-0.1198774E-02, +-0.1194817E-02,-0.1190874E-02,-0.1186947E-02,-0.1183033E-02, +-0.1179135E-02,-0.1175250E-02,-0.1171381E-02,-0.1167526E-02, +-0.1163685E-02,-0.1159858E-02,-0.1156046E-02,-0.1152248E-02, +-0.1148464E-02,-0.1144695E-02,-0.1140939E-02,-0.1137197E-02, +-0.1133469E-02,-0.1129756E-02,-0.1126055E-02,-0.1122369E-02, +-0.1118696E-02,-0.1115037E-02,-0.1111391E-02,-0.1107759E-02, +-0.1104140E-02,-0.1100534E-02,-0.1096942E-02,-0.1093363E-02, +-0.1089797E-02,-0.1086245E-02,-0.1082706E-02,-0.1079179E-02, +-0.1075666E-02,-0.1072165E-02,-0.1068678E-02,-0.1065203E-02, +-0.1061741E-02,-0.1058292E-02,-0.1054855E-02,-0.1051431E-02, +-0.1048020E-02,-0.1044621E-02,-0.1041234E-02,-0.1037860E-02, +-0.1034498E-02,-0.1031149E-02,-0.1027812E-02,-0.1024487E-02, +-0.1021174E-02,-0.1017873E-02,-0.1014585E-02,-0.1011308E-02, +-0.1008043E-02,-0.1004790E-02,-0.1001549E-02,-0.9983194E-03, +-0.9951020E-03,-0.9918960E-03,-0.9887015E-03,-0.9855187E-03, +-0.9823475E-03,-0.9791875E-03,-0.9760393E-03,-0.9729024E-03, +-0.9697769E-03,-0.9666628E-03,-0.9635598E-03,-0.9604679E-03, +-0.9573872E-03,-0.9543177E-03,-0.9512593E-03,-0.9482121E-03, +-0.9451756E-03,-0.9421500E-03,-0.9391355E-03,-0.9361315E-03, +-0.9331388E-03,-0.9301561E-03,-0.9271845E-03,-0.9242238E-03, +-0.9212739E-03,-0.9183342E-03,-0.9154051E-03,-0.9124864E-03, +-0.9095785E-03,-0.9066808E-03,-0.9037934E-03,-0.9009163E-03, +-0.8980496E-03,-0.8951934E-03,-0.8923472E-03,-0.8895112E-03, +-0.8866855E-03,-0.8838693E-03,-0.8810633E-03,-0.8782674E-03, +-0.8754817E-03,-0.8727060E-03,-0.8699397E-03,-0.8671835E-03, +-0.8644371E-03,-0.8616999E-03,-0.8589730E-03,-0.8562552E-03, +-0.8535475E-03,-0.8508497E-03,-0.8481610E-03,-0.8454818E-03, +-0.8428125E-03,-0.8401528E-03,-0.8375017E-03,-0.8348603E-03, +-0.8322283E-03,-0.8296055E-03,-0.8269918E-03,-0.8243868E-03, +-0.8217918E-03,-0.8192057E-03,-0.8166287E-03,-0.8140609E-03, +-0.8115017E-03,-0.8089517E-03,-0.8064108E-03,-0.8038786E-03, +-0.8013558E-03,-0.7988420E-03,-0.7963368E-03,-0.7938399E-03, +-0.7913518E-03,-0.7888729E-03,-0.7864023E-03,-0.7839404E-03, +-0.7814873E-03,-0.7790429E-03,-0.7766066E-03,-0.7741790E-03, +-0.7717595E-03,-0.7693488E-03,-0.7669462E-03,-0.7645518E-03, +-0.7621662E-03,-0.7597889E-03,-0.7574198E-03,-0.7550587E-03, +-0.7527059E-03,-0.7503618E-03,-0.7480255E-03,-0.7456972E-03, +-0.7433770E-03,-0.7410649E-03,-0.7387607E-03,-0.7364645E-03, +-0.7341760E-03,-0.7318952E-03,-0.7296228E-03,-0.7273580E-03, +-0.7251014E-03,-0.7228524E-03,-0.7206111E-03,-0.7183777E-03, +-0.7161522E-03,-0.7139341E-03,-0.7117235E-03,-0.7095204E-03, +-0.7073251E-03,-0.7051374E-03,-0.7029571E-03,-0.7007845E-03, +-0.6986192E-03,-0.6964610E-03,-0.6943110E-03,-0.6921680E-03, +-0.6900323E-03,-0.6879040E-03,-0.6857830E-03,-0.6836689E-03, +-0.6815627E-03,-0.6794634E-03,-0.6773721E-03,-0.6752873E-03, +-0.6732099E-03,-0.6711397E-03,-0.6690759E-03,-0.6670193E-03, +-0.6649695E-03,-0.6629269E-03,-0.6608911E-03,-0.6588621E-03, +-0.6568397E-03,-0.6548248E-03,-0.6528165E-03,-0.6508145E-03, +-0.6488202E-03,-0.6468324E-03,-0.6448512E-03,-0.6428769E-03, +-0.6409092E-03,-0.6389487E-03,-0.6369945E-03,-0.6350470E-03, +-0.6331059E-03,-0.6311713E-03,-0.6292435E-03,-0.6273218E-03, +-0.6254072E-03,-0.6234993E-03,-0.6215974E-03,-0.6197018E-03, +-0.6178126E-03,-0.6159298E-03,-0.6140532E-03,-0.6121831E-03, +-0.6103191E-03,-0.6084618E-03,-0.6066107E-03,-0.6047655E-03, +-0.6029264E-03,-0.6010939E-03,-0.5992672E-03,-0.5974467E-03, +-0.5956327E-03,-0.5938245E-03,-0.5920221E-03,-0.5902253E-03, +-0.5884351E-03,-0.5866511E-03,-0.5848729E-03,-0.5831011E-03, +-0.5813356E-03,-0.5795756E-03,-0.5778212E-03,-0.5760725E-03, +-0.5743302E-03,-0.5725932E-03,-0.5708623E-03,-0.5691371E-03, +-0.5674179E-03,-0.5657043E-03,-0.5639960E-03,-0.5622941E-03, +-0.5605974E-03,-0.5589058E-03,-0.5572205E-03,-0.5555405E-03, +-0.5538665E-03,-0.5521971E-03,-0.5505334E-03,-0.5488758E-03, +-0.5472240E-03,-0.5455782E-03,-0.5439365E-03,-0.5423010E-03, +-0.5406705E-03,-0.5390449E-03,-0.5374256E-03,-0.5358109E-03, +-0.5342017E-03,-0.5325983E-03,-0.5309996E-03,-0.5294063E-03, +-0.5278181E-03,-0.5262365E-03,-0.5246597E-03,-0.5230875E-03, +-0.5215202E-03,-0.5199585E-03,-0.5184012E-03,-0.5168499E-03, +-0.5153034E-03,-0.5137622E-03,-0.5122257E-03,-0.5106950E-03, +-0.5091690E-03,-0.5076480E-03,-0.5061315E-03,-0.5046204E-03, +-0.5031140E-03,-0.5016131E-03,-0.5001169E-03,-0.4986261E-03, +-0.4971397E-03,-0.4956578E-03,-0.4941807E-03,-0.4927087E-03, +-0.4912411E-03,-0.4897788E-03,-0.4883211E-03,-0.4868690E-03, +-0.4854206E-03,-0.4839762E-03,-0.4825383E-03,-0.4811047E-03, +-0.4796756E-03,-0.4782512E-03,-0.4768315E-03,-0.4754157E-03, +-0.4740039E-03,-0.4725967E-03,-0.4711940E-03,-0.4697970E-03, +-0.4684047E-03,-0.4670166E-03,-0.4656327E-03,-0.4642533E-03, +-0.4628787E-03,-0.4615085E-03,-0.4601421E-03,-0.4587810E-03, +-0.4574244E-03,-0.4560721E-03,-0.4547236E-03,-0.4533790E-03, +-0.4520393E-03,-0.4507038E-03,-0.4493726E-03,-0.4480453E-03, +-0.4467234E-03,-0.4454049E-03,-0.4440913E-03,-0.4427819E-03, +-0.4414773E-03,-0.4401762E-03,-0.4388790E-03,-0.4375870E-03, +-0.4362983E-03,-0.4350139E-03,-0.4337336E-03,-0.4324572E-03, +-0.4311850E-03,-0.4299171E-03,-0.4286534E-03,-0.4273936E-03, +-0.4261375E-03,-0.4248857E-03,-0.4236378E-03,-0.4223936E-03, +-0.4211535E-03,-0.4199176E-03,-0.4186854E-03,-0.4174572E-03, +-0.4162333E-03,-0.4150126E-03,-0.4137957E-03,-0.4125828E-03, +-0.4113745E-03,-0.4101702E-03,-0.4089697E-03,-0.4077730E-03, +-0.4065796E-03,-0.4053908E-03,-0.4042051E-03,-0.4030234E-03, +-0.4018450E-03,-0.4006710E-03,-0.3995011E-03,-0.3983342E-03/ c ------------------------------------------------------------------- r=h twoh=2.d0*h cons=hc*hc/2.d0/rmu do i=2,1500 ds=(uasp(i+1)-uasp(i-1))/twoh dd=(uadp(i+1)-uadp(i-1))/twoh vavs(i)=ed*uavs(i)+cons*(ds) vavd(i)=ed*uavd(i)+cons*(dd-6.d0*uavd(i)/r/r) r=r+h enddo return end c----------------------------------------------------------------------- subroutine saxon(r,rt,deet,g) implicit real*8(a-h,o-z) g=1.d0/(1.0+exp((r-rt)*deet)) return end c----------------------------------------------------------------------- subroutine dsaxon(r,rt,deet,dg) implicit real*8(a-h,o-z) gg=exp((r-rt)*deet) g=(1.d0+gg) dg=4.0*gg/g/g return end c----------------------------------------------------------------------- subroutine thomas(r,rt,deet,dg) implicit real*8(a-h,o-z) dg=0.0 if(r.eq.0.0) return gg=exp((r-rt)*deet) g=1+gg dg=2.0*gg*deet/r/g/g return end