LCOV - code coverage report
Current view: top level - orbdep - mcd_init.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 69 69 100.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             : MODULE m_mcdinit
       2             : CONTAINS
       3           8 :   SUBROUTINE mcd_init(atoms,input,DIMENSION,vr,g,f,mcd,itype,jspin)
       4             : 
       5             :     !-----------------------------------------------------------------------
       6             :     !
       7             :     ! For a given atom-type 'itype' look, whether a core state is in the
       8             :     ! energy interval [emcd_lo,emcd_up] and, if found, calculate the 
       9             :     ! MCD-matrix elements 'm_mcd'.
      10             :     !          
      11             :     !-----------------------------------------------------------------------
      12             : 
      13             :     USE m_nabla
      14             :     USE m_dr2fdr
      15             :     USE m_constants, ONLY : c_light
      16             :     USE m_setcor
      17             :     USE m_differ
      18             :     USE m_types
      19             :     IMPLICIT NONE
      20             : 
      21             :     TYPE(t_dimension),INTENT(IN) :: DIMENSION
      22             :     TYPE(t_input),INTENT(IN)     :: input
      23             :     TYPE(t_atoms),INTENT(IN)     :: atoms
      24             :     TYPE(t_mcd),INTENT(INOUT)    :: mcd
      25             : 
      26             :     INTEGER, PARAMETER :: l_max = 3
      27             : 
      28             :     ! Arguments ...
      29             : 
      30             :     INTEGER, INTENT (IN)  :: itype
      31             :     INTEGER, INTENT (IN)  :: jspin
      32             :     REAL,    INTENT (IN)  :: vr(atoms%jmtd,atoms%ntype,input%jspins)
      33             :     REAL,    INTENT (IN)  :: f(atoms%jmtd,2,0:atoms%lmaxd,jspin:jspin)
      34             :     REAL,    INTENT (IN)  :: g(atoms%jmtd,2,0:atoms%lmaxd,jspin:jspin)
      35             : 
      36             :     ! Locals ...
      37             : 
      38             :     INTEGER kap,mue,iri,l,ispin,i,icore,korb,nst,n_core,ierr
      39             :     REAL  c,t2,e,fj,fl,fn ,d,ms,rn ,bmu
      40          16 :     INTEGER kappa(DIMENSION%nstd),nprnc(DIMENSION%nstd),l_core(DIMENSION%nstd)
      41          56 :     REAL vrd(DIMENSION%msh),occ(DIMENSION%nstd,1),a(DIMENSION%msh),b(DIMENSION%msh),j_core(DIMENSION%nstd),e_mcd1(DIMENSION%nstd)
      42          16 :     REAL gv1(atoms%jmtd)
      43          16 :     REAL, ALLOCATABLE :: gc(:,:,:),fc(:,:,:)
      44          24 :     REAL, ALLOCATABLE :: gv(:,:,:,:),fv(:,:,:,:),dgv(:,:,:,:)
      45             : 
      46             :     !-----------------------------------------------------------------------
      47             : 
      48           8 :     c = c_light(1.0)
      49           8 :     ALLOCATE ( gc(atoms%jri(itype),atoms%ncst(itype),input%jspins) )
      50           8 :     ALLOCATE ( fc(atoms%jri(itype),atoms%ncst(itype),input%jspins) )
      51             : 
      52             :     ! core setup
      53             : 
      54           8 :     mcd%ncore(itype) = 0
      55           8 :     bmu = 0.0
      56           8 :     CALL setcor(itype,1,atoms,input,bmu, nst,kappa,nprnc,occ)
      57             : 
      58          16 :     DO ispin = jspin, jspin
      59             : 
      60             :        ! extend core potential
      61             : 
      62        6048 :        DO iri = 1, atoms%jri(itype)
      63        6048 :           vrd(iri) = vr(iri,itype,ispin)
      64             :        ENDDO
      65           8 :        t2 = vrd(atoms%jri(itype)) / (atoms%jri(itype) - DIMENSION%msh)
      66        1152 :        DO iri = atoms%jri(itype) + 1, DIMENSION%msh
      67        1152 :           vrd(iri) =  vrd(atoms%jri(itype))  + t2* ( iri-atoms%jri(itype) )
      68             :        ENDDO
      69             : 
      70             :        ! calculate core
      71             : 
      72           8 :        n_core = 0
      73          72 :        DO korb = 1, atoms%ncst(itype)
      74          64 :           IF (occ(korb,1).GT.0) THEN
      75          56 :              fn = nprnc(korb)
      76          56 :              fj = iabs(kappa(korb)) - .5e0
      77          56 :              fl = fj + (.5e0)*isign(1,kappa(korb))
      78          56 :              e = -2* (atoms%zatom(itype)/ (fn+fl))**2
      79          56 :              d = EXP(atoms%dx(itype))
      80          56 :              rn = atoms%rmsh(1,itype)*( d**(DIMENSION%msh-1) )
      81             :              CALL differ(fn,fl,fj,c,atoms%zatom(itype),atoms%dx(itype),atoms%rmsh(1,itype),&
      82          56 :                   rn,d,DIMENSION%msh,vrd, e, a,b,ierr)
      83          56 :              IF (ierr/=0)  CALL juDFT_error("error in core-levels", calledby="mcd_init")
      84          56 :              IF ( (e.LE.mcd%emcd_up).AND.(e.GE.mcd%emcd_lo) ) THEN
      85          24 :                 WRITE(*,*) 'good    ev = ',e
      86          24 :                 n_core = n_core + 1
      87          24 :                 j_core(n_core) = fj
      88          24 :                 l_core(n_core) = NINT( fl )
      89          24 :                 e_mcd1(n_core) = e
      90       18144 :                 DO iri = 1, atoms%jri(itype)
      91       18120 :                    gc(iri,n_core,ispin) = a(iri)
      92       18144 :                    fc(iri,n_core,ispin) = b(iri)
      93             :                 ENDDO
      94             :              ENDIF
      95             :           ENDIF
      96             :        ENDDO
      97             : 
      98             :     ENDDO
      99             : 
     100             :     !-----------------------------------------------------------------------
     101             : 
     102           8 :     IF (n_core.GT.0) THEN
     103             : 
     104           8 :        ALLOCATE ( gv(atoms%jri(itype),0:l_max,input%jspins,2) )
     105           8 :        ALLOCATE (dgv(atoms%jri(itype),0:l_max,input%jspins,2) )
     106           8 :        ALLOCATE ( fv(atoms%jri(itype),0:l_max,input%jspins,2) )
     107          40 :        DO i = 1, 2
     108          72 :           DO iri = 3*(itype-1)+1 , 3*(itype-1)+3
     109        1600 :              DO l = 1, (l_max+1)**2
     110       23088 :                 DO icore = 1, DIMENSION%nstd
     111       23040 :                    mcd%m_mcd(icore,l,iri,i) = CMPLX(0.0,0.0)
     112             :                 ENDDO
     113             :              ENDDO
     114             :           ENDDO
     115             :        ENDDO
     116             :        !
     117             :        ! bring LAPW wavefunctions in a proper form:
     118             :        !
     119          24 :        DO ispin = jspin, jspin
     120           8 :           ms = ispin - 1.5
     121          40 :           DO l = 0, l_max
     122       24192 :              DO iri = 1, atoms%jri(itype)
     123       24160 :                 gv(iri,l,ispin,1) = f(iri,1,l,ispin)   ! large component of u
     124       24160 :                 fv(iri,l,ispin,1) = f(iri,2,l,ispin)   ! small              .
     125       24160 :                 gv(iri,l,ispin,2) = g(iri,1,l,ispin)   ! large component of u
     126       24192 :                 fv(iri,l,ispin,2) = g(iri,2,l,ispin)   ! small
     127             :              ENDDO
     128          32 :              gv1(:) = atoms%rmsh(:,itype) * gv(:,l,ispin,1)
     129             :              CALL dr2fdr(&                                          ! deriative of u (large)&
     130          32 :                   gv1,atoms%rmsh(1,itype),atoms%jri(itype), dgv(1,l,ispin,1) )
     131          32 :              gv1(:) = atoms%rmsh(:,itype) * gv(:,l,ispin,2)              !              .
     132             :              CALL dr2fdr(&                                          ! deriative of u (large)&
     133          40 :                   gv1,atoms%rmsh(1,itype),atoms%jri(itype), dgv(1,l,ispin,2) )
     134             :           ENDDO
     135             :           !
     136             :           !
     137             :           !
     138          40 :           DO icore = 1, n_core
     139             : 
     140         120 :              DO i = 1, 2
     141             :                 !              write(*,*) j_core(icore),l_core(icore),l_max,ms
     142             :                 CALL nabla(itype,icore,atoms%jri(itype),atoms%dx(itype),DIMENSION%nstd,atoms%ntype,&
     143             :                      j_core(icore),l_core(icore),l_max,ms,atoms%rmsh(:,itype),gc(:,icore,ispin),&
     144          72 :                      gv(:,0:,ispin,i),dgv(:,0:,ispin,i), mcd%m_mcd(:,:,:,i) )
     145             :              ENDDO
     146             : 
     147         112 :              DO i = 1, 2*icore*l_core(icore)
     148          80 :                 mcd%ncore(itype) = mcd%ncore(itype) + 1
     149          80 :                 IF (mcd%ncore(itype)>DIMENSION%nstd)  CALL juDFT_error("dimension%nstd too small" ,calledby ="mcd_init")
     150         104 :                 mcd%e_mcd(itype,ispin,mcd%ncore(itype)) = e_mcd1(icore)
     151             :              ENDDO
     152             :           ENDDO
     153             :        ENDDO
     154             : 
     155           8 :        DEALLOCATE (gv,fv,dgv)
     156             :     ENDIF
     157           8 :     DEALLOCATE (gc,fc)
     158             : 
     159             : 
     160             :     !      DO i = 1, 2
     161             :     !       DO iri = 3*(itype-1)+1 , 3*(itype-1)+3
     162             :     !         write (*,*) iri
     163             :     !         DO icore = 1, mcd%ncore(itype)
     164             :     !           write (*,'(10f10.5)') (mcd%m_mcd(icore,l,iri,i),l=1,9)
     165             :     !         ENDDO
     166             :     !       ENDDO
     167             :     !      ENDDO
     168           8 :   END SUBROUTINE mcd_init
     169             : END MODULE m_mcdinit

Generated by: LCOV version 1.13