mae.F90 5.09 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 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
  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
    

42 43
  SUBROUTINE mae_start(this,potden)
    USE m_types_potden
44 45
    IMPLICIT NONE
    CLASS(t_forcetheo_mae),INTENT(INOUT):: this
46
    TYPE(t_potden) ,INTENT(INOUT)       :: potden
47
    this%directions_done=0
48
    CALL this%t_forcetheo%start(potden) !call routine of basis type
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
  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
67
       IF (.NOT.mae_next_job) RETURN
68 69 70

       noco%theta=this%theta(this%directions_done)
       noco%phi=this%phi(this%directions_done)
71
       noco%l_soc=.true.
72 73 74 75
       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

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

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