mae.F90 5.59 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

36 37
    LOGICAL::error(sym%nop)
    
38 39 40 41 42
    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")
43 44 45 46
    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
47 48 49 50 51
    ALLOCATE(this%evsum(SIZE(this%phi)))
    this%evsum=0
  END SUBROUTINE mae_init
    

52
  SUBROUTINE mae_start(this,potden,l_io)
53
    USE m_types_potden
54 55
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
56
    TYPE(t_potden) ,INTENT(INOUT)       :: potden
57
    LOGICAL,INTENT(IN)                  :: l_io
58
    this%directions_done=0
59
    CALL this%t_forcetheo%start(potden,l_io) !call routine of basis type
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
  END SUBROUTINE  mae_start


  LOGICAL FUNCTION mae_next_job(this,lastiter,noco)
    USE m_types_setup
    USE m_xmlOutput
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
    LOGICAL,INTENT(IN)                  :: lastiter
    !Stuff that might be modified...
    TYPE(t_noco),INTENT(INOUT) :: noco
       IF (.NOT.lastiter) THEN
          mae_next_job=this%t_forcetheo%next_job(lastiter,noco)
          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
78
       IF (.NOT.mae_next_job) RETURN
79 80 81

       noco%theta=this%theta(this%directions_done)
       noco%phi=this%phi(this%directions_done)
82
       noco%l_soc=.true.
83 84
       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/))
85 86
  END FUNCTION mae_next_job

87 88 89
  FUNCTION mae_eval(this,eig_id,DIMENSION,atoms,kpts,sym,&
       cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip)
    USE m_types
90 91 92 93
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
    LOGICAL :: skip
    !Stuff that might be used...
94 95 96 97 98 99 100 101 102 103 104 105 106
    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
107 108 109 110
    IF (this%directions_done==0) THEN
       skip=.FALSE.
       RETURN
    ENDIF
111 112 113 114 115 116 117 118 119 120 121 122
    this%evsum(this%directions_done)=results%seigv
    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)
123 124 125 126
    IF (this%directions_done==0) THEN
       RETURN
    ENDIF
    
127 128 129 130 131 132 133 134 135 136 137 138 139
    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
140
    CALL judft_end("Forcetheorem MAE")
141
  END SUBROUTINE mae_postprocess
142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158

  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
159
END MODULE m_types_mae