LCOV - code coverage report
Current view: top level - hybrid - gen_wavf.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 111 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             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       8             : !     This module generates the cmt coefficients and eigenvectors z   !
       9             : !     at all kpoints nkpt from the irreducible kpoints nkpti          !
      10             : !     and writes them out in cmt and z, respectively.                 !
      11             : !                                                 M.Betzinger(09/07)  !
      12             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      13             : 
      14             : MODULE m_gen_wavf
      15             : 
      16             : CONTAINS
      17             : 
      18           0 :    SUBROUTINE gen_wavf(nkpti, kpts, it, sym, atoms, el_eig, ello_eig, cell, dimension, hybrid, vr0, &
      19           0 :                        hybdat, noco, oneD, mpi, input, jsp, zmat)
      20             : 
      21             :       ! nkpti      ::     number of irreducible k-points
      22             :       ! nkpt       ::     number of all k-points
      23             : 
      24             :       USE m_radfun
      25             :       USE m_radflo
      26             :       USE m_abcof
      27             :       USE m_trafo, ONLY: waveftrafo_genwavf
      28             :       USE m_util, ONLY: modulo1
      29             :       USE m_olap
      30             :       USE m_types
      31             :       USE m_hyb_abcrot
      32             :       USE m_io_hybrid
      33             : 
      34             :       IMPLICIT NONE
      35             : 
      36             :       TYPE(t_hybdat), INTENT(INOUT) :: hybdat
      37             :       TYPE(t_mpi), INTENT(IN)    :: mpi
      38             :       TYPE(t_dimension), INTENT(IN)    :: dimension
      39             :       TYPE(t_oneD), INTENT(IN)    :: oneD
      40             :       TYPE(t_hybrid), INTENT(IN)    :: hybrid
      41             :       TYPE(t_input), INTENT(IN)    :: input
      42             :       TYPE(t_noco), INTENT(IN)    :: noco
      43             :       TYPE(t_sym), INTENT(IN)    :: sym
      44             :       TYPE(t_cell), INTENT(IN)    :: cell
      45             :       TYPE(t_kpts), INTENT(IN)    :: kpts
      46             :       TYPE(t_atoms), INTENT(IN)    :: atoms
      47             :       TYPE(t_mat), INTENT(IN)    :: zmat(:) !for all kpoints
      48             : 
      49             :       INTEGER, INTENT(IN)    :: nkpti, it
      50             :       INTEGER, INTENT(IN)    :: jsp
      51             : 
      52             :       REAL, INTENT(IN)    :: vr0(:, :, :)!(jmtd,ntype,jspd)
      53             :       REAL, INTENT(IN)    :: el_eig(0:atoms%lmaxd, atoms%ntype)
      54             :       REAL, INTENT(IN)    :: ello_eig(atoms%nlod, atoms%ntype)
      55             : 
      56             :       ! local scalars
      57             :       INTEGER                 :: ilo, idum, m, irecl_cmt, irecl_z
      58             :       COMPLEX                 :: cdum
      59           0 :       TYPE(t_mat)             :: zhlp
      60             :       INTEGER                 :: ikpt0, ikpt, itype, iop, ispin, ieq, indx, iatom
      61             :       INTEGER                 :: i, j, l, ll, lm, ng, ok
      62             :       COMPLEX                 :: img = (0.0, 1.0)
      63             : 
      64             :       INTEGER                 :: nodem, noded
      65             :       REAL                    :: wronk
      66             : 
      67             :       INTEGER                 :: lower, upper
      68             :       LOGICAL                 :: found
      69             : 
      70             :       ! local arrays
      71           0 :       INTEGER                 :: rrot(3, 3, sym%nsym)
      72           0 :       INTEGER                 :: map_lo(atoms%nlod)
      73           0 :       INTEGER                 :: iarr(0:atoms%lmaxd, atoms%ntype)
      74           0 :       COMPLEX, ALLOCATABLE     :: acof(:, :, :), bcof(:, :, :), ccof(:, :, :, :)
      75             : 
      76           0 :       COMPLEX, ALLOCATABLE     :: cmt(:, :, :), cmthlp(:, :, :)
      77             : 
      78           0 :       REAL                    :: vr(atoms%jmtd, atoms%ntype, input%jspins)
      79           0 :       REAL, ALLOCATABLE        :: f(:, :, :), df(:, :, :)
      80             : 
      81           0 :       REAL                    :: flo(atoms%jmtd, 2, atoms%nlod)
      82           0 :       REAL                    :: uuilon(atoms%nlod, atoms%ntype), duilon(atoms%nlod, atoms%ntype)
      83           0 :       REAL                    :: ulouilopn(atoms%nlod, atoms%nlod, atoms%ntype)
      84             : 
      85             :       REAL                    :: bkpt(3)
      86             : 
      87             : !     local arrays for abcof1
      88             : !      COMPLEX                 ::  a(nvd,0:lmd,natd,nkpti),b(nvd,0:lmd,natd,nkpti)
      89             : 
      90           0 :       TYPE(t_lapw)  :: lapw(kpts%nkptf)
      91           0 :       TYPE(t_usdus) :: usdus
      92             : 
      93           0 :       CALL usdus%init(atoms, input%jspins)
      94           0 :       CALL zhlp%alloc(zmat(1)%l_real, zmat(1)%matsize1, zmat(1)%matsize2)
      95             : 
      96             :       ! setup rotations in reciprocal space
      97           0 :       DO iop = 1, sym%nsym
      98           0 :          IF (iop <= sym%nop) THEN
      99           0 :             rrot(:, :, iop) = transpose(sym%mrot(:, :, sym%invtab(iop)))
     100             :          ELSE
     101           0 :             rrot(:, :, iop) = -rrot(:, :, iop - sym%nop)
     102             :          END IF
     103             :       END DO
     104             : 
     105             :       ! generate G-vectors, which fulfill |k+G|<rkmax
     106             :       ! for all k-points
     107           0 :       DO ikpt = 1, kpts%nkptf
     108           0 :          CALL lapw(ikpt)%init(input, noco, kpts, atoms, sym, ikpt, cell, sym%zrfs)
     109             :       END DO
     110             : 
     111             :       ! set spherical component of the potential from the previous iteration vr
     112           0 :       vr = vr0
     113             : 
     114             : !       ALLOCATE ( z_out(nbasfcn,neigd,nkpti),stat=ok )
     115             : !       IF ( ok .ne. 0) STOP 'gen_wavf: failure allocation z'
     116             : !       z_out = 0
     117             : !       z_out(:,:,:nkpti) = z_in
     118             : 
     119             :       ! calculate radial basis functions belonging to the
     120             :       ! potential vr stored in bas1 and bas2
     121             :       ! bas1 denotes the large component
     122             :       ! bas2    "     "  small component
     123             : 
     124           0 :       ALLOCATE (f(atoms%jmtd, 2, 0:atoms%lmaxd), df(atoms%jmtd, 2, 0:atoms%lmaxd))
     125           0 :       f = 0
     126           0 :       df = 0
     127           0 :       iarr = 2
     128           0 :       DO itype = 1, atoms%ntype
     129           0 :          IF (mpi%irank == 0) WRITE (6, FMT=8000) itype
     130           0 :          ng = atoms%jri(itype)
     131           0 :          DO l = 0, atoms%lmax(itype)
     132           0 :             CALL radfun(l, itype, jsp, el_eig(l, itype), vr(:, itype, jsp), atoms, f(:, :, l), df(:, :, l), usdus, nodem, noded, wronk)
     133           0 :             IF (mpi%irank == 0) WRITE (6, FMT=8010) l, el_eig(l, itype), usdus%us(l, itype, jsp), usdus%dus(l, itype, jsp), nodem, &
     134           0 :                usdus%uds(l, itype, jsp), usdus%duds(l, itype, jsp), noded, usdus%ddn(l, itype, jsp), wronk
     135             : 
     136           0 :             hybdat%bas1(1:ng, 1, l, itype) = f(1:ng, 1, l)
     137           0 :             hybdat%bas2(1:ng, 1, l, itype) = f(1:ng, 2, l)
     138           0 :             hybdat%bas1(1:ng, 2, l, itype) = df(1:ng, 1, l)
     139           0 :             hybdat%bas2(1:ng, 2, l, itype) = df(1:ng, 2, l)
     140             : 
     141           0 :             hybdat%bas1_MT(1, l, itype) = usdus%us(l, itype, jsp)
     142           0 :             hybdat%drbas1_MT(1, l, itype) = usdus%dus(l, itype, jsp)
     143           0 :             hybdat%bas1_MT(2, l, itype) = usdus%uds(l, itype, jsp)
     144           0 :             hybdat%drbas1_MT(2, l, itype) = usdus%duds(l, itype, jsp)
     145             :          END DO
     146             : 
     147           0 :          IF (atoms%nlo(itype) >= 1) THEN
     148           0 :             CALL radflo(atoms, itype, jsp, ello_eig, vr(:, itype, jsp), f, df, mpi, usdus, uuilon, duilon, ulouilopn, flo)
     149             : 
     150           0 :             DO ilo = 1, atoms%nlo(itype)
     151           0 :                iarr(atoms%llo(ilo, itype), itype) = iarr(atoms%llo(ilo, itype), itype) + 1
     152           0 :                hybdat%bas1(1:ng, iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = flo(1:ng, 1, ilo)
     153           0 :                hybdat%bas2(1:ng, iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = flo(1:ng, 2, ilo)
     154           0 :                hybdat%bas1_MT(iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = usdus%ulos(ilo, itype, jsp)
     155           0 :                hybdat%drbas1_MT(iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = usdus%dulos(ilo, itype, jsp)
     156             :             END DO
     157             :          END IF
     158             :       END DO
     159           0 :       DEALLOCATE (f, df)
     160             : 
     161             : #if CPP_DEBUG
     162             :       ! consistency check
     163             :       IF (.not. all(iarr == hybrid%nindx)) STOP 'gen_wavf: counting error'
     164             : #endif
     165             : 
     166             : 8000  FORMAT(1x, /, /, ' wavefunction parameters for atom type', i3, ':', /, t32, 'radial function', t79, &
     167             :              'energy derivative', /, t3, 'l', t8, 'energy', t26, 'value', t39, 'derivative', t53, &
     168             :              'nodes', t68, 'value', t81, 'derivative', t95, 'nodes', t107, 'norm', t119, 'wronskian')
     169             : 8010  FORMAT(i3, f10.5, 2(5x, 1p, 2e16.7, i5), 1p, 2e16.7)
     170             : 
     171             :       ! determine boundaries for parallel calculations
     172           0 :       lower = 1
     173           0 :       upper = nkpti
     174           0 :       found = .true.
     175             :       
     176             :       IF (.NOT. found) THEN
     177             :          upper = 0
     178             :       END IF
     179             : 
     180             :       ! calculate wavefunction expansion in the the MT region
     181             :       ! (acof,bcof,ccof) and APW-basis coefficients
     182             :       ! (a,b,bascofold_lo) at irred. kpoints
     183             : 
     184           0 :       ALLOCATE (acof(dimension%neigd, 0:dimension%lmd, atoms%nat), stat=ok)
     185           0 :       IF (ok /= 0) STOP 'gen_wavf: failure allocation acof'
     186           0 :       ALLOCATE (bcof(dimension%neigd, 0:dimension%lmd, atoms%nat), stat=ok)
     187           0 :       IF (ok /= 0) STOP 'gen_wavf: failure allocation bcof'
     188           0 :       ALLOCATE (ccof(-atoms%llod:atoms%llod, dimension%neigd, atoms%nlod, atoms%nat), stat=ok)
     189           0 :       IF (ok /= 0) STOP 'gen_wavf: failure allocation ccof'
     190           0 :       ALLOCATE (cmt(dimension%neigd, hybrid%maxlmindx, atoms%nat), stat=ok)
     191           0 :       IF (ok /= 0) STOP 'gen_wavf: Failure allocation cmt'
     192           0 :       ALLOCATE (cmthlp(dimension%neigd, hybrid%maxlmindx, atoms%nat), stat=ok)
     193           0 :       IF (ok /= 0) STOP 'gen_wavf: failure allocation cmthlp'
     194             : 
     195           0 :       DO ikpt0 = lower, upper
     196             : 
     197           0 :          acof = 0; bcof = 0; ccof = 0
     198             : 
     199             :          ! abcof calculates the wavefunction coefficients
     200             :          ! stored in acof,bcof,ccof
     201           0 :          lapw(ikpt0)%nmat = lapw(ikpt0)%nv(jsp) + atoms%nlotot
     202             :          CALL abcof(input, atoms, sym, cell, lapw(ikpt0), hybrid%nbands(ikpt0), usdus, noco, jsp, &!hybdat%kveclo_eig(:,ikpt0),&
     203             :                     oneD, acof(:hybrid%nbands(ikpt0), :, :), bcof(:hybrid%nbands(ikpt0), :, :), &
     204           0 :                     ccof(:, :hybrid%nbands(ikpt0), :, :), zmat(ikpt0))
     205             : 
     206             : ! call was ...
     207             :          ! gpt(1,:,:,ikpt0),gpt(2,:,:,ikpt0),&
     208             :          ! gpt(3,:,:,ikpt0),ngpt(:,ikpt0),&!k1hlp,k2hlp,k3hlp,nvhlp,&
     209             :          !    ngpt(jsp,ikpt0)+nbands(ikpt0),z(:,:,ikpt0),&!nvhlp(jsp)+ &
     210             :          !   &usdus,&
     211             :          !    noco,&
     212             :          !    jsp,kveclo_eig(:ikpt0),oneD,oneD,&
     213             :          !    acof(:nbands(ikpt0),:,:),&
     214             :          !    bcof(:nbands(ikpt0),:,:),ccof(:,:nbands(ikpt0),:,:) )
     215             : 
     216             :          ! MT wavefunction coefficients are calculated in a local coordinate system rotate them in the global one
     217             : 
     218             :          CALL hyb_abcrot(hybrid, atoms, hybrid%nbands(ikpt0), sym, cell, oneD, acof(:hybrid%nbands(ikpt0), :, :), &
     219           0 :                          bcof(:hybrid%nbands(ikpt0), :, :), ccof(:, :hybrid%nbands(ikpt0), :, :))
     220             : 
     221             :          ! decorate acof, bcof, ccof with coefficient i**l and store them
     222             :          ! in the field cmt(neigd,nkpt,maxlmindx,nat), i.e.
     223             :          ! where maxlmindx subsumes l,m and nindx
     224             : 
     225           0 :          cmt = 0
     226           0 :          iatom = 0
     227           0 :          DO itype = 1, atoms%ntype
     228           0 :             DO ieq = 1, atoms%neq(itype)
     229           0 :                iatom = iatom + 1
     230           0 :                indx = 0
     231           0 :                DO l = 0, atoms%lmax(itype)
     232           0 :                   ll = l*(l + 1)
     233           0 :                   cdum = img**l
     234             : 
     235             :                   ! determine number of local orbitals with quantum number l
     236             :                   ! map returns the number of the local orbital of quantum
     237             :                   ! number l in the list of all local orbitals of the atom type
     238           0 :                   idum = 0
     239           0 :                   map_lo = 0
     240           0 :                   IF (hybrid%nindx(l, itype) > 2) THEN
     241           0 :                      DO j = 1, atoms%nlo(itype)
     242           0 :                         IF (atoms%llo(j, itype) == l) THEN
     243           0 :                            idum = idum + 1
     244           0 :                            map_lo(idum) = j
     245             :                         END IF
     246             :                      END DO
     247             :                   END IF
     248             : 
     249           0 :                   DO M = -l, l
     250           0 :                      lm = ll + M
     251           0 :                      DO i = 1, hybrid%nindx(l, itype)
     252           0 :                         indx = indx + 1
     253           0 :                         IF (i == 1) THEN
     254           0 :                            cmt(:, indx, iatom) = cdum*acof(:, lm, iatom)
     255           0 :                         ELSE IF (i == 2) THEN
     256           0 :                            cmt(:, indx, iatom) = cdum*bcof(:, lm, iatom)
     257             :                         ELSE
     258           0 :                            idum = i - 2
     259           0 :                            cmt(:, indx, iatom) = cdum*ccof(M, :, map_lo(idum), iatom)
     260             :                         END IF
     261             :                      END DO
     262             :                   END DO
     263             :                END DO
     264             :             END DO
     265             :          END DO
     266             : 
     267             :          ! write cmt at irreducible k-points in direct-access file cmt
     268           0 :          CALL write_cmt(cmt, ikpt0)
     269           0 :          CALL zhlp%alloc(zmat(ikpt0)%l_real, zmat(ikpt0)%matsize1, zmat(ikpt0)%matsize2)
     270             : 
     271           0 :          IF (zhlp%l_real) THEN
     272           0 :             zhlp%data_r = zmat(ikpt0)%data_r
     273             :          ELSE
     274           0 :             zhlp%data_c = zmat(ikpt0)%data_c
     275             :          END IF
     276           0 :          CALL write_z(zhlp, ikpt0)
     277             : 
     278             :          ! generate wavefunctions coefficients at all k-points from
     279             :          ! irreducible k-points
     280             : 
     281           0 :          DO ikpt = 1, kpts%nkptf
     282           0 :             IF ((kpts%bkp(ikpt) == ikpt0) .AND. (ikpt0 /= ikpt)) THEN
     283           0 :                iop = kpts%bksym(ikpt)
     284             :                CALL waveftrafo_genwavf(cmthlp, zhlp%data_r, zhlp%data_c, cmt(:, :, :), zmat(1)%l_real, zmat(ikpt0)%data_r(:, :), &
     285             :                                        zmat(ikpt0)%data_c(:, :), ikpt0, iop, atoms, hybrid, kpts, sym, jsp, dimension, &
     286           0 :                                        hybrid%nbands(ikpt0), cell, lapw(ikpt0), lapw(ikpt), .true.)
     287             : 
     288           0 :                CALL write_cmt(cmthlp, ikpt)
     289           0 :                CALL write_z(zhlp, ikpt)
     290             :             END IF
     291             :          END DO  !ikpt
     292             :       END DO !ikpt0
     293             : 
     294           0 :       DEALLOCATE (acof, bcof, ccof)
     295           0 :       DEALLOCATE (cmt, cmthlp)
     296             : 
     297           0 :    END SUBROUTINE gen_wavf
     298             : 
     299             : END MODULE m_gen_wavf

Generated by: LCOV version 1.13