LCOV - code coverage report
Current view: top level - mix - type_mixvector.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 273 313 87.2 %
Date: 2019-09-08 04:53:50 Functions: 16 18 88.9 %

          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             : MODULE m_types_mixvector
       7             :   !TODO!!!
       8             :   ! LDA+U
       9             :   ! Noco (third spin)
      10             :   
      11             :   use m_types
      12             :   implicit none
      13             : #ifdef CPP_MPI
      14             :       include 'mpif.h'
      15             : #endif
      16             :   PRIVATE
      17             :   !Here we store the pointers used for metric
      18             :   TYPE(t_stars),POINTER  :: stars
      19             :   TYPE(t_cell),POINTER   :: cell
      20             :   TYPE(t_sphhar),POINTER :: sphhar
      21             :   TYPE(t_atoms),POINTER  :: atoms  =>null()
      22             :   INTEGER                :: jspins,nvac
      23             :   LOGICAL                :: l_noco,invs,invs2,l_mtnocopot
      24             :   INTEGER                :: pw_length !The shape of the local arrays
      25             :   INTEGER                :: pw_start(3)=0,pw_stop(3) !First and last index for spin
      26             :   INTEGER                :: mt_length,mt_length_g
      27             :   INTEGER                :: mt_start(3)=0,mt_stop(3) !First and last index for spin
      28             :   INTEGER                :: vac_length,vac_length_g
      29             :   INTEGER                :: vac_start(3)=0,vac_stop(3) !First and last index for spin
      30             :   INTEGER                :: misc_length=0,misc_length_g
      31             :   INTEGER                :: misc_start(3)=0,misc_stop(3) !First and last index for spin
      32             :   INTEGER                :: mix_mpi_comm !Communicator for all PEs doing mixing
      33             :   LOGICAL                :: spin_here(3)=.TRUE.
      34             :   LOGICAL                :: pw_here=.TRUE.
      35             :   LOGICAL                :: mt_here=.TRUE.
      36             :   LOGICAL                :: vac_here=.TRUE.
      37             :   LOGICAL                :: misc_here=.TRUE.
      38             :   INTEGER                :: mt_rank=0
      39             :   INTEGER                :: mt_size=1
      40             :   LOGICAL                :: l_pot=.FALSE. !Is this a potential?
      41             :   REAL,ALLOCATABLE       :: g_mt(:),g_vac(:),g_misc(:)
      42             :   
      43             :   TYPE,PUBLIC:: t_mixvector
      44             :      REAL,ALLOCATABLE       :: vec_pw(:)
      45             :      REAL,ALLOCATABLE       :: vec_mt(:)
      46             :      REAL,ALLOCATABLE       :: vec_vac(:)
      47             :      REAL,ALLOCATABLE       :: vec_misc(:)
      48             :    CONTAINS
      49             :      procedure :: alloc=>mixvector_alloc
      50             :      PROCEDURE :: from_density=>mixvector_from_density
      51             :      PROCEDURE :: to_density=>mixvector_to_density
      52             :      PROCEDURE :: apply_metric=>mixvector_metric
      53             :      PROCEDURE :: multiply_dot_mask
      54             :      PROCEDURE :: read_unformatted
      55             :      PROCEDURE :: write_unformatted
      56             :      GENERIC :: READ(UNFORMATTED) =>read_unformatted
      57             :      GENERIC :: WRITE(UNFORMATTED) =>write_unformatted
      58             :   END TYPE t_mixvector
      59             : 
      60             :   INTERFACE OPERATOR (*)
      61             :      MODULE PROCEDURE multiply_scalar
      62             :      MODULE PROCEDURE multiply_scalar_spin
      63             :   END INTERFACE OPERATOR (*)
      64             :   INTERFACE OPERATOR (+)
      65             :      MODULE PROCEDURE add_vectors
      66             :   END INTERFACE OPERATOR (+)
      67             :   INTERFACE OPERATOR (-)
      68             :      MODULE PROCEDURE subtract_vectors
      69             :   END INTERFACE OPERATOR (-)
      70             :   INTERFACE OPERATOR (.dot.)
      71             :      MODULE PROCEDURE multiply_dot
      72             :   END INTERFACE OPERATOR (.dot.)
      73             : 
      74             :   PUBLIC :: OPERATOR(+),OPERATOR(-),OPERATOR(*),OPERATOR(.dot.)
      75             :   PUBLIC :: mixvector_init,mixvector_reset
      76             : 
      77             : CONTAINS
      78             : 
      79          48 :   SUBROUTINE READ_unformatted(this,unit,iostat,iomsg)
      80             :     IMPLICIT NONE
      81             :     CLASS(t_mixvector),INTENT(INOUT)::this
      82             :     INTEGER,INTENT(IN)::unit
      83             :     INTEGER,INTENT(OUT)::iostat
      84             :     CHARACTER(len=*),INTENT(INOUT)::iomsg
      85             : 
      86          48 :     CALL this%alloc()
      87          48 :     IF (pw_here) READ(unit) this%vec_pw
      88          48 :     IF (mt_here) READ(unit) this%vec_mt
      89          48 :     IF (vac_here) READ(unit) this%vec_vac
      90          48 :     IF (misc_here) READ(unit) this%vec_misc
      91          48 :   END SUBROUTINE READ_unformatted
      92             : 
      93         636 :   SUBROUTINE write_unformatted(this,unit,iostat,iomsg)
      94             :     IMPLICIT NONE
      95             :     CLASS(t_mixvector),INTENT(IN)::this
      96             :     INTEGER,INTENT(IN)::unit
      97             :     INTEGER,INTENT(OUT)::iostat
      98             :     CHARACTER(len=*),INTENT(INOUT)::iomsg
      99         636 :     IF (pw_here) WRITE(unit) this%vec_pw
     100         636 :     IF (mt_here) WRITE(unit) this%vec_mt
     101         636 :     IF (vac_here) WRITE(unit) this%vec_vac
     102         636 :     IF (misc_here) WRITE(unit) this%vec_misc
     103         636 :   END SUBROUTINE write_unformatted
     104             : 
     105             :   
     106             : 
     107             : 
     108           2 :   SUBROUTINE mixvector_reset()
     109             :     IMPLICIT NONE
     110           2 :     atoms=>NULL()
     111           2 :     IF (ALLOCATED(g_mt)) DEALLOCATE(g_mt)
     112           2 :     IF (ALLOCATED(g_vac)) DEALLOCATE(g_vac)
     113           2 :     IF (ALLOCATED(g_misc)) DEALLOCATE(g_misc)
     114           2 :   END SUBROUTINE mixvector_reset
     115             : 
     116             :   
     117        1182 :   SUBROUTINE mixvector_from_density(vec,den,swapspin)
     118             :     USE m_types
     119             :     IMPLICIT NONE
     120             :     CLASS(t_mixvector),INTENT(INOUT)    :: vec
     121             :     TYPE(t_potden),    INTENT(inout)    :: Den
     122             :     LOGICAL,INTENT(IN),OPTIONAL         :: swapspin
     123             :     INTEGER:: js,ii,n,l,iv,j
     124        1182 :     call den%distribute(mix_mpi_comm)
     125        3930 :     DO js=1,MERGE(jspins,3,.NOT.l_noco)
     126        3244 :        j=js
     127        3244 :        IF (PRESENT(swapspin)) THEN
     128        1560 :           IF (swapspin.AND.js<3) j=MERGE(1,2,js==2)
     129             :        ENDIF
     130        3930 :        IF (spin_here(js)) THEN
     131             :           !PW part
     132        1678 :           IF (pw_here) THEN
     133        1622 :              vec%vec_pw(pw_start(js):pw_start(js)+stars%ng3-1)=REAL(den%pw(:,j))
     134        1622 :              IF ((.NOT.invs).or.(js==3)) THEN
     135         716 :                 vec%vec_pw(pw_start(js)+stars%ng3:pw_start(js)+2*stars%ng3-1)=AIMAG(den%pw(:,j))
     136             :              ENDIF
     137             :           ENDIF
     138        1678 :           IF (vac_here) THEN
     139             :              !This PE stores vac-data
     140          26 :              ii=vac_start(js)-1
     141          52 :              DO iv=1,nvac
     142          26 :                 vec%vec_vac(ii+1:ii+SIZE(den%vacz,1))=den%vacz(:,iv,j)
     143          26 :                 ii=ii+SIZE(den%vacz,1)
     144          26 :                 vec%vec_vac(ii+1:ii+SIZE(den%vacxy(:,:,iv,js)))=RESHAPE(REAL(den%vacxy(:,:,iv,j)),(/SIZE(den%vacxy(:,:,iv,j))/))
     145          26 :                 ii=ii+SIZE(den%vacxy(:,:,iv,j))
     146          26 :                 IF ((.NOT.invs2).or.(js==3))THEN
     147          18 :                    vec%vec_vac(ii+1:ii+SIZE(den%vacxy(:,:,iv,j)))=RESHAPE(AIMAG(den%vacxy(:,:,iv,j)),(/SIZE(den%vacxy(:,:,iv,j))/))
     148          18 :                    ii=ii+SIZE(den%vacxy(:,:,iv,j))
     149             :                 ENDIF
     150          52 :                 IF (js>2)THEN
     151           0 :                    vec%vec_vac(ii+1:ii+SIZE(den%vacz,1))=den%vacz(:,iv,4)
     152             :                    ii=ii+SIZE(den%vacz,1)
     153             :                 ENDIF
     154             :              ENDDO
     155             :           ENDIF
     156        1678 :           IF (js>2.AND..NOT.l_mtnocopot) RETURN
     157        1182 :           IF (mt_here) THEN
     158             :              !This PE stores some(or all) MT data
     159        1126 :              ii=mt_start(js)-1
     160        4408 :              DO n=mt_rank+1,atoms%ntype,mt_size
     161       35776 :                 DO l=0,sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n-1))+1))
     162       34650 :                    vec%vec_mt(ii+1:ii+atoms%jri(n))=den%mt(:atoms%jri(n),l,n,j)
     163       36806 :                    ii=ii+atoms%jri(n)
     164             :                 ENDDO
     165             :              ENDDO
     166        1126 :              IF (js==3) THEN !Imaginary part 
     167           0 :                 DO n=mt_rank+1,atoms%ntype,mt_size
     168           0 :                    DO l=0,sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n-1))+1))
     169           0 :                       vec%vec_mt(ii+1:ii+atoms%jri(n))=den%mt(:atoms%jri(n),l,n,4)
     170           0 :                       ii=ii+atoms%jri(n)
     171             :                    ENDDO
     172             :                 ENDDO
     173             :              ENDIF
     174             :           ENDIF
     175        1182 :           IF (js>2) RETURN
     176        1182 :           IF (misc_here) THEN
     177          26 :              vec%vec_misc(misc_start(js):misc_start(js)+SIZE(den%mmpMat(:,:,:,j))-1)=RESHAPE(REAL(den%mmpMat(:,:,:,j)),(/SIZE(den%mmpMat(:,:,:,j))/))
     178          26 :              vec%vec_misc(misc_start(js)+SIZE(den%mmpMat(:,:,:,j)):misc_start(js)+2*SIZE(den%mmpMat(:,:,:,j))-1)=RESHAPE(AIMAG(den%mmpMat(:,:,:,j)),(/SIZE(den%mmpMat(:,:,:,j))/))
     179             :           END IF
     180             :        END IF
     181             :     END DO
     182             : 
     183             :   END SUBROUTINE mixvector_from_density
     184             : 
     185         322 :   SUBROUTINE mixvector_to_density(vec,den)
     186             :     USE m_types
     187             :     IMPLICIT NONE
     188             :     CLASS(t_mixvector),INTENT(IN)    :: vec
     189             :     TYPE(t_potden),    INTENT(INOUT) :: Den
     190             :      INTEGER:: js,ii,n,l,iv
     191             : 
     192        1158 :      DO js=1,MERGE(jspins,3,.NOT.l_noco)
     193        1158 :         IF (spin_here(js)) THEN
     194             :            !PW part
     195         446 :            IF (pw_here) THEN
     196         418 :               IF (invs.and.js<3) THEN
     197       90207 :                  den%pw(:,js)=vec%vec_pw(pw_start(js):pw_start(js)+stars%ng3-1)
     198             :               ELSE
     199      259484 :                  den%pw(:,js)=CMPLX(vec%vec_pw(pw_start(js):pw_start(js)+stars%ng3-1),vec%vec_pw(pw_start(js)+stars%ng3:pw_start(js)+2*stars%ng3-1))
     200             :               ENDIF
     201             :            ENDIF
     202         446 :            IF (mt_here.AND.(js<3.OR.l_mtnocopot)) THEN
     203             :               !This PE stores some(or all) MT data
     204         294 :               ii=mt_start(js)
     205        1149 :               DO n=mt_rank+1,atoms%ntype,mt_size
     206        9336 :                  DO l=0,sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n-1))+1))
     207        9042 :                     den%mt(:atoms%jri(n),l,n,js)=vec%vec_mt(ii:ii+atoms%jri(n)-1)
     208        9603 :                     ii=ii+atoms%jri(n)
     209             :                  ENDDO
     210             :               ENDDO
     211         294 :               IF (js==3) THEN !Imaginary part comes as 4th spin
     212           0 :                  DO n=mt_rank+1,atoms%ntype,mt_size
     213           0 :                     DO l=0,sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n-1))+1))
     214           0 :                        den%mt(:atoms%jri(n),l,n,4)=vec%vec_mt(ii:ii+atoms%jri(n)-1)
     215           0 :                        ii=ii+atoms%jri(n)
     216             :                     ENDDO
     217             :                  ENDDO
     218             :               ENDIF
     219             :            ENDIF
     220         446 :            IF (vac_here) THEN
     221             :               !This PE stores vac-data
     222           7 :               ii=vac_start(js)-1
     223          14 :               DO iv=1,nvac
     224           7 :                  den%vacz(:,iv,js)=vec%vec_vac(ii+1:ii+SIZE(den%vacz,1))
     225           7 :                  ii=ii+SIZE(den%vacz,1)
     226           7 :                  IF (invs2.and.js<3)THEN
     227           2 :                     den%vacxy(:,:,iv,js)=RESHAPE(vec%vec_vac(ii+1:ii+SIZE(den%vacxy(:,:,iv,js))),SHAPE(den%vacxy(:,:,iv,js)))
     228           2 :                     ii=ii+SIZE(den%vacxy(:,:,iv,js))
     229             :                  ELSE
     230             :                     den%vacxy(:,:,iv,js)=RESHAPE(CMPLX(vec%vec_vac(ii+1:ii+SIZE(den%vacxy(:,:,iv,js))),&
     231             :                          vec%vec_vac(ii+SIZE(den%vacxy(:,:,iv,js))+1:ii+2*SIZE(den%vacxy(:,:,iv,js)))),&
     232          10 :                          SHAPE(den%vacxy(:,:,iv,js)))
     233           5 :                     ii=ii+2*SIZE(den%vacxy(:,:,iv,js))
     234             :                  ENDIF
     235          14 :                  IF (js>2) THEN
     236           0 :                     den%vacz(:,iv,4)=vec%vec_vac(ii+1:ii+SIZE(den%vacz,1))
     237             :                     ii=ii+SIZE(den%vacz,1)
     238             :               ENDIF
     239             :               ENDDO
     240             :            ENDIF
     241         446 :            IF (misc_here.AND.js<3) THEN
     242          13 :               den%mmpMat(:,:,:,js)=RESHAPE(CMPLX(vec%vec_misc(misc_start(js):misc_start(js)+SIZE(den%mmpMat(:,:,:,js))-1),vec%vec_misc(misc_start(js)+SIZE(den%mmpMat(:,:,:,js)):misc_start(js)+2*SIZE(den%mmpMat(:,:,:,js))-1)),SHAPE(den%mmpMat(:,:,:,js)))
     243             :            END IF
     244             :         END IF
     245             :      ENDDO
     246         322 :      call den%collect(mix_mpi_comm)
     247             :     
     248         322 :   END SUBROUTINE mixvector_to_density
     249             : 
     250             : 
     251        2808 :   FUNCTION mixvector_metric(vec)RESULT(mvec)
     252             :     USE m_types
     253             :     USE m_convol
     254             :     IMPLICIT NONE
     255             :     CLASS(t_mixvector),INTENT(IN)    :: vec
     256             :     TYPE(t_mixvector)                :: mvec
     257             : 
     258             :     INTEGER:: js,ii,n,l,iv
     259        2808 :     COMPLEX,ALLOCATABLE::pw(:),pw_w(:)
     260        2808 :     mvec=vec
     261        2808 :     IF (pw_here) ALLOCATE(pw(stars%ng3),pw_w(stars%ng3))
     262             :     
     263       10722 :     DO js=1,MERGE(jspins,3,.NOT.l_noco)
     264       10722 :        IF (spin_here(js)) THEN
     265             :           !PW part
     266        4078 :           IF (pw_here) THEN
     267             :              !Put back on g-grid and use convol
     268        3957 :              IF (invs.and.js<3) THEN
     269      592322 :                 pw(:)=vec%vec_pw(pw_start(js):pw_start(js)+stars%ng3-1)
     270             :              ELSE
     271     1409818 :                 pw(:)=CMPLX(vec%vec_pw(pw_start(js):pw_start(js)+stars%ng3-1),vec%vec_pw(pw_start(js)+stars%ng3:pw_start(js)+2*stars%ng3-1))
     272             :              ENDIF
     273        3957 :              CALL convol(stars,pw_w,pw,stars%ufft)
     274        3957 :              pw_w=pw_w*cell%omtil
     275        3957 :              mvec%vec_pw(pw_start(js):pw_start(js)+stars%ng3-1)=REAL(pw_w)
     276        3957 :              IF ((.NOT.invs).or.(js==3)) THEN 
     277        1794 :                 mvec%vec_pw(pw_start(js)+stars%ng3:pw_start(js)+2*stars%ng3-1)=AIMAG(pw_w)
     278             :              ENDIF
     279             :           ENDIF
     280        4078 :           IF (mt_here.AND.(js<3.OR.l_mtnocopot)) THEN
     281             :              !This PE stores some(or all) MT data
     282        2687 :              mvec%vec_mt(mt_start(js):mt_start(js)+SIZE(g_mt)-1)=g_mt*vec%vec_mt(mt_start(js):mt_start(js)+SIZE(g_mt)-1)
     283        2687 :              IF (js==3) THEN    
     284             :                 !Here we have a the imaginary part as well
     285           0 :                 mvec%vec_mt(mt_start(js)+SIZE(g_mt):mt_stop(js))=g_mt*vec%vec_mt(mt_start(js)+SIZE(g_mt):mt_stop(js))
     286             :              ENDIF
     287             :           ENDIF
     288        4078 :           IF (vac_here) THEN
     289           7 :              mvec%vec_vac(vac_start(js):vac_start(js)+SIZE(g_vac)-1)=g_vac*vec%vec_vac(vac_start(js):vac_start(js)+SIZE(g_vac)-1)
     290           7 :              IF (js==3) THEN !We have some extra data that corresponds to first part of metric
     291           0 :                 mvec%vec_vac(vac_start(js)+SIZE(g_vac):vac_stop(js))=g_vac(:vac_stop(js)-vac_start(js)-SIZE(g_vac)+1)*vec%vec_vac(vac_start(js)+SIZE(g_vac):vac_stop(js))
     292             :              ENDIF
     293             :           ENDIF
     294        4078 :           IF (misc_here.AND.(js<3)) THEN
     295          91 :              mvec%vec_misc(misc_start(js):misc_stop(js))=g_misc*vec%vec_misc(misc_start(js):misc_stop(js))
     296             :           END IF
     297             :        ENDIF
     298             :     END DO
     299             :    
     300        5616 :   END FUNCTION mixvector_metric
     301             : 
     302             : 
     303          50 :   SUBROUTINE init_metric(oneD,vacuum)
     304             :     USE m_metrz0
     305             :     IMPLICIT NONE
     306             :     TYPE(t_oned),INTENT(in)::oneD
     307             :     TYPE(t_vacuum),INTENT(in)::vacuum
     308             : 
     309             :     
     310             :     INTEGER:: i,n,l,j,ivac,iz,iv2c,k2,iv2
     311             :     REAL:: dxn,dxn2,dxn4,dvol,volnstr2
     312          50 :     REAL,allocatable:: wght(:)
     313             :     
     314          50 :     IF (mt_here) THEN
     315             :        !This PE stores some(or all) MT data
     316          38 :        ALLOCATE(g_mt(mt_length_g)) 
     317          38 :        i=0
     318         156 :        DO n =mt_rank+1,atoms%ntype,mt_size
     319          80 :           dxn = atoms%neq(n) * atoms%dx(n) / 3.0
     320          80 :           dxn2 =2.0 * dxn
     321          80 :           dxn4 =4.0 * dxn
     322        1792 :           DO l = 0, sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n-1))+1))
     323        1674 :              i = i + 1
     324        1674 :              g_mt(i) = dxn / atoms%rmsh(1,n)
     325        1754 :              IF (.NOT.l_pot) THEN
     326      530710 :                 DO j = 2, atoms%jri(n) - 1, 2
     327      529036 :                    i = i + 2
     328      529036 :                    g_mt(i-1) = dxn4 / atoms%rmsh(j,n) 
     329      530710 :                    g_mt(i) = dxn2 / atoms%rmsh(j+1,n) 
     330             :                 END DO
     331             :                 ! CHANGE JR 96/12/01
     332             :                 ! take care when jri(n) is even
     333        1674 :                 i = i + 1 - MOD(atoms%jri(n),2)
     334        1674 :                 g_mt(i) = dxn / atoms%rmsh(atoms%jri(n),n)
     335             :              ELSE
     336             :                 ! for the potential multiply by r^4
     337           0 :                 DO j = 2, atoms%jri(n) - 1, 2
     338           0 :                    i = i + 2
     339           0 :                    g_mt(i-1) = dxn4 * atoms%rmsh(j,n)**3 
     340           0 :                    g_mt(i) = dxn2 * atoms%rmsh(j+1,n)**3
     341             :                 END DO
     342           0 :                 i = i + 1 - MOD(atoms%jri(n),2)
     343           0 :                 g_mt(i) = dxn * atoms%rmsh(atoms%jri(n),n)**3
     344             :              END IF
     345             :           END DO
     346             :        END DO
     347             :     ENDIF
     348          50 :     i=0
     349          50 :     IF (vac_here) THEN
     350           7 :        iv2 = 2
     351           7 :        IF (invs2) iv2 = 1
     352             : 
     353           7 :        ALLOCATE(g_vac(vac_length_g),wght(vacuum%nmzd))
     354           7 :        dvol = cell%area*vacuum%delz
     355             :        ! nvac=1 if (zrfs.or.invs)
     356           7 :        IF (vacuum%nvac.EQ.1) dvol = dvol + dvol
     357           7 :        IF (oneD%odi%d1) dvol = cell%area*vacuum%delz
     358          14 :        DO ivac = 1, vacuum%nvac
     359             :           ! G||=0 components
     360             :           !
     361             :           ! use 7-point simpson integration in accordance to intgz0.f
     362             :           ! calculate weights for integration
     363           7 :           CALL metr_z0(vacuum%nmz,wght)
     364        1757 :           DO iz = 1, vacuum%nmz
     365        1750 :              i = i + 1
     366        1757 :              IF (oneD%odi%d1) THEN
     367           0 :                 g_vac(i) = wght(iz) * dvol * (cell%z1+(iz-1)*vacuum%delz)
     368             :              ELSE
     369        1750 :                 g_vac(i) = wght(iz) * dvol
     370             :              END IF
     371             :           END DO
     372             :           ! G||.ne.0 components
     373             :           !
     374             :           ! calculate weights for integration
     375           7 :           CALL metr_z0(vacuum%nmzxy,wght)
     376          26 :           DO iv2c = 1, iv2
     377        3387 :              DO k2 = 1, oneD%odi%nq2 - 1
     378        3380 :                 IF (oneD%odi%d1) THEN
     379           0 :                    DO iz = 1,vacuum%nmzxy
     380           0 :                       i = i + 1
     381           0 :                       g_vac(i) = wght(iz) * oneD%odi%nst2(k2) * dvol * (cell%z1+(iz-1)*vacuum%delz)
     382             :                    END DO
     383             :                 ELSE
     384        3368 :                    volnstr2 = dvol * stars%nstr2(k2)
     385      340168 :                    DO iz = 1, vacuum%nmzxy
     386      336800 :                       i = i + 1
     387      340168 :                       g_vac(i) = wght(iz) * volnstr2
     388             :                    END DO
     389             :                 END IF
     390             :              END DO
     391             :           END DO
     392             :        END DO
     393             :     END IF
     394          50 :     IF (misc_here) THEN
     395           2 :        ALLOCATE(g_misc(misc_length_g))
     396         786 :        g_misc=1.0
     397             :     END IF
     398             :     
     399             :     
     400          50 :   END SUBROUTINE init_metric
     401             :     
     402             :   
     403             :   
     404          50 :   SUBROUTINE init_storage_mpi(mpi_comm)
     405             :     IMPLICIT NONE
     406             :     INTEGER,INTENT(in):: mpi_comm
     407             :     INTEGER      :: irank,isize,err,js,new_comm
     408          50 :     mix_mpi_comm=mpi_comm
     409             : #ifdef CPP_MPI
     410             : 
     411          50 :     CALL mpi_comm_rank(mpi_comm,irank,err)
     412          50 :     CALL mpi_comm_size(mpi_comm,isize,err)
     413             : 
     414         100 :     IF (isize==1) RETURN !No parallelization
     415          50 :     js=MERGE(jspins,3,.NOT.l_noco)!distribute spins
     416          50 :     js=MIN(js,isize)
     417          50 :     CALL MPI_COMM_SPLIT(mpi_comm,MOD(irank,js),irank,new_comm,err)
     418          50 :     spin_here=(/MOD(irank,js)==0,MOD(irank,js)==1,(isize==2.AND.irank==0).or.MOD(irank,js)==2/)
     419             : 
     420          50 :     CALL mpi_comm_rank(new_comm,irank,err)
     421          50 :     CALL mpi_comm_size(new_comm,isize,err)
     422          50 :     CALL mpi_comm_free(new_comm,err)
     423             : 
     424             :     !Now distribute data   
     425          50 :     IF(isize==1) return !No further parallelism
     426             :     !Split off the pw-part
     427          24 :     pw_here=(irank==0)
     428          24 :     mt_here=(irank>0)
     429          24 :     vac_here=vac_here.AND.(irank>0)
     430          24 :     misc_here=misc_here.AND.(irank>0)
     431          24 :     isize=isize-1
     432          24 :     irank=irank-1
     433          24 :     mt_rank=irank
     434          24 :     mt_size=isize
     435          24 :     IF(isize==1.OR.irank<0) RETURN !No further parallelism
     436           0 :     IF (vac_here.OR.misc_here) THEN !split off-vacuum&misc part
     437           0 :        vac_here=vac_here.AND.(irank==0)
     438           0 :        misc_here=misc_here.AND.(irank==0)
     439           0 :        mt_here=(irank>0)
     440           0 :        isize=isize-1
     441           0 :        irank=irank-1
     442             :     ENDIF
     443           0 :     mt_rank=irank
     444           0 :     mt_size=isize
     445             : #endif
     446             :   END SUBROUTINE init_storage_mpi
     447             :       
     448             : 
     449             :   
     450         322 :   SUBROUTINE mixvector_init(mpi_comm,l_densitymatrix,oneD,input,vacuum,noco,sym,stars_i,cell_i,sphhar_i,atoms_i)
     451             :     USE m_types
     452             :     IMPLICIT NONE
     453             :     INTEGER,INTENT(IN)               :: mpi_comm
     454             :     LOGICAL,INTENT(IN)               :: l_densitymatrix
     455             :     TYPE(t_oneD),INTENT(IN)          :: oneD
     456             :     TYPE(t_input),INTENT(IN)         :: input
     457             :     TYPE(t_vacuum),INTENT(IN),TARGET :: vacuum
     458             :     TYPE(t_noco),INTENT(IN)          :: noco
     459             :     TYPE(t_sym),INTENT(IN)           :: sym
     460             :     TYPE(t_stars),INTENT(IN),TARGET  :: stars_i
     461             :     TYPE(t_cell),INTENT(IN),TARGET   :: cell_i
     462             :     TYPE(t_sphhar),INTENT(IN),TARGET :: sphhar_i
     463             :     TYPE(t_atoms),INTENT(IN),TARGET  :: atoms_i
     464             : 
     465             :     INTEGER::js,n,len
     466             :     
     467             : 
     468             :     !Store pointers to data-types
     469         322 :     if (associated(atoms)) return !was done before...
     470          50 :     jspins=input%jspins
     471          50 :     nvac=vacuum%nvac
     472          50 :     l_noco=noco%l_noco
     473          50 :     l_mtnocopot=noco%l_mtnocopot
     474          50 :     invs=sym%invs
     475          50 :     invs2=sym%invs2
     476          50 :     stars=>stars_i;cell=>cell_i;sphhar=>sphhar_i;atoms=>atoms_i
     477             :     
     478          50 :     vac_here=input%film
     479          50 :     misc_here=l_densitymatrix
     480          50 :     CALL init_storage_mpi(mpi_comm)
     481             :     
     482          50 :     pw_length=0;mt_length=0;vac_length=0;misc_length=0
     483          50 :     mt_length_g=0;vac_length_g=0;misc_length_g=0
     484         140 :     DO js=1,MERGE(jspins,3,.NOT.l_noco)
     485         140 :        IF (spin_here(js)) THEN
     486             :           !Now calculate the length of the vectors
     487          57 :           IF (pw_here) THEN
     488          45 :              pw_start(js)=pw_length+1
     489          45 :              IF (invs.and.js<3) THEN
     490          25 :                 pw_length=pw_length+stars%ng3
     491             :              ELSE
     492          20 :                 pw_length=pw_length+2*stars%ng3
     493             :              ENDIF
     494             :           ENDIF
     495          57 :           pw_stop(js)=pw_length
     496          57 :           IF (mt_here) THEN
     497          45 :              IF (js<3.OR.noco%l_mtnocopot) mt_start(js)=mt_length+1
     498          45 :              len=0
     499             :              !This PE stores some(or all) MT data
     500         138 :              DO n=mt_rank+1,atoms%ntype,mt_size
     501          45 :                 len=len+(sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n-1))+1))+1)*atoms%jri(n)
     502             :              ENDDO
     503          45 :              mt_length_g=MAX(len,mt_length_g)
     504          45 :              IF (js==3) THEN
     505             :                 !need to store imaginary part as well...
     506          20 :                 DO n=mt_rank+1,atoms%ntype,mt_size
     507           7 :                    len=len+(sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n-1))+1))+1)*atoms%jri(n)
     508             :                 ENDDO
     509             :              ENDIF
     510          45 :              IF (js<3.OR.noco%l_mtnocopot) mt_length=mt_length+len
     511          45 :              mt_stop(js)=mt_length
     512             :           END IF
     513          57 :           IF (vac_here) THEN
     514             :              !This PE stores vac-data
     515           7 :              vac_start(js)=vac_length+1
     516           7 :              len=0
     517           7 :              IF (invs2.and.js<3) THEN
     518           2 :                 len=len+vacuum%nmzxyd * ( oneD%odi%n2d - 1 ) * vacuum%nvac + vacuum%nmzd * vacuum%nvac
     519             :              ELSE
     520           5 :                 len=len+2*vacuum%nmzxyd * ( oneD%odi%n2d - 1 ) * vacuum%nvac + vacuum%nmzd * vacuum%nvac
     521             :              ENDIF
     522           7 :              vac_length_g=MAX(vac_length_g,len)
     523           7 :              IF (js==3) len=len+vacuum%nmzd * vacuum%nvac !Offdiagnal potential is complex
     524           7 :              vac_length=vac_length+len
     525           7 :              vac_stop(js)=vac_length
     526             :           ENDIF
     527          57 :           IF (misc_here.AND.(js<3)) THEN
     528           2 :              len = 7*7*2*atoms%n_u
     529           2 :              misc_start(js)=misc_length+1
     530           2 :              misc_length = misc_length + len
     531           2 :              misc_stop(js)=misc_length
     532           2 :              misc_length_g = MAX(len,misc_length_g)
     533             :           END IF
     534             :        END IF
     535             :     END DO
     536          50 :     CALL init_metric(oneD,vacuum)
     537             :   END SUBROUTINE mixvector_init
     538        7348 :   SUBROUTINE mixvector_alloc(vec)
     539             :     IMPLICIT NONE
     540             :     CLASS(t_mixvector),INTENT(OUT)    :: vec
     541        7348 :     ALLOCATE( vec%vec_pw(pw_length) )
     542        7348 :     ALLOCATE( vec%vec_mt(mt_length) )
     543        7348 :     ALLOCATE( vec%vec_vac(vac_length) )
     544        7348 :     ALLOCATE( vec%vec_misc(misc_length) )   
     545        7348 :   END SUBROUTINE mixvector_alloc
     546             : 
     547             : 
     548       33898 :     FUNCTION multiply_scalar(scalar,vec)RESULT(vecout)
     549             :       TYPE(t_mixvector),INTENT(IN)::vec
     550             :       REAL,INTENT(IN)             ::scalar
     551             :       TYPE(t_mixvector)           ::vecout
     552             : 
     553       33898 :       vecout=vec
     554       33898 :       vecout%vec_pw=vecout%vec_pw*scalar
     555       33898 :       vecout%vec_mt=vecout%vec_mt*scalar
     556       33898 :       vecout%vec_vac=vecout%vec_vac*scalar
     557       33898 :       vecout%vec_misc=vecout%vec_misc*scalar
     558       67796 :     END FUNCTION multiply_scalar
     559             : 
     560             : 
     561           0 :     FUNCTION multiply_scalar_spin(scalar,vec)RESULT(vecout)
     562             :       TYPE(t_mixvector),INTENT(IN)::vec
     563             :       REAL,INTENT(IN)             ::scalar(:)
     564             :       TYPE(t_mixvector)           ::vecout
     565             : 
     566             :       INTEGER:: js
     567             :       REAL:: fac
     568             :       
     569           0 :       vecout=vec
     570           0 :       DO js=1,MERGE(jspins,3,.NOT.l_noco)
     571           0 :          IF (SIZE(scalar)<js) THEN
     572             :             fac=0.0
     573             :          ELSE
     574           0 :             fac=scalar(js)
     575             :          ENDIF
     576           0 :          IF (pw_start(js)>0) vecout%vec_pw(pw_start(js):pw_stop(js))=vecout%vec_pw(pw_start(js):pw_stop(js))*fac
     577           0 :          IF (mt_start(js)>0)vecout%vec_mt(mt_start(js):mt_stop(js))=vecout%vec_mt(mt_start(js):mt_stop(js))*fac
     578           0 :          IF (vac_start(js)>0)vecout%vec_vac(vac_start(js):vac_stop(js))=vecout%vec_vac(vac_start(js):vac_stop(js))*fac
     579           0 :          IF (misc_start(js)>0)vecout%vec_misc(misc_start(js):misc_stop(js))=vecout%vec_misc(misc_start(js):misc_stop(js))*fac
     580             :       END DO
     581           0 :     END FUNCTION multiply_scalar_spin
     582             : 
     583        2808 :     FUNCTION add_vectors(vec1,vec2)RESULT(vecout)
     584             :       TYPE(t_mixvector),INTENT(IN)::vec1,vec2
     585             :       TYPE(t_mixvector)           ::vecout
     586             :       
     587        2808 :       vecout=vec1
     588        2808 :       vecout%vec_pw=vecout%vec_pw+vec2%vec_pw
     589        2808 :       vecout%vec_mt=vecout%vec_mt+vec2%vec_mt
     590        2808 :       vecout%vec_vac=vecout%vec_vac+vec2%vec_vac
     591        2808 :       vecout%vec_misc=vecout%vec_misc+vec2%vec_misc
     592        5616 :     END FUNCTION add_vectors
     593             :     
     594       34164 :     FUNCTION subtract_vectors(vec1,vec2)RESULT(vecout)
     595             :       TYPE(t_mixvector),INTENT(IN)::vec1,vec2
     596             :       TYPE(t_mixvector)           ::vecout
     597             :       
     598       34164 :       vecout=vec1
     599       34164 :       vecout%vec_pw=vecout%vec_pw-vec2%vec_pw
     600       34164 :       vecout%vec_mt=vecout%vec_mt-vec2%vec_mt
     601       34164 :       vecout%vec_vac=vecout%vec_vac-vec2%vec_vac
     602       34164 :       vecout%vec_misc=vecout%vec_misc-vec2%vec_misc
     603       68328 :     END FUNCTION subtract_vectors
     604             :     
     605       17062 :     FUNCTION multiply_dot(vec1,vec2)RESULT(dprod)
     606             :       TYPE(t_mixvector),INTENT(IN)::vec1,vec2
     607             :       REAL                        ::dprod,dprod_tmp
     608             :       integer                     ::ierr
     609       17062 :       dprod=dot_PRODUCT(vec1%vec_pw,vec2%vec_pw)
     610       17062 :       dprod=dprod+dot_PRODUCT(vec1%vec_mt,vec2%vec_mt)
     611       17062 :       dprod=dprod+dot_PRODUCT(vec1%vec_vac,vec2%vec_vac)
     612       17062 :       dprod=dprod+dot_PRODUCT(vec1%vec_misc,vec2%vec_misc)
     613             : #ifdef CPP_MPI
     614       17062 :       CALL MPI_ALLREDUCE(dprod,dprod_tmp,1,MPI_DOUBLE_PRECISION,MPI_SUM,mix_mpi_comm,ierr)
     615       17062 :       dprod=dprod_tmp
     616             : #endif      
     617       17062 :     END FUNCTION multiply_dot
     618             : 
     619        1102 :     FUNCTION multiply_dot_mask(vec1,vec2,mask,spin)RESULT(dprod)
     620             :       CLASS(t_mixvector),INTENT(IN)::vec1
     621             :       TYPE(t_mixvector),INTENT(IN)::vec2
     622             :       LOGICAL,INTENT(IN)          ::mask(4)
     623             :       INTEGER,INTENT(IN)          ::spin
     624             :       REAL                        ::dprod,dprod_tmp
     625             : 
     626             :       INTEGER:: js,ierr
     627             : 
     628        1102 :       dprod=0.0
     629             : 
     630        4408 :       DO js=1,3
     631        3306 :          IF (mask(1).and.(spin==js.or.spin==0).and.pw_start(js)>0) &
     632             :                  dprod=dprod+dot_PRODUCT(vec1%vec_pw(pw_start(js):pw_stop(js)),&
     633         551 :                  vec2%vec_pw(pw_start(js):pw_stop(js)))
     634        3306 :          IF (mask(2).and.(spin==js.or.spin==0).and.mt_start(js)>0) &
     635             :                  dprod=dprod+dot_PRODUCT(vec1%vec_mt(mt_start(js):mt_stop(js)),&
     636         427 :                  vec2%vec_mt(mt_start(js):mt_stop(js)))
     637        3306 :          IF (mask(3).and.(spin==js.or.spin==0).and.vac_start(js)>0) &
     638             :                  dprod=dprod+dot_PRODUCT(vec1%vec_vac(vac_start(js):vac_stop(js)),&
     639          10 :                  vec2%vec_vac(vac_start(js):vac_stop(js)))
     640        3306 :          IF (mask(4).and.(spin==js.or.spin==0).and.misc_start(js)>0) &
     641             :                  dprod=dprod+dot_PRODUCT(vec1%vec_misc(misc_start(js):misc_stop(js)),&
     642        1102 :                  vec2%vec_misc(misc_start(js):misc_stop(js)))
     643             :       enddo
     644             : 
     645             : #ifdef CPP_MPI
     646        1102 :       CALL MPI_ALLREDUCE(dprod,dprod_tmp,1,MPI_DOUBLE_PRECISION,MPI_SUM,mix_mpi_comm,ierr)
     647        1102 :       dprod=dprod_tmp
     648             : #endif
     649        1102 :     END FUNCTION multiply_dot_mask
     650        7348 :   end MODULE m_types_mixvector

Generated by: LCOV version 1.13