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

          Line data    Source code
       1             :       MODULE m_coredir
       2             :       CONTAINS
       3           0 :       SUBROUTINE coredir(mrad,e,l,xmj,iway,vv,bb,rc,dx,nmatch,nzero,
       4           0 :      +                   gc,fc,pow,qow,piw,qiw)
       5             : 
       6             : c.........................................................coredir
       7             : c   solution of dirac equation for atomic problem
       8             : c   full relativistic spin-polarized case
       9             : c   Ry units: in charge
      10             : c_______________________________________________  a. shick KFA 1996
      11             : 
      12             :       USE m_constants, ONLY : c_light
      13             :       USE m_crtail
      14             :       USE m_kernel1
      15             :       USE m_kernel2
      16             : 
      17             :       IMPLICIT NONE
      18             : c
      19             : C     .. Parameters ..
      20             :       INTEGER, INTENT (IN) :: mrad
      21             : C     ..
      22             : C     .. Scalar Arguments ..
      23             :       REAL dx,e,xmj
      24             :       INTEGER iway,l,nmatch,nzero
      25             : C     ..
      26             : C     .. Array Arguments ..
      27             :       REAL bb(mrad),fc(2,2,mrad),gc(2,2,mrad),piw(2,2),pow(2,2),
      28             :      +     qiw(2,2),qow(2,2),rc(mrad),vv(mrad)
      29             : C     ..
      30             : C     .. Local Scalars ..
      31             :       REAL cc,csq,dx1
      32             :       INTEGER i,ir,irv,j,kap1,kap2,n,nn,nsol,nstart
      33             : C     ..
      34             : C     .. Local Arrays ..
      35           0 :       REAL b(mrad),dp(2,2,mrad),dq(2,2,mrad),ra(mrad),v(mrad),
      36           0 :      +     wp(2,2,mrad),wq(2,2,mrad),xx1(4),xx2(4)
      37             : C     ..
      38             : C     .. External Subroutines ..
      39             :       EXTERNAL inconi,inconz
      40             : C     ..
      41             : C     .. Intrinsic Functions ..
      42             :       INTRINSIC abs
      43             : C     ..
      44           0 :       cc = c_light(2.0)
      45           0 :       csq = cc*cc
      46             : C
      47           0 :       kap1 = -l - 1
      48           0 :       kap2 = +l
      49             : c
      50           0 :       nsol = 2
      51           0 :       IF (abs(xmj).GE.l) nsol = 1
      52             : C
      53           0 :       IF (iway.EQ.2) GO TO 60
      54             : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      55             : C             OUTWARD INTEGRATION
      56             : C
      57           0 :       DO i = 1,2
      58           0 :          DO j = 1,2
      59           0 :             pow(j,i) = 0.0
      60           0 :             qow(j,i) = 0.0
      61             :          END DO
      62             :       END DO
      63             : c     potential redefinition
      64           0 :       DO ir = 1,nmatch
      65           0 :          v(ir) = vv(ir)*rc(ir)*rc(ir)
      66           0 :          b(ir) = bb(ir)*rc(ir)*rc(ir)
      67           0 :          ra(ir) = rc(ir)
      68             :       END DO
      69             : c initial condition
      70           0 :       CALL inconz(e,l,xmj,kap1,kap2,vv(1),bb(1),rc(1),xx1,xx2)
      71             : c dirac equation solution: two cases 1)nsol=2; 2)nsol=1.
      72           0 :       nstart = 1
      73           0 :       IF (nsol.EQ.2) THEN
      74             :          CALL kernel2(mrad,nsol,xmj,kap1,kap2,xx1,xx2,e,v,b,ra,dx,
      75           0 :      +                nmatch,nstart,dp,dq,wp,wq)
      76             :       ELSE
      77             :          CALL kernel1(mrad,xmj,kap1,xx1,e,v,b,ra,dx,nmatch,nstart,dp,
      78           0 :      +                dq,wp,wq)
      79             :       END IF
      80             : C
      81             : C     NOW TRANSFORM TO THE PROPER WAVEFUNCTIONS
      82             : C
      83           0 :       DO 30 n = 1,nmatch
      84           0 :          DO 20 j = 1,nsol
      85           0 :             DO 10 i = 1,nsol
      86           0 :                gc(i,j,n) = wp(i,j,n)/rc(n)
      87           0 :                fc(i,j,n) = wq(i,j,n)/ (rc(n)*cc)
      88           0 :    10       CONTINUE
      89           0 :    20    CONTINUE
      90           0 :    30 CONTINUE
      91             : c
      92           0 :       DO 50 j = 1,nsol
      93           0 :          DO 40 i = 1,nsol
      94           0 :             pow(i,j) = wp(i,j,nmatch)
      95           0 :             qow(i,j) = wq(i,j,nmatch)
      96           0 :    40    CONTINUE
      97           0 :    50 CONTINUE
      98           0 :       RETURN
      99             : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     100             : C             INWARD INTEGRATION
     101             : C
     102             :    60 CONTINUE
     103           0 :       DO i = 1,2
     104           0 :          DO j = 1,2
     105           0 :             piw(j,i) = 0.0
     106           0 :             qiw(j,i) = 0.0
     107             :          END DO
     108             :       END DO
     109             : c initial condition
     110           0 :       CALL inconi(l,xmj,e,csq,rc(nzero),xx1,xx2)
     111             : c     redefinition of order & potential redefinition
     112           0 :       DO ir = nzero,nmatch,-1
     113           0 :          irv = nzero - ir + 1
     114           0 :          v(irv) = vv(ir)*rc(ir)*rc(ir)
     115           0 :          b(irv) = bb(ir)*rc(ir)*rc(ir)
     116           0 :          ra(irv) = rc(ir)
     117             :       END DO
     118           0 :       dx1 = -dx
     119             : c dirac equation solution: two cases 1)nsol=2; 2)nsol=1.
     120           0 :       nstart = 1
     121           0 :       IF (nsol.EQ.2) THEN
     122             :          CALL kernel2(mrad,nsol,xmj,kap1,kap2,xx1,xx2,e,v,b,ra,dx1,
     123           0 :      +                nzero-nmatch+1,nstart,dp,dq,wp,wq)
     124             :       ELSE
     125             :          CALL kernel1(mrad,xmj,kap1,xx1,e,v,b,ra,dx1,nzero-nmatch+1,
     126           0 :      +                nstart,dp,dq,wp,wq)
     127             :       END IF
     128             : C
     129             : C     NOW TRANSFORM TO THE PROPER WAVEFUNCTIONS
     130             : C
     131           0 :       DO 90 nn = 1,nzero - nmatch + 1
     132           0 :          n = nzero - nn + 1
     133           0 :          DO 80 j = 1,nsol
     134           0 :             DO 70 i = 1,nsol
     135           0 :                gc(i,j,n) = wp(i,j,nn)/ra(nn)
     136           0 :                fc(i,j,n) = wq(i,j,nn)/ (ra(nn)*cc)
     137           0 :    70       CONTINUE
     138           0 :    80    CONTINUE
     139           0 :    90 CONTINUE
     140             : 
     141             : c exponential tail
     142             : 
     143             :       CALL crtail(
     144             :      >            mrad,e,rc,nsol,nzero,csq,
     145           0 :      X            gc,fc)
     146             : 
     147           0 :       DO  j = 1,nsol
     148           0 :          DO  i = 1,nsol
     149           0 :             piw(i,j) = wp(i,j,nzero-nmatch+1)
     150           0 :             qiw(i,j) = wq(i,j,nzero-nmatch+1)
     151             :          ENDDO
     152             :       ENDDO
     153             : c
     154             :       END SUBROUTINE coredir
     155             :       END MODULE m_coredir

Generated by: LCOV version 1.13