C This subroutine calculates the number of 1N and XN C coulomb breakup at impact parameter b for a nucleus with C Z=zp, A=ap C it is not normalized; the real probability is P=1-exp(-p1N), etc. SUBROUTINE PHOTONBREAKUP(P1N,PXN,b,zp,ap,gamma,omaxx) IMPLICIT REAL*8(A-H,O-Z) C ENERGY STORAGE ARRAYS dimension ee(10000), eee(161),e1(22),e2(11),e3(28) C data storage dimension se(10000), sa(160),s1(22),s2(11),s3(28),sen(160) C proton and neutron cross sections dimension sigt(159),sigtn(159) data e1/103.,106.,112.,119.,127.,132.,145.,171.,199.,230.,235., x254.,280.,300.,320.,330.,333.,373.,390.,420.,426.,440./ data s1/12.0,11.5,12.0,12.0,12.0,15.0,17.0,28.0,33.0,52.0,60.0, x70.0,76.0,85.0,86.0,89.0,89.0,75.0,76.0,69.0,59.0,61.0/ data e2/2000.,3270.,4100.,4810.,6210.,6600.,7790.,8400., x9510.,13600.,16400./ data s2/.1266,.1080,.0805,.1017,.0942,.0844,.0841,.0755, x.0827,.0626,.0740/ data e3/26.,28.,30.,32.,34.,36.,38.,40.,44.,46., x48.,50.,52.,55.,57.,62.,64.,66.,69.,72., x74.,76.,79.,82.,86.,92.,98.,103./ data s3/30.,21.5,22.5,18.5,17.5,15.,14.5,19.,17.5,16., x14.,20.,16.5,17.5,17.,15.5,18.,15.5,15.5,15., x13.5,18.,14.5,15.5,12.5,13.,13.,12./ data sa/0.,.004,.008,.013,.017,.021,.025,.029,.034,.038,.042,.046, x.051,.055,.059,.063,.067,.072,.076,.08,.085,.09,.095,.1,.108,.116, x.124,.132,.14,.152,.164,.176,.188,.2,.22,.24,.26,.28,.3,.32,.34, x.36,.38,.4,.417,.433,.450,.467,.483,.5,.51,.516,.52,.523,.5245, x.525,.5242, x.5214,.518,.512,.505,.495,.482,.469,.456,.442,.428,.414,.4,.386, x.370,.355,.34,.325,.310,.295,.280,.265,.25,.236,.222,.208,.194, x.180,.166, x.152,.138,.124,.11,.101,.095,.09,.085,.08,.076,.072,.069,.066, x.063,.06,.0575,.055,.0525,.05,.04875,.0475,.04625,.045,.04375, x.0425,.04125,.04,.03875,.0375,.03625,.035,.03375,.0325,.03125,.03, x.02925,.0285,.02775,.027,.02625,.0255,.02475,.024,.02325,.0225, x.02175,.021,.02025,.0195,.01875,.018,.01725,.0165,.01575,.015, x.01425,.0135,.01275,.012,.01125,.0105,.00975,.009,.00825,.0075, x.00675,.006,.00525,.0045,.00375,.003,.00225,.0015,.00075,0./ data sen/0.,.012,.025,.038,.028,.028,.038,.035,.029,.039,.035, x.038,.032,.038,.041,.041,.049,.055,.061,.072,.076,.070,.067, x.080,.103,.125,.138,.118,.103,.129,.155,.170,.180,.190,.200, x.215,.250,.302,.310,.301,.315,.330,.355,.380,.400,.410,.420, x.438,.456,.474,.492,.510,.533,.556,.578,.6,.62,.63,.638, x.640,.640,.637,.631,.625,.618,.610,.600,.580,.555,.530,.505, x.480,.455,.435,.410,.385,.360,.340,.320,.300,.285,.270,.255, x.240,.225,.210,.180,.165,.150,.140,.132,.124,.116,.108,.100, x.092,.084,.077,.071,.066,.060,.055,.051,.048,.046,.044,.042, x.040,.038,.036,.034,.032,.030,.028,.027,.026,.025,.025,.025, x.024,.024,.024,.024,.024,.023,.023,.023,.023,.023,.022,.022, x.022,.022,.022,.021,.021,.021,.020,.020, x.020,.019,.018,.017,.016,.015,.014,.013,.012,.011,.010,.009, x.008,.007,.006,.005,.004,.003,.002,.001,0./ c gammay,p gamma,n of Armstrong begin at 265 incr 25 data sigt/.4245,.4870,.5269,.4778,.4066,.3341,.2444,.2245,.2005, x.1783,.1769,.1869,.1940,.2117,.2226,.2327,.2395,.2646,.2790,.2756, x.2607,.2447,.2211,.2063,.2137,.2088,.2017,.2050,.2015,.2121,.2175, x.2152,.1917,.1911,.1747,.1650,.1587,.1622,.1496,.1486,.1438,.1556, x.1468,.1536,.1544,.1536,.1468,.1535,.1442,.1515,.1559,.1541,.1461, x.1388,.1565,.1502,.1503,.1454,.1389,.1445,.1425,.1415,.1424,.1432, x.1486,.1539,.1354,.1480,.1443,.1435,.1491,.1435,.1380,.1317,.1445, x.1375,.1449,.1359,.1383,.1390,.1361,.1286,.1359,.1395,.1327,.1387, x.1431,.1403,.1404,.1389,.1410,.1304,.1363,.1241,.1284,.1299,.1325, x.1343,.1387,.1328,.1444,.1334,.1362,.1302,.1338,.1339,.1304,.1314, x.1287,.1404,.1383,.1292,.1436,.1280,.1326,.1321,.1268,.1278,.1243, x.1239,.1271,.1213,.1338,.1287,.1343,.1231,.1317,.1214,.1370,.1232, x.1301,.1348,.1294,.1278,.1227,.1218,.1198,.1193,.1342,.1323,.1248, x.1220,.1139,.1271,.1224,.1347,.1249,.1163,.1362,.1236,.1462,.1356, x.1198,.1419,.1324,.1288,.1336,.1335,.1266/ data sigtn/.3125,.3930,.4401,.4582,.3774,.3329,.2996,.2715,.2165, x.2297,.1861,.1551,.2020,.2073,.2064,.2193,.2275,.2384,.2150,.2494, x.2133,.2023,.1969,.1797,.1693,.1642,.1463,.1280,.1555,.1489,.1435, x.1398,.1573,.1479,.1493,.1417,.1403,.1258,.1354,.1394,.1420,.1364, x.1325,.1455,.1326,.1397,.1286,.1260,.1314,.1378,.1353,.1264,.1471, x.1650,.1311,.1261,.1348,.1277,.1518,.1297,.1452,.1453,.1598,.1323, x.1234,.1212,.1333,.1434,.1380,.1330,89*.12/ INTEGER IFIRST SAVE IFIRST DATA IFIRST /0/ C Initialization needed? IF (IFIRST .NE. 0) GOTO 100 IFIRST=1 hbar=197.3 pi=3.141592654 C maximum energy for GDR dissocation (in target frame, in MeV) omax1n=24.01 if(zp.eq.79) then ap=197. si1=540. g1=4.75 C peak and minimum energies for GDR excitation (in MeV) o1=13.70 o0=8.1 else zp=82. ap=208. si1=640. g1=4.05 o1=13.42 o0=7.4 do 104 j=1,160 sa(j)=sen(j) 104 continue endif C part II of initialization delo=.05 c .1 to turn mb into fm^2 scon=.1*g1*g1*si1 zcon=(zp/(gamma*pi*hbar))**2/137.04 C write(6,51)zp,gamma,pi,hbar,zcon C 51 format(' ZP,gamma,pi,hbar,zcon ',F7.4,' ',E11.4,' ',F8.5, C *' ',E12.5,' ',E12.5) c Single neutron from GDR, Veyssiere et al. Nucl. Phys. A159, 561 (1970) do 111 i=1,160 eee(i)=o0+.1*(i-1) sa(i)=100.*sa(i) 111 continue c See Baltz, Rhoades-Brown, and Weneser, Phys. Rev. E 54, 4233 (1996) c for details of the folowing photo cross-sections. eee(161)=24.1 ne=nint((25.-o0)/delo)+1 c GDR any number of neutrons, Veyssiere et al., Nucl. Phys. A159, 561 (1970) do 200 i=1,ne ee(i)=o0+(i-1)*delo se(i)=scon*ee(i)*ee(i)/((o1*o1-ee(i)*ee(i))**2 1 +ee(i)*ee(i)*g1*g1) 200 continue i=ne c 25-103 MeV, Lepretre, et al., Nucl. Phys. A367, 237 (1981) do 110 j=1,27 i=i+1 ee(i)=e3(j) se(i)=.1*ap*s3(j)/208. 110 continue c 103-440 MeV, Carlos, et al., Nucl. Phys. A431, 573 (1984) do 130 j=1,22 i=i+1 ee(i)=e1(j) se(i)=.1*ap*s1(j)/208. 130 continue c 440 MeV-2 GeV Armstrong et al. do 140 j=9,70 i=i+1 ee(i)=ee(i-1)+25. se(i)=.1*(zp*sigt(j)+(ap-zp)*sigtn(j)) 140 continue c 2-16.4 GeV Michalowski; Caldwell do 150 j=1,11 i=i+1 ee(i)=e2(j) se(i)=.1*ap*s2(j) 150 continue c Regge parameters x=.0677 y=.129 eps=.0808 eta=.4525 em=.94 exx=10**.05 c Regge model for high energy s=.002*em*ee(i) C make sure we reach LHC energies ictr=100 if (gamma .gt. (2.*150.*150.)) ictr=150 do 160 j=1,ictr i=i+1 s=s*exx ee(i)=1000.*.5*(s-em*em)/em pom=x*s**eps vec=y*s**(-eta) se(i)=.1*.65*ap*(pom+vec) c write(7,*)i,ee(i),se(i) c write(8,*)ee(i),se(i) 160 continue ee(i+1)=99999999999. write(6,99)o0 99 format(' Coulomb breakup initialized. Emin= ',F7.3, 'MeV') C done with initaliation. 100 CONTINUE C clear counters for 1N,XN P1N=0. PXN=0. c start XN calculation C what's the (b-dependent) highest energy of interest? omax=min(omaxx,4.*gamma*hbar/b) if (omax .lt.o0) return gk1m=dbesk1(ee(1)*b/(hbar*gamma)) k=2 212 if(ee(k).lt.omax) then gk1=dbesk1(ee(k)*b/(hbar*gamma)) C Eq.(3) BCW: PXN=PXN+zcon*(ee(k)-ee(k-1))*.5*(se(k-1)*ee(k-1)* 1 gk1m*gk1m+se(k)*ee(k)*gk1*gk1) k=k+1 gk1m=gk1 goto 212 endif c one neutron dissociation omax=min(omax1n,4.*gamma*hbar/b) gk1m=dbesk1(eee(1)*b/(hbar*gamma)) k=2 102 if(eee(k).lt.omax) then gk1=dbesk1(eee(k)*b/(hbar*gamma)) c Like Eq.(3) but with only the one neutron out GDR photo cross section input: P1N=P1N+zcon*(eee(k)-eee(k-1))*.5*(sa(k-1)* 1 eee(k-1)*gk1m*gk1m+sa(k)*eee(k)*gk1*gk1) k=k+1 gk1m=gk1 goto 102 endif RETURN END