Subroutine field
!---------------------------------------------------------------------
! calculates fields in r-space form axially symmetric densities
!=====================================================================
Use definitions
Implicit None
Integer(4) :: it,ita,ihli
Real(dnik) :: ra,ra2,rs,rs2,rsa,rsa0,rsa0m,x,v0v1,cx,TMPN,TMPP
If(itime.gt.0) CALL CPU_TIME (time1)
!
! constraint constants
cx=zero
If (icstr.Ne.0) Then
cx = abs(icstr)*cqad*(cdef-tdef)*ty20
If(lpriter) Write(6,'(40x,a,f7.3,a,f8.3,f8.3)') &
' Requested cdef=',cdef,' Q[b] =',q2(3)/100.0d0
End If
!
! tensor fields
If(KOP3.Ne.0) Then
Do ihli = 1,nghl
TMPN=SFIZ(ihli,1); TMPP=SFIZ(ihli,2); SFIZ(ihli,1)=TB7*TMPN+TB8*TMPP; SFIZ(ihli,2)=TB7*TMPP+TB8*TMPN
TMPN=SZFI(ihli,1); TMPP=SZFI(ihli,2); SZFI(ihli,1)=TB7*TMPN+TB8*TMPP; SZFI(ihli,2)=TB7*TMPP+TB8*TMPN
TMPN=SFIR(ihli,1); TMPP=SFIR(ihli,2); SFIR(ihli,1)=TB7*TMPN+TB8*TMPP; SFIR(ihli,2)=TB7*TMPP+TB8*TMPN
TMPN=SRFI(ihli,1); TMPP=SRFI(ihli,2); SRFI(ihli,1)=TB7*TMPN+TB8*TMPP; SRFI(ihli,2)=TB7*TMPP+TB8*TMPN
End Do
End If
!
! fields
Do it = 1,2
ita = 3-it
Do ihli = 1,nghl
rs=ro(ihli,it); ra=ro(ihli,ita); ra2=ra*ra; rs2=rs*rs; rsa=rs+ra;
rsa0=(rsa/rho0)**dalf; rsa0m=rsa0/rsa; v0v1= v0*(one-v1*rsa0)
x = t0s*rs + t0a*ra + t3alp*rsa**alp - t3al0*rsa**alph*rs & ! density dependence
- t3alm*rsa**alm*(ra2+rs2)
x = x + drs*dro(ihli,it) + dra*dro(ihli,ita) ! dro dependence
x = x - wls*dj(ihli,it) - wla*dj(ihli,ita) ! s.o. dependence
!wla:W0/2,wls:W0
x = x + ts*tau(ihli,it) + ta*tau(ihli,ita) ! tau dependence
x = x - v01a*rsa0m*(aka(ihli,it)**2 + aka(ihli,ita)**2) ! from pairing density dependence
if(it.eq.2) then
If(icou.Ge.1) x = x + cou(ihli) ! direct coulomb
If(icou.Eq.2) x = x + coex*rs**third ! exchange coulomb
endif
x = x - cx*(two*fh(ihli)**2-fl(ihli)**2) ! constraining potential
!
v(ihli,it)=x; hb(ihli,it)=hb0+ts*rs+ta*ra; vs(ihli,it)=wls*rs+wla*ra;
dv(ihli,it)=v0v1*aka(ihli,it)
!
End Do !ihli
End Do !it
!
If(itime.gt.0) then
CALL CPU_TIME (time2)
write(*,*) ' Time in field:',time2-time1,' seconds'
End If
Return
End Subroutine field