mae.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_mae
8
  USE m_types
9
  USE m_types_forcetheo
10
  USE m_judft
11 12 13 14 15 16 17 18 19 20
  TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_mae
     INTEGER :: directions_done
     REAL,ALLOCATABLE:: theta(:)
     REAL,ALLOCATABLE:: phi(:)
     REAL,ALLOCATABLE:: evsum(:)
   CONTAINS
     PROCEDURE :: start   =>mae_start
     PROCEDURE :: next_job=>mae_next_job 
     PROCEDURE :: eval    =>mae_eval
     PROCEDURE :: postprocess => mae_postprocess
21 22
     PROCEDURE :: init   => mae_init !not overloaded
     PROCEDURE :: dist   => mae_dist !not overloaded
23 24 25
  END TYPE t_forcetheo_mae

CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
26
  SUBROUTINE mae_init(this,cell,sym,theta_s,phi_s)
27
    USE m_calculator
28 29
    USE m_socsym
    USE m_types
30 31
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
32 33
    TYPE(t_cell),INTENT(IN)             :: cell
    TYPE(t_sym),INTENT(IN)              :: sym
34 35
    CHARACTER(len=*),INTENT(INOUT)      :: theta_s,phi_s

Daniel Wortmann's avatar
Daniel Wortmann committed
36
    INTEGER::n
37 38
    LOGICAL::error(sym%nop)
    
39 40 41 42 43
    CALL evaluateList(this%theta,theta_s)
    CALL evaluateList(this%phi,phi_s)

    IF (SIZE(this%phi).NE.SIZE(this%theta)) CALL &
         judft_error("Lists for theta/phi must have the same length in MAE force theorem calculations")
44 45 46 47
    DO n=1,SIZE(this%phi)
       CALL soc_sym(sym%nop,sym%mrot,this%theta(n),this%phi(n),cell%amat,error)
       IF (ANY(error)) CALL judft_error("Force theory choice of SOC-SQA breaks symmetry")
    END DO
48 49 50 51 52
    ALLOCATE(this%evsum(SIZE(this%phi)))
    this%evsum=0
  END SUBROUTINE mae_init
    

53
  SUBROUTINE mae_start(this,potden,l_io)
54
    USE m_types_potden
55 56
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
57
    TYPE(t_potden) ,INTENT(INOUT)       :: potden
58
    LOGICAL,INTENT(IN)                  :: l_io
59
    this%directions_done=0
60
    CALL this%t_forcetheo%start(potden,l_io) !call routine of basis type
61 62 63
  END SUBROUTINE  mae_start


Daniel Wortmann's avatar
Daniel Wortmann committed
64
  LOGICAL FUNCTION mae_next_job(this,lastiter,atoms,noco)
65 66
    USE m_types_setup
    USE m_xmlOutput
Daniel Wortmann's avatar
Daniel Wortmann committed
67
    USE m_constants
68 69 70
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
    LOGICAL,INTENT(IN)                  :: lastiter
Daniel Wortmann's avatar
Daniel Wortmann committed
71
    TYPE(t_atoms),INTENT(IN)            :: atoms
72 73 74
    !Stuff that might be modified...
    TYPE(t_noco),INTENT(INOUT) :: noco
       IF (.NOT.lastiter) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
75
          mae_next_job=this%t_forcetheo%next_job(lastiter,atoms,noco)
76 77 78 79 80
          RETURN
       ENDIF
       !OK, now we start the MAE-loop
       this%directions_done=this%directions_done+1
       mae_next_job=(this%directions_done<=SIZE(this%phi)) !still angles to do
81
       IF (.NOT.mae_next_job) RETURN
82 83 84

       noco%theta=this%theta(this%directions_done)
       noco%phi=this%phi(this%directions_done)
85
       noco%l_soc=.true.
86 87
       IF (this%directions_done.NE.1.AND.this%l_io) CALL closeXMLElement('Forcetheorem_Loop_MAE')
       IF (this%l_io) CALL openXMLElementPoly('Forcetheorem_Loop_MAE',(/'No'/),(/this%directions_done/))
88 89
  END FUNCTION mae_next_job

90 91 92
  FUNCTION mae_eval(this,eig_id,DIMENSION,atoms,kpts,sym,&
       cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip)
    USE m_types
93 94 95 96
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
    LOGICAL :: skip
    !Stuff that might be used...
97 98 99 100 101 102 103 104 105 106 107 108 109
    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
110 111 112 113
    IF (this%directions_done==0) THEN
       skip=.FALSE.
       RETURN
    ENDIF
114
    this%evsum(this%directions_done)=results%seigv/2.0 
115 116 117 118 119 120 121 122 123 124 125
    skip=.TRUE.
  END FUNCTION  mae_eval

  SUBROUTINE mae_postprocess(this)
    USE m_xmlOutput
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this

    !Locals
    INTEGER:: n
    CHARACTER(LEN=12):: attributes(3)
126 127 128 129
    IF (this%directions_done==0) THEN
       RETURN
    ENDIF
    
130 131 132 133 134 135 136 137 138 139 140 141 142
    IF (this%l_io) THEN
       !Now output the results
       CALL closeXMLElement('Forcetheorem_Loop_MAE')
       CALL openXMLElementPoly('Forcetheorem_MAE',(/'Angles'/),(/SIZE(this%evsum)/))
       DO n=1,SIZE(this%evsum)
          WRITE(attributes(1),'(f12.7)') this%theta(n)
          WRITE(attributes(2),'(f12.7)') this%phi(n)
          WRITE(attributes(3),'(f12.7)') this%evsum(n)     
          CALL writeXMLElementForm('Angle',(/'theta ','phi   ','ev-sum'/),attributes,&
               RESHAPE((/5,3,6,12,12,12/),(/3,2/)))
       END DO
       CALL closeXMLElement('Forcetheorem_MAE')
    ENDIF
143
    CALL judft_end("Forcetheorem MAE")
144
  END SUBROUTINE mae_postprocess
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161

  SUBROUTINE mae_dist(this,mpi)
    USE m_types_mpi
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
    TYPE(t_mpi),INTENT(in):: mpi

    INTEGER:: i,ierr
#ifdef CPP_MPI    
    INCLUDE 'mpif.h'
    IF (mpi%irank==0) i=SIZE(this%theta)
    call MPI_BCAST(i,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
    IF (mpi%irank.NE.0) ALLOCATE(this%phi(i),this%theta(i),this%evsum(i));this%evsum=0.0
    CALL MPI_BCAST(this%phi,i,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
    CALL MPI_BCAST(this%theta,i,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
#endif    
  END SUBROUTINE mae_dist
162
END MODULE m_types_mae