Oliy va o’rta maxsus ta`lim vazirligi

blockdata single
implicit real*8(a-h,o-z)
common/nucdata/A1,A2,z1,z2
common/constant/H22M,pi,e2
***** for 8B -> 7Be + p
c data a1/7.0d0/,a2/1.0d0/,z1/4.0/,z2/1.0/
data a1/7.014735d0/,a2/1.0072764669d0/,z1/4.0/,z2/1.0/
data H22M/20.7343d0/,pi/3.141592653589793/, e2/1.439975/ !rmasp=938.974MeV
c data H22M/20.9d0/,pi/3.141592653589793/, e2/1.43989923/ !rmasp=931.530 MeV
end
PROGRAM E1_and_E2_single_transition
implicit real*8(a-h,o-z)
parameter(N1=10000,N2=2)
dimension Vpotf(N1),Gbound(N1),R12(N1)
common/nucdata/A1,A2,z1,z2
common/constant/H22M,pi,e2
A12=A1+A2
RMU=(A1*A2)/(A12)
print*
print*,'RMU=',Rmu
print*
c HM=20.73422408/mu tut tau_N=6.4396
HM=H22M/RMU
Tau=dsqrt(H22M*2.d0)
c hc=197.3269788d0 !L.Marcucci NPA987, 1-15 (2019)
hc=197.327d0
rmasp=hc*hc/2.d0/H22M
rk=hc/rmasp/2.d0
print*, 'rmasp=',rmasp
N=1000
h=0.05d0
eps=0.001d0
Lf=1
Jf=2
open(4,file='ANC-8B.dat')
open(5,file='wf-8B.dat')
DO i=1,N
R12(i)=i*h
ENDDO
do i=1,N
Vpotf(i)=Vdub(R12(i),Lf,Jf)+HM*Lf*(Lf+1)/(i*h)**2
enddo
do i=1,N
Vpotf(i)=Vpotf(i)/HM
enddo
******************* bound state calculation*********************
E=0
Nr=0
S22=0
call NUM1L(N,h,E,S22,Vpotf,Gbound,Nr,Eps)
E=E*HM
write(5,301) N,h,E
write(*,301) N,h,E
write(5,302) Lf,Jf
do i=1,N
write(5,303) i*h,Gbound(i)
enddo
301 format(2x,'N=',I4,' h=',F12.2,' E=',F12.5,'MeV')
302 format(5x,'R',10x,'Wave_func(R)'/5x,'Lf=',I2,5x,'Jf=',I2)
303 format(1x,F6.3,3x,E12.5)
c-------------------------------------------------------------------
** ANC calculation
c-------------------------------------------------------------------
cc------Dubovichenko_Russian Physics Journal_2018 ------
c if(Jf.eq.2) Eth=0.13672d0
c if(Jf.eq.2) Eth=0.13705d0
cc------Dubovichenko_NPA_2019 --------------------------
!Eps=0.0001
c if(Jf.eq.2) Eth=0.13631d0 !Ta'qiqlangan xolat bor =>Nr=0=> Eth=-96.6 MeV
c if(Jf.eq.2) Eth=0.13753d0 ! Ta'qiqlangan xolat yo'q
!Eps=0.001
c if(Jf.eq.2) Eth=0.13631d0 !Ta'qiqlangan xolat bor =>Nr=0=> Eth=-96.6 MeV
if(Jf.eq.2) Eth=0.13499d0 ! Ta'qiqlangan xolat yo'q
QKA=DSQRT(2.d0*Eth*RMU)/tau
ETA=-Z1*Z2*E2*DSQRT(RMU/2.d0/Eth)/tau
print*
write(*,147) QKA,ETA
print*
147 format(2x,'QKA=',F12.3,'fm^(-1/2)',2x,' ','ETA=',F12.3)
eps1=eps
do i=1,N
CALL WITT(ETA,1.5d0,2.d0*QKA*R12(i),W,WP,EPS1)
c s1=Gbound(i)/W/sqrt(2.d0*QKA) ! ANC bezrazmerniy
s1=Gbound(i)/W ! ANC razmerniy [fm^(-1/2)]
write(4,148) R12(i),s1,s1*s1
c write(*,148) R12(i),s1
end do
148 format(2x,F12.3,2x,F12.3,2x,F12.3)
c--------------------------------------------------------------------------------
END
************************************************************
** Dubovichenko potential with forbiddenstates
function Vdub(r,L,J)
implicit real*8 (a-h,o-z)
common/nucdata/A1,A2,z1,z2
common/constant/H22M,pi,e2
V=0.d0
Vcoul=0.d0