mae.F90 5 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
!--------------------------------------------------------------------------------
! 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
  USE m_judft
  USE m_types_forcetheo
  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
20 21
     PROCEDURE :: init   => mae_init !not overloaded
     PROCEDURE :: dist   => mae_dist !not overloaded
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
  END TYPE t_forcetheo_mae

CONTAINS
  SUBROUTINE mae_init(this,theta_s,phi_s)
    USE m_calculator
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
    CHARACTER(len=*),INTENT(INOUT)      :: theta_s,phi_s

    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")
    ALLOCATE(this%evsum(SIZE(this%phi)))
    this%evsum=0
  END SUBROUTINE mae_init
    

  SUBROUTINE mae_start(this)
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
    this%directions_done=0
    CALL this%t_forcetheo%start() !call routine of basis type
  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
64
       IF (.NOT.mae_next_job) RETURN
65 66 67

       noco%theta=this%theta(this%directions_done)
       noco%phi=this%phi(this%directions_done)
68
       noco%l_soc=.true.
69 70 71 72
       IF (this%directions_done.NE.1) CALL closeXMLElement('Forcetheorem_Loop_MAE')
       CALL openXMLElementPoly('Forcetheorem_Loop_MAE',(/'No'/),(/this%directions_done/))
  END FUNCTION mae_next_job

73 74 75
  FUNCTION mae_eval(this,eig_id,DIMENSION,atoms,kpts,sym,&
       cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip)
    USE m_types
76 77 78 79
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
    LOGICAL :: skip
    !Stuff that might be used...
80 81 82 83 84 85 86 87 88 89 90 91 92
    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
93 94 95 96
    IF (this%directions_done==0) THEN
       skip=.FALSE.
       RETURN
    ENDIF
97 98 99 100 101 102 103 104 105 106 107 108
    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)
109 110 111 112
    IF (this%directions_done==0) THEN
       RETURN
    ENDIF
    
113 114
    !Now output the results
    call closeXMLElement('Forcetheorem_Loop_MAE')
115
    CALL openXMLElementPoly('Forcetheorem_MAE',(/'Angles'/),(/SIZE(this%evsum)/))
116 117 118 119 120 121 122 123
    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')
124
    CALL judft_end("Forcetheorem MAE")
125
  END SUBROUTINE mae_postprocess
126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142

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