LCOV - code coverage report
Current view: top level - init - lapw_dim.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 58 72 80.6 %
Date: 2019-09-08 04:53:50 Functions: 2 2 100.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_lapwdim
       8             : CONTAINS
       9          24 :   SUBROUTINE lapw_dim(kpts,cell,input,noco,oneD,forcetheo,DIMENSION)
      10             :     !
      11             :     !*********************************************************************
      12             :     !     determines dimensions of the lapw basis set with |k+G|<rkmax.
      13             :     !  Generalization of the old apws_dim routine
      14             :     !*********************************************************************
      15             :     USE m_boxdim
      16             :     USE m_types
      17             :     USE m_types_forcetheo_extended
      18             :     IMPLICIT NONE
      19             :     TYPE(t_kpts),INTENT(IN)      :: kpts
      20             :     TYPE(t_cell),INTENT(IN)      :: cell
      21             :     TYPE(t_input),INTENT(IN)     :: input
      22             :     TYPE(t_noco),INTENT(INOUT)   :: noco
      23             :     TYPE(t_oneD),INTENT(IN)      :: oneD
      24             :     CLASS(t_forcetheo),INTENT(in):: forcetheo
      25             :     TYPE(t_dimension),INTENT(INOUT)::DIMENSION
      26             : 
      27             :     INTEGER j1,j2,j3,mk1,mk2,mk3,iofile,ksfft,q,nk,nv,nv2
      28             :     INTEGER ispin,nvh(2),nv2h(2)
      29             : 
      30             :     REAL arltv1,arltv2,arltv3,rkm,rk2,r2,s(3),gmaxp,qss(3)
      31          24 :     REAL,ALLOCATABLE:: q_vectors(:,:)
      32             :     REAL            :: bkpt(3)
      33             :     ! ..
      34             :     !
      35             :     !------->          ABBREVIATIONS
      36             :     !
      37             : 
      38             :     !   iofile      : device number for in and output
      39             :     !   gmax        : cut-off wavevector for charge density
      40             :     !   rkmax       : cut-off for |g+k|
      41             :     !   gmaxp       : gmaxp = gmax/rkmax, ideal: gmaxp=2
      42             :     !   arltv(i)    : length of reciprical lattice vector along
      43             :     !                 direction (i)
      44             :     !
      45             :     !---> Determine rkmax box of size mk1, mk2, mk3,
      46             :     !     for which |G(mk1,mk2,mk3) + (k1,k2,k3)| < rkmax
      47             :     !
      48          24 :     CALL boxdim(cell%bmat,arltv1,arltv2,arltv3)
      49             : 
      50             :     !     (add 1+1 due to integer rounding, strange k_vector in BZ)
      51          24 :     mk1 = int(input%rkmax/arltv1) + 2
      52          24 :     mk2 = int(input%rkmax/arltv2) + 2
      53          24 :     mk3 = int(input%rkmax/arltv3) + 2
      54             : 
      55          24 :     rkm = input%rkmax
      56          24 :     rk2 = rkm*rkm
      57             : 
      58             :     !Determine the q-vector(s) to use
      59             :     SELECT TYPE(forcetheo)
      60             :     TYPE IS (t_forcetheo_ssdisp)
      61           0 :        ALLOCATE(q_vectors(3,SIZE(forcetheo%qvec,2)))
      62           0 :        q_vectors=forcetheo%qvec
      63             :     TYPE IS (t_forcetheo_dmi)
      64           0 :        ALLOCATE(q_vectors(3,SIZE(forcetheo%qvec,2)))
      65           0 :        q_vectors=forcetheo%qvec
      66             :     TYPE IS (t_forcetheo_jij)
      67           0 :        ALLOCATE(q_vectors(3,SIZE(forcetheo%qvec,2)))
      68           0 :        q_vectors=forcetheo%qvec
      69             :     CLASS IS (t_forcetheo) ! DEFAULT
      70          24 :        ALLOCATE(q_vectors(3,1))
      71          96 :        q_vectors(:,1)=noco%qss
      72             :     END SELECT
      73             : 
      74          24 :     if (any(abs(noco%qss-q_vectors(:,1))>1E-4)) CALL judft_warn("q-vector for self-consistency should be first in list for force-theorem")
      75          96 :     noco%qss=q_vectors(:,1) ! Usually does not do anything, but ensures that in
      76             :                             !force theorem CASE noco%qss is first q-vector in list
      77             : 
      78             :     
      79          24 :     DIMENSION%nvd = 0 ; DIMENSION%nv2d = 0
      80          48 :     DO q=1,SIZE(q_vectors,2)
      81          24 :        qss=q_vectors(:,q)
      82         183 :        DO nk=1,kpts%nkpt
      83         135 :           bkpt=kpts%bk(:,nk)
      84             :           !---> obtain vectors
      85             :           !---> in a spin-spiral calculation different basis sets are used for
      86             :           !---> the two spin directions, because the cutoff radius is defined
      87             :           !---> by |G + k +/- qss/2| < rkmax.
      88         675 :           DO ispin = 1,2
      89         270 :              nv = 0
      90         270 :              nv2 = 0
      91        3076 :              DO j1 = -mk1,mk1
      92        2806 :                 s(1) = bkpt(1) + j1 + (2*ispin - 3)/2.0*qss(1)
      93       33122 :                 DO j2 = -mk2,mk2
      94       30046 :                    s(2) = bkpt(2) + j2 + (2*ispin - 3)/2.0*qss(2)
      95             :                    !--->          nv2 for films
      96       30046 :                    s(3) = 0.0
      97             :                    !r2 = dotirp(s,s,cell%bbmat)
      98       30046 :                    r2 = dot_product(matmul(s,cell%bbmat),s)
      99       30046 :                    IF (r2.LE.rk2) nv2 = nv2 + 1
     100      554370 :                    DO j3 = -mk3,mk3
     101      521518 :                       s(3) = bkpt(3) + j3 + (2*ispin - 3)/2.0*qss(3)
     102             :                       !r2 = dotirp(s,s,cell%bbmat)
     103      521518 :                       r2 = dot_product(matmul(s,cell%bbmat),s)
     104      551564 :                       IF (r2.LE.rk2) THEN
     105       69348 :                          nv = nv + 1
     106             :                       END IF
     107             :                    END DO
     108             :                 END DO
     109             :              END DO
     110             :              !-odim
     111         270 :              IF (oneD%odd%d1) THEN
     112           0 :                 nv2 = 0
     113           0 :                 s(1) = 0.0
     114           0 :                 s(2) = 0.0
     115           0 :                 DO j3 = -mk3,mk3
     116           0 :                    s(3) = bkpt(3) + j3 + (2*ispin - 3)/2.0*qss(3)
     117             :                    !r2 = dotirp(s,s,cell%bbmat)
     118           0 :                    r2 = dot_product(matmul(s,cell%bbmat),s)
     119             : 
     120           0 :                    IF (r2.LE.rk2) THEN
     121           0 :                       nv2 = nv2 + 1
     122             :                    END IF
     123             :                 END DO
     124             :              END IF
     125             :              !+odim
     126         270 :              nvh(ispin)  = nv
     127         405 :              nv2h(ispin) = nv2
     128             :           END DO
     129         135 :           DIMENSION%nvd=MAX(DIMENSION%nvd,MAX(nvh(1),nvh(2)))
     130         159 :           DIMENSION%nv2d=MAX(DIMENSION%nv2d,MAX(nv2h(1),nv2h(2)))
     131             : 
     132             :        ENDDO !k-loop
     133             :     ENDDO !q-loop
     134          24 :   END SUBROUTINE lapw_dim
     135             : 
     136          24 :   SUBROUTINE lapw_fft_dim(cell,input,noco,stars)
     137             :     !
     138             :     !*********************************************************************
     139             :     !     determines dimensions of the lapw basis set with |k+G|<rkmax.
     140             :     !  Generalization of the old apws_dim routine
     141             :     !*********************************************************************
     142             :     USE m_boxdim
     143             :     USE m_ifft,     ONLY : ifft235
     144             :     USE m_types
     145             : 
     146             :     IMPLICIT NONE
     147             :     TYPE(t_cell),INTENT(IN)      :: cell
     148             :     TYPE(t_input),INTENT(IN)     :: input
     149             :     TYPE(t_noco),INTENT(IN)      :: noco
     150             :     TYPE(t_stars),INTENT(INOUT)  :: stars
     151             : 
     152             :     INTEGER j1,j2,j3,mk1,mk2,mk3,iofile,ksfft,q,nk,nv,nv2
     153             :     INTEGER ispin,nvh(2),nv2h(2)
     154             : 
     155             :     REAL arltv1,arltv2,arltv3,rkm,rk2,r2,s(3),gmaxp
     156             :     REAL,ALLOCATABLE:: q_vectors(:,:)
     157             :     REAL            :: bkpt(3)
     158             :     ! ..
     159             :     !
     160             :     !------->          ABBREVIATIONS
     161             :     !
     162             : 
     163             :     !   iofile      : device number for in and output
     164             :     !   gmax        : cut-off wavevector for charge density
     165             :     !   rkmax       : cut-off for |g+k|
     166             :     !   gmaxp       : gmaxp = gmax/rkmax, ideal: gmaxp=2
     167             :     !   arltv(i)    : length of reciprical lattice vector along
     168             :     !                 direction (i)
     169             :     !
     170             :     !---> Determine rkmax box of size mk1, mk2, mk3,
     171             :     !     for which |G(mk1,mk2,mk3) + (k1,k2,k3)| < rkmax
     172             :     !
     173          24 :     CALL boxdim(cell%bmat,arltv1,arltv2,arltv3)
     174             : 
     175             :     !     (add 1+1 due to integer rounding, strange k_vector in BZ)
     176             : 
     177             : 
     178             : 
     179             :     !---> Determine the dimensions kq1d, kq2d, kq3d
     180             :     !     of the dimension of the charge density fft-box
     181             :     !     needed for the fast calculation of pw density
     182             :     !     (add 1 due to integer rounding,
     183             :     !      factor 2 due to positive domain)
     184             :     !
     185          24 :     gmaxp = 2.0
     186          24 :     CALL boxdim(cell%bmat,arltv1,arltv2,arltv3)
     187             :     !
     188          24 :     mk1 = int(gmaxp*input%rkmax/arltv1) + 1
     189          24 :     mk2 = int(gmaxp*input%rkmax/arltv2) + 1
     190          24 :     mk3 = int(gmaxp*input%rkmax/arltv3) + 1
     191             : 
     192             :     !---> add + 1 in spin spiral calculation, to make sure that all G's are 
     193             :     !---> still within the FFT-box after being shifted by the spin spiral
     194             :     !---> q-vector.
     195          24 :     IF (noco%l_ss) THEN
     196           1 :        mk1 = mk1 + 1
     197           1 :        mk2 = mk2 + 1
     198           1 :        mk3 = mk3 + 1
     199             :     ENDIF
     200             :     !
     201          24 :     stars%kq1_fft = 2*mk1
     202          24 :     stars%kq2_fft = 2*mk2
     203          24 :     stars%kq3_fft = 2*mk3
     204             :     !
     205             :     !---> fft's are usually fastest for low primes
     206             :     !     (restrict kqid to: kqid=  (2**P) * (3**Q) * (5**R)
     207             :     !
     208          24 :     ksfft = 1
     209             :     !     ksfft=(0,1) : KEY OF SELECTING FFT-PRDOGRAM AND RADIX-TYPE
     210             :     !                      0  PROGRAM, RADIX-2 ONLY
     211             :     !                      1  PROGRAM, RADIX-2, RADIX-3,RADIX-5
     212             : 
     213          24 :     stars%kq1_fft = ifft235(6,ksfft,stars%kq1_fft,gmaxp)
     214          24 :     stars%kq2_fft = ifft235(6,ksfft,stars%kq2_fft,gmaxp)
     215          24 :     stars%kq3_fft = ifft235(6,ksfft,stars%kq3_fft,gmaxp)
     216             : 
     217             : 
     218          24 :   END SUBROUTINE lapw_fft_dim
     219          96 : END MODULE m_lapwdim

Generated by: LCOV version 1.13