ssdisp.F90 5.69 KB
Newer Older
1 2 3 4 5 6 7
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

MODULE m_types_ssdisp
8 9

  USE m_types
10
  USE m_types_forcetheo
11
  USE m_judft
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
  TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_ssdisp
     INTEGER :: q_done
     REAL,ALLOCATABLE:: qvec(:,:)
     REAL,ALLOCATABLE:: evsum(:)
   CONTAINS
     PROCEDURE :: start   =>ssdisp_start
     PROCEDURE :: next_job=>ssdisp_next_job 
     PROCEDURE :: eval    =>ssdisp_eval
     PROCEDURE :: postprocess => ssdisp_postprocess
     PROCEDURE :: init   => ssdisp_init !not overloaded
     PROCEDURE :: dist   => ssdisp_dist !not overloaded
  END TYPE t_forcetheo_ssdisp

CONTAINS

  SUBROUTINE ssdisp_init(this,q)
    USE m_calculator
    USE m_constants
    IMPLICIT NONE
    CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
    REAL,INTENT(in)                     :: q(:,:)
    
    ALLOCATE(this%qvec(3,SIZE(q,2)))
    this%qvec=q
    
    ALLOCATE(this%evsum(SIZE(q,2)))
    this%evsum=0
  END SUBROUTINE ssdisp_init

41
  SUBROUTINE ssdisp_start(this,potden,l_io)
42
    USE m_types_potden
43 44
    IMPLICIT NONE
    CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
45
    TYPE(t_potden) ,INTENT(INOUT)          :: potden
46
    LOGICAL,INTENT(IN)                     :: l_io
47
    this%q_done=0
48
    CALL this%t_forcetheo%start(potden,l_io) !call routine of basis type
49 50 51 52 53 54 55 56 57 58

    IF (SIZE(potden%pw,2)<2) RETURN
    !Average out magnetic part of potential/charge in INT+Vacuum
    potden%pw(:,1)=(potden%pw(:,1)+potden%pw(:,2))/2.0
    potden%pw(:,2)=potden%pw(:,1)
    
    potden%vacz(:,:,1)=(potden%vacz(:,:,1)+potden%vacz(:,:,2))/2.0
    potden%vacxy(:,:,:,1)=(potden%vacxy(:,:,:,1)+potden%vacxy(:,:,:,2))/2.0
    potden%vacz(:,:,2)=potden%vacz(:,:,1)
    potden%vacxy(:,:,:,2)=potden%vacxy(:,:,:,1)
59 60 61 62 63 64
    !Off diagonal part
    IF (SIZE(potden%pw,2)==3) THEN
       potden%pw(:,3)=0.0
       potden%vacz(:,:,3:)=0.0
       potden%vacxy(:,:,:,3)=0.0
    END IF
65
    
66 67
  END SUBROUTINE  ssdisp_start

Daniel Wortmann's avatar
Daniel Wortmann committed
68
  LOGICAL FUNCTION ssdisp_next_job(this,lastiter,atoms,noco)
69 70
    USE m_types_setup
    USE m_xmlOutput
Daniel Wortmann's avatar
Daniel Wortmann committed
71
    USE m_constants
72 73 74
    IMPLICIT NONE
    CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
    LOGICAL,INTENT(IN)                  :: lastiter
Daniel Wortmann's avatar
Daniel Wortmann committed
75
    TYPE(t_atoms),INTENT(IN)            :: atoms
76 77
    !Stuff that might be modified...
    TYPE(t_noco),INTENT(INOUT) :: noco
78
    INTEGER                    :: itype
79
    IF (.NOT.lastiter) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
80
       ssdisp_next_job=this%t_forcetheo%next_job(lastiter,atoms,noco)
81 82 83 84 85 86 87 88 89
       RETURN
    ENDIF
    !OK, now we start the SSDISP-loop
    this%q_done=this%q_done+1
    ssdisp_next_job=(this%q_done<=SIZE(this%qvec,2)) !still q-vectors to do
    IF (.NOT.ssdisp_next_job) RETURN
    
    !Now modify the noco-file
    noco%qss=this%qvec(:,this%q_done)
90 91 92 93
    !Modify the alpha-angles
    DO iType = 1,atoms%ntype
       noco%alph(iType) = noco%alphInit(iType) + tpi_const*dot_PRODUCT(noco%qss,atoms%taual(:,SUM(atoms%neq(:itype-1))+1))
    END DO
94
    IF (.NOT.this%l_io) RETURN
95
    IF (this%q_done.NE.1) CALL closeXMLElement('Forcetheorem_Loop_SSDISP')
96
    CALL openXMLElementPoly('Forcetheorem_Loop_SSDISP',(/'Q-vec'/),(/this%q_done/))
97 98 99 100 101 102 103 104 105 106
  END FUNCTION ssdisp_next_job

  SUBROUTINE ssdisp_postprocess(this)
    USE m_xmlOutput
    IMPLICIT NONE
    CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this

    !Locals
    INTEGER:: n,q
    CHARACTER(LEN=12):: attributes(4)
107
    IF (this%q_done==0) RETURN
108
    !Now output the results
109 110 111 112 113 114 115 116 117 118 119
    IF (this%l_io) THEN
       CALL closeXMLElement('Forcetheorem_Loop_SSDISP')
       CALL openXMLElementPoly('Forcetheorem_SSDISP',(/'qvectors'/),(/SIZE(this%evsum)/))
       DO q=1,SIZE(this%evsum)
          WRITE(attributes(1),'(i5)') q
          WRITE(attributes(2),'(f12.7)') this%evsum(q) 
          CALL writeXMLElementForm('Entry',(/'q     ','ev-sum'/),attributes(1:2),&
               RESHAPE((/1,6,5,12/),(/2,2/)))
       ENDDO
       CALL closeXMLElement('Forcetheorem_SSDISP')
    ENDIF
120
    CALL judft_end("Forcetheorem:SpinSpiralDispersion")
121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
  END SUBROUTINE ssdisp_postprocess

  SUBROUTINE ssdisp_dist(this,mpi)
    USE m_types_mpi
    IMPLICIT NONE
    CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
    TYPE(t_mpi),INTENT(in):: mpi
    
    INTEGER:: q,ierr
#ifdef CPP_MPI    
    INCLUDE 'mpif.h'
    IF (mpi%irank==0) q=SIZE(this%qvec,2)
    CALL MPI_BCAST(q,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
    IF (mpi%irank.NE.0) ALLOCATE(this%qvec(3,q),this%evsum(q));this%evsum=0.0
    CALL MPI_BCAST(this%qvec,3*q,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
#endif    
  END SUBROUTINE ssdisp_dist

  FUNCTION ssdisp_eval(this,eig_id,DIMENSION,atoms,kpts,sym,&
       cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip)
     USE m_types
     USE m_ssomat
    IMPLICIT NONE
    CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
    LOGICAL :: skip
    !Stuff that might be used...
    TYPE(t_mpi),INTENT(IN)         :: mpi
    TYPE(t_dimension),INTENT(IN)   :: dimension
    TYPE(t_oneD),INTENT(IN)        :: oneD
    TYPE(t_input),INTENT(IN)       :: input
    TYPE(t_noco),INTENT(IN)        :: noco
    TYPE(t_sym),INTENT(IN)         :: sym
    TYPE(t_cell),INTENT(IN)        :: cell
    TYPE(t_kpts),INTENT(IN)        :: kpts
    TYPE(t_atoms),INTENT(IN)       :: atoms
    TYPE(t_enpara),INTENT(IN)      :: enpara
    TYPE(t_potden),INTENT(IN)      :: v
    TYPE(t_results),INTENT(IN)     :: results
    INTEGER,INTENT(IN)             :: eig_id
160 161 162
    skip=.FALSE.
    IF (this%q_done==0) RETURN
  
163 164 165 166 167 168
    this%evsum(this%q_done)=results%seigv
    skip=.TRUE.
  END FUNCTION  ssdisp_eval

  
END MODULE m_types_ssdisp