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_types_ssdisp
       8             : 
       9             :   USE m_types
      10             :   USE m_types_forcetheo
      11             :   USE m_judft
      12             :   IMPLICIT NONE
      13             :   TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_ssdisp
      14             :      INTEGER :: q_done
      15             :      REAL,ALLOCATABLE:: qvec(:,:)
      16             :      REAL,ALLOCATABLE:: evsum(:)
      17             :    CONTAINS
      18             :      PROCEDURE :: start   =>ssdisp_start
      19             :      PROCEDURE :: next_job=>ssdisp_next_job
      20             :      PROCEDURE :: eval    =>ssdisp_eval
      21             :      PROCEDURE :: postprocess => ssdisp_postprocess
      22             :      PROCEDURE :: init   => ssdisp_init !not overloaded
      23             :      PROCEDURE :: dist   => ssdisp_dist !not overloaded
      24             :   END TYPE t_forcetheo_ssdisp
      25             : 
      26             : CONTAINS
      27             : 
      28             : 
      29           0 :   SUBROUTINE ssdisp_init(this,q)
      30             :     USE m_calculator
      31             :     USE m_constants
      32             :     IMPLICIT NONE
      33             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
      34             :     REAL,INTENT(in)                     :: q(:,:)
      35             : 
      36           0 :     ALLOCATE(this%qvec(3,SIZE(q,2)))
      37           0 :     this%qvec=q
      38           0 :     this%l_needs_vectors=.false.
      39             :    
      40           0 :     ALLOCATE(this%evsum(SIZE(q,2)))
      41           0 :     this%evsum=0
      42           0 :   END SUBROUTINE ssdisp_init
      43             : 
      44           0 :   SUBROUTINE ssdisp_start(this,potden,l_io)
      45             :     USE m_types_potden
      46             :     IMPLICIT NONE
      47             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
      48             :     TYPE(t_potden) ,INTENT(INOUT)          :: potden
      49             :     LOGICAL,INTENT(IN)                     :: l_io
      50           0 :     this%q_done=0
      51           0 :     CALL this%t_forcetheo%start(potden,l_io) !call routine of basis type
      52             : 
      53           0 :     IF (SIZE(potden%pw,2)<2) RETURN
      54             :     !Average out magnetic part of potential/charge in INT+Vacuum
      55           0 :     potden%pw(:,1)=(potden%pw(:,1)+potden%pw(:,2))/2.0
      56           0 :     potden%pw(:,2)=potden%pw(:,1)
      57           0 :     potden%vac(:,:,:,1)=(potden%vac(:,:,:,1)+potden%vac(:,:,:,2))/2.0
      58           0 :     potden%vac(:,:,:,2)=potden%vac(:,:,:,1)
      59             :     !Off diagonal part
      60           0 :     IF (SIZE(potden%pw,2)==3) THEN
      61           0 :        potden%pw(:,3)=0.0
      62           0 :        potden%vac(:,:,:,3)=0.0
      63             :     END IF
      64             : 
      65             :   END SUBROUTINE  ssdisp_start
      66             : 
      67           0 :   LOGICAL FUNCTION ssdisp_next_job(this,fmpi,lastiter,atoms,noco,nococonv)
      68             :     USE m_types_setup
      69             :     USE m_xmlOutput
      70             :     USE m_constants
      71             :     USE m_types_mpi
      72             :     IMPLICIT NONE
      73             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
      74             :     TYPE(t_mpi), INTENT(IN)                :: fmpi
      75             :     LOGICAL,INTENT(IN)                  :: lastiter
      76             :     TYPE(t_atoms),INTENT(IN)            :: atoms
      77             :     TYPE(t_noco),INTENT(IN)             :: noco
      78             :     !Stuff that might be modified...
      79             :     TYPE(t_nococonv),INTENT(INOUT) :: nococonv
      80             :     CHARACTER(LEN=12):: attributes(2)
      81             :     INTEGER                    :: itype
      82           0 :     IF (.NOT.lastiter) THEN
      83           0 :        ssdisp_next_job=this%t_forcetheo%next_job(fmpi,lastiter,atoms,noco,nococonv)
      84           0 :        RETURN
      85             :     ENDIF
      86             :     !OK, now we start the SSDISP-loop
      87           0 :     this%l_in_forcetheo_loop = .true.
      88           0 :     this%q_done=this%q_done+1
      89           0 :     ssdisp_next_job=(this%q_done<=SIZE(this%qvec,2)) !still q-vectors to do
      90           0 :     IF (.NOT.ssdisp_next_job) RETURN
      91             : 
      92             :     !Now modify the noco-file
      93           0 :     nococonv%qss=this%qvec(:,this%q_done)
      94             :     !Modify the alpha-angles
      95           0 :     DO iType = 1,atoms%ntype
      96           0 :        nococonv%alph(iType) = noco%alph_inp(iType) + tpi_const*dot_PRODUCT(nococonv%qss,atoms%taual(:,atoms%firstAtom(itype)))
      97             :     END DO
      98           0 :     IF (.NOT.this%l_io) RETURN
      99           0 :     IF (fmpi%irank .EQ. 0) THEN
     100           0 :        IF (this%q_done.NE.1) CALL closeXMLElement('Forcetheorem_Loop')
     101           0 :        WRITE(attributes(1),'(a)') 'SSDISP'
     102           0 :        WRITE(attributes(2),'(i5)') this%q_done
     103           0 :        CALL openXMLElementPoly('Forcetheorem_Loop',(/'calculationType','No             '/),attributes)
     104             :     END IF
     105             :   END FUNCTION ssdisp_next_job
     106             : 
     107           0 :   SUBROUTINE ssdisp_postprocess(this)
     108             :     USE m_xmlOutput
     109             :     IMPLICIT NONE
     110             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
     111             : 
     112             :     !Locals
     113             :     INTEGER:: n,q
     114             :     CHARACTER(LEN=12):: attributes(4)
     115           0 :     IF (this%q_done==0) RETURN
     116             :     !Now output the results
     117           0 :     IF (this%l_io) THEN
     118           0 :        CALL closeXMLElement('Forcetheorem_Loop')
     119           0 :        attributes = ''
     120           0 :        WRITE(attributes(1),'(i5)') SIZE(this%evsum)
     121           0 :        WRITE(attributes(2),'(a)') 'Htr'
     122           0 :        CALL openXMLElement('Forcetheorem_SSDISP',(/'qvectors','units   '/),attributes(:2))
     123           0 :        DO q=1,SIZE(this%evsum)
     124           0 :           WRITE(attributes(1),'(i5)') q
     125           0 :           WRITE(attributes(2),'(f12.7)') this%evsum(q)
     126             :           CALL writeXMLElementForm('Entry',(/'q     ','ev-sum'/),attributes(1:2),&
     127           0 :                RESHAPE((/1,6,5,12/),(/2,2/)))
     128             :        ENDDO
     129           0 :        CALL closeXMLElement('Forcetheorem_SSDISP')
     130             :     ENDIF
     131           0 :     CALL judft_end("Forcetheorem:SpinSpiralDispersion")
     132             :   END SUBROUTINE ssdisp_postprocess
     133             : 
     134           0 :   SUBROUTINE ssdisp_dist(this,fmpi)
     135             : #ifdef CPP_MPI
     136             :     USE mpi
     137             : #endif
     138             :     USE m_types_mpi
     139             :     IMPLICIT NONE
     140             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
     141             :     TYPE(t_mpi),INTENT(in):: fmpi
     142             : 
     143             :     INTEGER:: q,ierr
     144             : #ifdef CPP_MPI
     145           0 :     IF (fmpi%irank==0) q=SIZE(this%qvec,2)
     146           0 :     CALL MPI_BCAST(q,1,MPI_INTEGER,0,fmpi%mpi_comm,ierr)
     147           0 :     IF (fmpi%irank.NE.0) ALLOCATE(this%qvec(3,q),this%evsum(q));this%evsum=0.0
     148           0 :     CALL MPI_BCAST(this%qvec,3*q,MPI_DOUBLE_PRECISION,0,fmpi%mpi_comm,ierr)
     149             : #endif
     150           0 :   END SUBROUTINE ssdisp_dist
     151             : 
     152           0 :   FUNCTION ssdisp_eval(this,eig_id,atoms,kpts,sym,&
     153             :        cell,noco,nococonv, input,fmpi,  enpara,v,results)RESULT(skip)
     154             :      USE m_types
     155             :      USE m_ssomat
     156             :     IMPLICIT NONE
     157             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
     158             :     LOGICAL :: skip
     159             :     !Stuff that might be used...
     160             :     TYPE(t_mpi),INTENT(IN)         :: fmpi
     161             : 
     162             :      
     163             :     TYPE(t_input),INTENT(IN)       :: input
     164             :     TYPE(t_noco),INTENT(IN)        :: noco
     165             :     TYPE(t_nococonv),INTENT(IN)   :: nococonv
     166             :     TYPE(t_sym),INTENT(IN)         :: sym
     167             :     TYPE(t_cell),INTENT(IN)        :: cell
     168             :     TYPE(t_kpts),INTENT(IN)        :: kpts
     169             :     TYPE(t_atoms),INTENT(IN)       :: atoms
     170             :     TYPE(t_enpara),INTENT(IN)      :: enpara
     171             :     TYPE(t_potden),INTENT(IN)      :: v
     172             :     TYPE(t_results),INTENT(IN)     :: results
     173             :     INTEGER,INTENT(IN)             :: eig_id
     174           0 :     skip=.FALSE.
     175           0 :     IF (this%q_done==0) RETURN
     176             : 
     177           0 :     this%evsum(this%q_done)=results%seigv
     178           0 :     skip=.TRUE.
     179           0 :   END FUNCTION  ssdisp_eval
     180             : 
     181             : 
     182           0 : END MODULE m_types_ssdisp