ssdisp.F90 4.56 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 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 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
!--------------------------------------------------------------------------------
! 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
  USE m_judft
  USE m_types_forcetheo
  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

  SUBROUTINE ssdisp_start(this)
    IMPLICIT NONE
    CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
    this%q_done=0
    CALL this%t_forcetheo%start() !call routine of basis type
  END SUBROUTINE  ssdisp_start

  LOGICAL FUNCTION ssdisp_next_job(this,lastiter,noco)
    USE m_types_setup
    USE m_xmlOutput
    IMPLICIT NONE
    CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
    LOGICAL,INTENT(IN)                  :: lastiter
    !Stuff that might be modified...
    TYPE(t_noco),INTENT(INOUT) :: noco
    IF (.NOT.lastiter) THEN
       ssdisp_next_job=this%t_forcetheo%next_job(lastiter,noco)
       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)
    IF (this%q_done.NE.1) CALL closeXMLElement('Forcetheorem_Loop_SSDISP')
    CALL openXMLElementPoly('Forcetheorem_Loop_SSDISP',(/'Q-vec:'/),(/this%q_done/))
  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)
77
    IF (this%q_done==0) RETURN
78 79 80 81 82 83 84 85 86 87
    !Now output the results
    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')
88
    CALL judft_end("Forcetheorem:SpinSpiralDispersion")
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
  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
128 129 130
    skip=.FALSE.
    IF (this%q_done==0) RETURN
  
131 132 133 134 135 136
    this%evsum(this%q_done)=results%seigv
    skip=.TRUE.
  END FUNCTION  ssdisp_eval

  
END MODULE m_types_ssdisp