LCOV - code coverage report
Current view: top level - core - inconz.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 89 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1           0 :       SUBROUTINE inconz(e,l,xmj,kap1,kap2,vv,bb,rr,xx1,xx2)
       2             : 
       3             : c..........................................................inconz
       4             : c initial point for outcome regular solution of dirac eq.
       5             : c order kap1=-L-1, kap2=L
       6             : c
       7             :       USE m_constants, ONLY : c_light
       8             :       IMPLICIT NONE
       9             : C     .. Scalar Arguments ..
      10             :       REAL bb,e,rr,vv,xmj
      11             :       INTEGER kap1,kap2,l
      12             : C     ..
      13             : C     .. Array Arguments ..
      14             :       REAL xx1(4),xx2(4)
      15             : C     ..
      16             : C     .. Local Scalars ..
      17             :       REAL aa11,aa12,aa21,aa22,bb1,bb2,bc0,bqq,cc,cg1,cg2,cg4,cg5,cg8,
      18             :      +     cgo,csq,det,emvpp,emvqq,rpwgpm,tz,vc0
      19             :       INTEGER i,j,m,mps,nsol
      20             : C     ..
      21             : C     .. Local Arrays ..
      22             :       REAL cgd(2),cgmd(2),gam(2),kap(2),pc(2,2,0:1),qc(2,2,0:1),wp(2,2),
      23             :      +     wq(2,2)
      24             : C     ..
      25             : C     .. Intrinsic Functions ..
      26             :       INTRINSIC abs,real,int,sqrt
      27             : C     ..
      28           0 :       cc = c_light(2.0)
      29           0 :       csq = cc*cc
      30             : c
      31             : C     EXPANSION COEFFICIENTS FOR THE POTENTIAL AND B-FIELD
      32             : C VV=VV(1)
      33           0 :       tz = real(int(-vv*rr))
      34           0 :       vc0 = vv - (-tz)/rr
      35             : C BB=BB(1)
      36           0 :       bc0 = bb
      37             : C
      38             : C    CALCULATE G-COEFFICIENTS OF B-FIELD
      39             : C
      40             : c      KAP1 = - L - 1
      41             : c      KAP2 = + L
      42           0 :       cg1 = -xmj/ (kap1+0.5)
      43           0 :       cg5 = -xmj/ (-kap1+0.5)
      44           0 :       cgd(1) = cg1
      45           0 :       cgmd(1) = cg5
      46           0 :       kap(1) = real(kap1)
      47           0 :       gam(1) = sqrt(kap(1)**2- (tz/cc)**2)
      48           0 :       IF (abs(xmj).GE.l) THEN
      49           0 :          cg2 = 0.00
      50           0 :          cg4 = 0.00
      51           0 :          cg8 = 0.00
      52           0 :          nsol = 1
      53           0 :          cgd(2) = 0.00
      54           0 :          cgo = 0.00
      55           0 :          cgmd(2) = 0.00
      56           0 :          gam(2) = 0.00
      57           0 :          kap(2) = 0.00
      58             :       ELSE
      59           0 :          cg2 = -sqrt(1.0- (xmj/ (kap1+0.50))**2)
      60           0 :          cg4 = -xmj/ (kap2+0.50)
      61           0 :          cg8 = -xmj/ (-kap2+0.50)
      62           0 :          nsol = 2
      63           0 :          cgd(2) = cg4
      64           0 :          cgo = cg2
      65           0 :          cgmd(2) = cg8
      66           0 :          kap(2) = real(kap2)
      67           0 :          gam(2) = sqrt(kap(2)**2- (tz/cc)**2)
      68             :       END IF
      69             : C
      70           0 :       DO 10 j = 1,nsol
      71           0 :          i = 3 - j
      72           0 :          pc(j,j,0) = sqrt(abs(kap(j)-gam(j)))
      73           0 :          qc(j,j,0) = (kap(j)+gam(j))* (csq/tz)*pc(j,j,0)
      74           0 :          pc(i,j,0) = 0.0
      75           0 :          qc(i,j,0) = 0.0
      76           0 :    10 CONTINUE
      77             : C  DETERMINE HIGHER EXPANSION COEFFICIENTS FOR THE WAVE FUNCTIONS
      78           0 :       mps = 1
      79           0 :       aa12 = -tz/csq
      80           0 :       aa21 = tz
      81           0 :       emvqq = (e-vc0+csq)/csq
      82           0 :       emvpp = -e + vc0
      83           0 :       bqq = bc0/csq
      84           0 :       DO 40 j = 1,nsol
      85           0 :          DO 30 m = 1,mps
      86           0 :             DO 20 i = 1,nsol
      87           0 :                bb1 = (emvqq+bqq*cgmd(i))*qc(i,j,m-1)
      88             :                bb2 = (emvpp+bc0*cgd(i))*pc(i,j,m-1) +
      89           0 :      +               bc0*cgo*pc(3-i,j,m-1)
      90           0 :                aa11 = gam(j) + m + kap(i)
      91           0 :                aa22 = gam(j) + m - kap(i)
      92           0 :                det = aa11*aa22 - aa12*aa21
      93           0 :                pc(i,j,m) = (bb1*aa22-aa12*bb2)/det
      94           0 :                qc(i,j,m) = (aa11*bb2-bb1*aa21)/det
      95           0 :    20       CONTINUE
      96           0 :    30    CONTINUE
      97           0 :    40 CONTINUE
      98             : C
      99             : C  PERFORM SUMMATION OVER WAVE FUNCTION - EXPANSION COEFFICIENTS
     100             : C  FOR THE FIRST - MESH - POINT
     101             : c      RR= RC(1)
     102           0 :       DO 80 j = 1,nsol
     103           0 :          rpwgpm = rr** (gam(j))
     104           0 :          DO 50 i = 1,nsol
     105           0 :             wp(i,j) = pc(i,j,0)*rpwgpm
     106           0 :             wq(i,j) = qc(i,j,0)*rpwgpm
     107           0 :    50    CONTINUE
     108           0 :          DO 70 m = 1,mps
     109           0 :             rpwgpm = rpwgpm*rr
     110           0 :             DO 60 i = 1,nsol
     111           0 :                wp(i,j) = wp(i,j) + pc(i,j,m)*rpwgpm
     112           0 :                wq(i,j) = wq(i,j) + qc(i,j,m)*rpwgpm
     113           0 :    60       CONTINUE
     114           0 :    70    CONTINUE
     115           0 :    80 CONTINUE
     116             : C---> First point solutions construction
     117           0 :       IF (nsol.EQ.2) THEN
     118           0 :          xx1(1) = wp(1,1)
     119           0 :          xx1(2) = wq(1,1)
     120           0 :          xx1(3) = wp(2,1)
     121           0 :          xx1(4) = wq(2,1)
     122             : c
     123           0 :          xx2(1) = wp(1,2)
     124           0 :          xx2(2) = wq(1,2)
     125           0 :          xx2(3) = wp(2,2)
     126           0 :          xx2(4) = wq(2,2)
     127             :       ELSE
     128           0 :          xx1(1) = wp(1,1)
     129           0 :          xx1(2) = wq(1,1)
     130             : c not needed
     131           0 :          xx1(3) = 0.0
     132           0 :          xx1(4) = 0.0
     133           0 :          xx2(1) = 0.0
     134           0 :          xx2(2) = 0.0
     135           0 :          xx2(3) = 0.0
     136           0 :          xx2(4) = 0.0
     137             :       END IF
     138           0 :       RETURN
     139             :       END

Generated by: LCOV version 1.13