Line data    Source code

       1             : MODULE m_BfieldtoVmat
       2             :    USE m_types
       3             :    USE m_constants
       4             : 
       5             :    IMPLICIT NONE
       6             : 
       7             : CONTAINS
       8             : 
       9           2 :    SUBROUTINE BfieldtoVmat(sym, stars, atoms, sphhar, vacuum, &
      10             :                           vScal, bx, by, bz, vMat)
      11             :       USE m_fft3d
      12             : 
      13             :       TYPE(t_sym),      INTENT(IN)  :: sym
      14             :       TYPE(t_stars),    INTENT(IN)  :: stars
      15             :       TYPE(t_atoms),    INTENT(IN)  :: atoms
      16             :       TYPE(t_sphhar),   INTENT(IN)  :: sphhar
      17             :       TYPE(t_vacuum),   INTENT(IN)  :: vacuum
      18             :       TYPE(t_potden),   INTENT(IN)  :: vScal, bx, by, bz
      19             :       TYPE(t_potden),   INTENT(OUT) :: vMat
      20             : 
      21             :       ! Local scalars: iteration indices, matrix elements etc.
      22             :       INTEGER iden, ifft3, ityp, iri, ilh, imesh
      23             :       REAL zero, rho_11, rho_22, rerho_21, imrho_21, cdn11, cdn22, recdn21, imcdn21
      24             :       COMPLEX czero
      25             : 
      26             :       ! Local arrays: densities in real space and off-diagonal elements.
      27           2 :       REAL,    ALLOCATABLE        :: ris(:,:), ris2(:,:), fftwork(:)
      28           2 :       REAL,    ALLOCATABLE        :: rho(:,:,:,:)
      29           2 :       COMPLEX, ALLOCATABLE        :: qpw(:,:), qpww(:,:)
      30             : 
      31           2 :       zero  = 0.0; czero = CMPLX(0.0,0.0)
      32           2 :       ifft3 = 27*stars%mx1*stars%mx2*stars%mx3
      33             : 
      34             :       ! Allocation of arrays and initialization of those that make up the real
      35             :       ! space density matrix.
      36             :       ALLOCATE (rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,4), qpw(stars%ng3,4), &
      37             :                 qpww(stars%ng3,4), fftwork(0:27*stars%mx1*stars%mx2*stars%mx3-1), &
      38          30 :                 ris(0:27*stars%mx1*stars%mx2*stars%mx3-1,4), ris2(0:27*stars%mx1*stars%mx2*stars%mx3-1,4))
      39             : 
      40     1006972 :       rho(:,:,:,:) = zero; qpw(:,:) = czero
      41             : 
      42      245598 :       rho(:,0:,:,1) = vScal%mt(:,0:,:,1)
      43      245598 :       rho(:,0:,:,2) = bx%mt(:,0:,:,1)
      44      245598 :       rho(:,0:,:,3) = by%mt(:,0:,:,1)
      45      245598 :       rho(:,0:,:,4) = bz%mt(:,0:,:,1)
      46        6144 :       qpw(1:,1)     = vScal%pw(1:,1)
      47        6144 :       qpw(1:,2)     = bx%pw(1:,1)
      48        6144 :       qpw(1:,3)     = by%pw(1:,1)
      49        6144 :       qpw(1:,4)     = bz%pw(1:,1)
      50        6144 :       qpww(1:,1)    = vScal%pw_w(1:,1)
      51        6144 :       qpww(1:,2)    = bx%pw_w(1:,1)
      52        6144 :       qpww(1:,3)    = by%pw_w(1:,1)
      53        6144 :       qpww(1:,4)    = bz%pw_w(1:,1)
      54             : 
      55             :       ! Calculate the charge and magnetization densities in the muffin tins.
      56             : 
      57           6 :       DO ityp = 1,atoms%ntype
      58         330 :          DO ilh = 0,sphhar%nlh(sym%ntypsy(atoms%firstAtom(ityp)))
      59      245596 :             DO iri = 1,atoms%jri(ityp)
      60      245268 :                cdn11 = rho(iri,ilh,ityp,1)+rho(iri,ilh,ityp,4)
      61      245268 :                cdn22 = rho(iri,ilh,ityp,1)-rho(iri,ilh,ityp,4)
      62      245268 :                recdn21 = rho(iri,ilh,ityp,2)
      63      245268 :                imcdn21 = rho(iri,ilh,ityp,3)
      64             : 
      65      245268 :                rho(iri,ilh,ityp,1) = cdn11
      66      245268 :                rho(iri,ilh,ityp,2) = cdn22
      67      245268 :                rho(iri,ilh,ityp,3) = recdn21
      68      245592 :                rho(iri,ilh,ityp,4) = imcdn21
      69             :             END DO
      70             :          END DO
      71             :       END DO
      72             : 
      73             :       ! Fourier transform the diagonal part of the density matrix in the
      74             :       ! interstitial (qpw) to real space (ris).
      75          10 :       DO iden = 1,4
      76           8 :          CALL fft3d(ris(0:,iden),fftwork,qpw(1,iden),stars,1)
      77          10 :          CALL fft3d(ris2(0:,iden),fftwork,qpww(1,iden),stars,1)
      78             :       END DO
      79             : 
      80       54002 :       DO imesh = 0,ifft3-1
      81       54000 :          rho_11  = ris(imesh,1)+ris(imesh,4)
      82       54000 :          rho_22  = ris(imesh,1)-ris(imesh,4)
      83       54000 :          rerho_21  = ris(imesh,2)
      84       54000 :          imrho_21  = ris(imesh,3)
      85             : 
      86       54000 :          ris(imesh,1) = rho_11
      87       54000 :          ris(imesh,2) = rho_22
      88       54000 :          ris(imesh,3) = rerho_21
      89       54000 :          ris(imesh,4) = imrho_21
      90             : 
      91       54000 :          rho_11  = ris2(imesh,1)+ris2(imesh,4)
      92       54000 :          rho_22  = ris2(imesh,1)-ris2(imesh,4)
      93       54000 :          rerho_21  = ris2(imesh,2)
      94       54000 :          imrho_21  = ris2(imesh,3)
      95             : 
      96       54000 :          ris2(imesh,1) = rho_11
      97       54000 :          ris2(imesh,2) = rho_22
      98       54000 :          ris2(imesh,3) = rerho_21
      99       54002 :          ris2(imesh,4) = imrho_21
     100             :       END DO
     101             : 
     102           6 :       DO iden = 1,2
     103      108004 :          fftwork=zero
     104           4 :          CALL fft3d(ris(0:,iden),fftwork,qpw(1,iden),stars,-1)
     105      108004 :          fftwork=zero
     106           6 :          CALL fft3d(ris2(0:,iden),fftwork,qpww(1,iden),stars,-1)
     107             :       END DO
     108             : 
     109           2 :       CALL fft3d(ris(0:,3),ris(0:,4),qpw(1,3),stars,-1)
     110           2 :       CALL fft3d(ris2(0:,3),ris2(0:,4),qpww(1,3),stars,-1)
     111             : 
     112             :       CALL vMat%init_potden_simple(stars%ng3,atoms%jmtd,atoms%msh,sphhar%nlhd,&
     113             :                                       atoms%ntype,atoms%n_u,atoms%n_vPairs,2,.TRUE.,.TRUE.,&
     114             :                                       POTDEN_TYPE_POTTOT,vacuum%nmzd,&
     115           2 :                                       vacuum%nmzxyd,stars%ng2)
     116             :                                      
     117           8 :       ALLOCATE (vMat%pw_w, mold=vMat%pw)
     118      982394 :       vMat%mt(:,0:,1:,1:4) = rho(:,0:,1:,1:4)
     119       18434 :       vMat%pw(1:,1:3) = qpw(1:,1:3)
     120       18434 :       vMat%pw_w(1:,1:3) = qpww(1:,1:3)
     121             : 
     122           2 :       DEALLOCATE (rho, qpw, qpww, fftwork, ris, ris2)
     123             : 
     124           2 :    END SUBROUTINE BfieldtoVmat
     125             : 
     126             : END MODULE m_BfieldtoVmat