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

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_etabinit
       8             :   USE m_juDFT
       9             :   !     *******************************************************
      10             :   !     *****   set up etab via old core program          *****
      11             :   !     *******************************************************
      12             :   !     modified to run with core-levels as provided by setcor
      13             :   !     ntab & ltab transport this info to core.F        gb`02
      14             :   !------------------------------------------------------------
      15             : CONTAINS
      16           0 :   SUBROUTINE etabinit(atoms,DIMENSION,input, vr,&
      17           0 :        etab,ntab,ltab,nkmust)
      18             : 
      19             :     USE m_constants, ONLY : c_light
      20             :     USE m_setcor
      21             :     USE m_differ
      22             :     USE m_types
      23             :     IMPLICIT NONE
      24             :     TYPE(t_dimension),INTENT(IN)   :: DIMENSION
      25             :     TYPE(t_atoms),INTENT(IN)       :: atoms
      26             :     TYPE(t_input),INTENT(IN)       :: input
      27             :     !
      28             :     !     .. Scalar Arguments ..
      29             :     !     ..
      30             :     !     .. Array Arguments ..
      31             :     REAL   , INTENT (IN) :: vr(atoms%jmtd,atoms%ntype) 
      32             :     REAL   , INTENT (OUT):: etab(100,atoms%ntype)
      33             :     INTEGER, INTENT (OUT):: ntab(100,atoms%ntype),ltab(100,atoms%ntype)
      34             :     INTEGER, INTENT (OUT):: nkmust(atoms%ntype)
      35             :     !     ..
      36             :     !     .. Local Scalars ..
      37             :     REAL  c,d,dxx,e,fj,fl,fn,rn,rnot,t2 ,z,t1,rr,weight
      38             :     REAL  bmu
      39             :     INTEGER i,ic,iksh,ilshell,j,jatom,korb,l, nst,ncmsh ,nshell,ipos,ierr
      40             :     !     ..
      41             :     !     .. Local Arrays ..
      42           0 :     INTEGER kappa(DIMENSION%nstd),nprnc(DIMENSION%nstd)
      43           0 :     REAL eig(DIMENSION%nstd),occ(DIMENSION%nstd,1),vrd(DIMENSION%msh),a(DIMENSION%msh),b(DIMENSION%msh)
      44             :     !     ..
      45             :     !
      46           0 :     c = c_light(1.0)
      47             :     !
      48           0 :     WRITE (6,FMT=8020)
      49             :     !
      50           0 :     ncmsh = DIMENSION%msh
      51             :     !     ---> set up densities
      52           0 :     DO  jatom = 1,atoms%ntype
      53           0 :        z = atoms%zatom(jatom)
      54           0 :        rn = atoms%rmt(jatom)
      55           0 :        dxx = atoms%dx(jatom)
      56           0 :        bmu = 0.0
      57           0 :        CALL setcor(jatom,1,atoms,input,bmu,nst,kappa,nprnc,occ)
      58           0 :        rnot = atoms%rmsh(1,jatom)
      59           0 :        d = EXP(atoms%dx(jatom))
      60           0 :        rn = rnot* (d** (ncmsh-1))
      61           0 :        WRITE (6,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
      62           0 :        DO j = 1,atoms%jri(jatom)
      63           0 :           vrd(j) = vr(j,jatom)
      64             :        ENDDO
      65           0 :        IF (input%l_core_confpot) THEN
      66             :           !--->    linear extension of the potential with slope t1 / a.u.
      67           0 :           t1=0.125
      68           0 :           t2  = vrd(atoms%jri(jatom))/atoms%rmt(jatom)-atoms%rmt(jatom)*t1
      69           0 :           rr = atoms%rmt(jatom)
      70           0 :           d = EXP(atoms%dx(jatom))
      71             :        ELSE
      72           0 :           t2 = vrd(atoms%jri(jatom))/ (atoms%jri(jatom)-DIMENSION%msh)
      73             :        ENDIF
      74           0 :        IF (atoms%jri(jatom).LT.DIMENSION%msh) THEN
      75           0 :           DO i = atoms%jri(jatom) + 1,DIMENSION%msh
      76           0 :              if (input%l_core_confpot) THEN
      77           0 :                 rr = d*rr
      78           0 :                 vrd(i) = rr*( t2 + rr*t1 )
      79             :              ELSE
      80             :                 
      81           0 :                 vrd(i) = vrd(atoms%jri(jatom)) + t2* (i-atoms%jri(jatom))
      82             :              ENDIF
      83             :           ENDDO
      84             :        END IF
      85             : 
      86           0 :        nst = atoms%ncst(jatom)
      87           0 :        DO  korb = 1,nst
      88           0 :           fn = nprnc(korb)
      89           0 :           fj = iabs(kappa(korb)) - .5e0
      90           0 :           weight = 2*fj + 1.e0
      91           0 :           fl = fj + (.5e0)*isign(1,kappa(korb))
      92           0 :           e = -2* (z/ (fn+fl))**2
      93             :           CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,DIMENSION%msh,vrd,&
      94           0 :                e, a,b,ierr)
      95           0 :           IF (ierr/=0)  CALL juDFT_error("error in core-levels",calledby="etabinit")
      96           0 :           WRITE (6,FMT=8010) fn,fl,fj,e,weight
      97           0 :           eig(korb) = e
      98             :        ENDDO
      99             :        ic = 0
     100           0 :        DO korb = 1,nst
     101           0 :           fn = nprnc(korb)
     102           0 :           fj = iabs(kappa(korb)) - .5e0
     103           0 :           weight = 2*fj + 1.e0
     104           0 :           fl = fj + (.5e0)*isign(1,kappa(korb))
     105           0 :           DO i = 1, INT(weight)
     106           0 :              ic = ic + 1
     107           0 :              IF (kappa(korb).GT.0) THEN
     108           0 :                 ipos = ic + 1 + i 
     109           0 :              ELSEIF (kappa(korb).LT.-1) THEN
     110           0 :                 ipos = ic - 2*(iabs(kappa(korb))-1) + MAX(i-2,0)
     111             :              ELSE
     112             :                 ipos = ic
     113             :              ENDIF
     114           0 :              etab(ipos,jatom) = eig(korb)
     115           0 :              ntab(ipos,jatom) = NINT(fn)
     116           0 :              ltab(ipos,jatom) = NINT(fl)
     117             :           ENDDO
     118             :        ENDDO
     119           0 :        nkmust(jatom) = ic
     120             : 
     121           0 :        DO i=1,nkmust(jatom)
     122           0 :           WRITE(6,'(f12.6,2i3)') etab(i,jatom),ntab(i,jatom), ltab(i,jatom)
     123             :        ENDDO
     124             : 
     125             :     ENDDO
     126             : 8000 FORMAT (/,/,10x,'z=',f4.0,5x,'r(1)=',e14.6,5x,'dx=',f8.6,5x,&
     127             :                 'm.t.index=',i4,/,15x,'n',4x,'l',5x,'j',4x,'energy',7x, 'weight')
     128             : 8010 FORMAT (12x,2f5.0,f6.1,f10.4,f12.4)
     129             : 8020 FORMAT (/,/,12x,'core e.v. initialization')
     130             : 
     131           0 :   END SUBROUTINE etabinit
     132             : END MODULE m_etabinit

Generated by: LCOV version 1.13