Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_types_mae
       8             :   USE m_types
       9             :   USE m_types_forcetheo
      10             :   USE m_judft
      11             :   IMPLICIT NONE
      12             :   PRIVATE
      13             :   TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_mae
      14             :      INTEGER :: directions_done
      15             :      REAL,ALLOCATABLE:: theta(:)
      16             :      REAL,ALLOCATABLE:: phi(:)
      17             :      REAL,ALLOCATABLE:: evsum(:)
      18             :    CONTAINS
      19             :      PROCEDURE :: start   =>mae_start
      20             :      PROCEDURE :: next_job=>mae_next_job
      21             :      PROCEDURE :: eval    =>mae_eval
      22             :      PROCEDURE :: postprocess => mae_postprocess
      23             :      PROCEDURE :: init   => mae_init !not overloaded
      24             :      PROCEDURE :: dist   => mae_dist !not overloaded
      25             :   END TYPE t_forcetheo_mae
      26             :   PUBLIC t_forcetheo_mae
      27             : CONTAINS
      28             : 
      29             : 
      30           0 :   SUBROUTINE mae_init(this,theta,phi,cell,sym)
      31             :     USE m_calculator
      32             :     USE m_socsym
      33             :     USE m_types
      34             :     IMPLICIT NONE
      35             :     CLASS(t_forcetheo_mae),INTENT(INOUT):: this
      36             :     TYPE(t_cell),INTENT(IN)             :: cell
      37             :     TYPE(t_sym),INTENT(IN)              :: sym
      38             :     REAL,INTENT(in)                     :: theta(:),phi(:)
      39             : 
      40             :     INTEGER::n
      41           0 :     LOGICAL::error(sym%nop)
      42           0 :     this%l_needs_vectors=.true.
      43             :    
      44           0 :     this%phi=phi
      45           0 :     this%theta=theta
      46             : 
      47           0 :     IF (SIZE(this%phi).NE.SIZE(this%theta)) CALL &
      48           0 :          judft_error("Lists for theta/phi must have the same length in MAE force theorem calculations")
      49           0 :     DO n=1,SIZE(this%phi)
      50           0 :        CALL soc_sym(sym%nop,sym%mrot,this%theta(n),this%phi(n),cell%amat,error)
      51           0 :        IF (ANY(error)) CALL judft_warn("Force theorem choice of SOC-SQA breaks symmetry")
      52             :     END DO
      53           0 :     ALLOCATE(this%evsum(SIZE(this%phi)))
      54           0 :     this%evsum=0
      55           0 :   END SUBROUTINE mae_init
      56             : 
      57             : 
      58           0 :   SUBROUTINE mae_start(this,potden,l_io)
      59             :     USE m_types_potden
      60             :     IMPLICIT NONE
      61             :     CLASS(t_forcetheo_mae),INTENT(INOUT):: this
      62             :     TYPE(t_potden) ,INTENT(INOUT)       :: potden
      63             :     LOGICAL,INTENT(IN)                  :: l_io
      64           0 :     this%directions_done=0
      65           0 :     CALL this%t_forcetheo%start(potden,l_io) !call routine of basis type
      66           0 :   END SUBROUTINE  mae_start
      67             : 
      68             : 
      69           0 :   LOGICAL FUNCTION mae_next_job(this,fmpi,lastiter,atoms,noco,nococonv)
      70             :     USE m_types_setup
      71             :     USE m_xmlOutput
      72             :     USE m_constants
      73             :     USE m_types_mpi
      74             :     IMPLICIT NONE
      75             :     CLASS(t_forcetheo_mae),INTENT(INOUT):: this
      76             :     TYPE(t_mpi), INTENT(IN)             :: fmpi
      77             :     LOGICAL,INTENT(IN)                  :: lastiter
      78             :     TYPE(t_atoms),INTENT(IN)            :: atoms
      79             :     TYPE(t_noco),INTENT(IN)             :: noco
      80             :     !Stuff that might be modified...
      81             :     TYPE(t_nococonv),INTENT(INOUT) :: nococonv
      82             :     CHARACTER(LEN=12):: attributes(2)
      83           0 :        IF (.NOT.lastiter) THEN
      84           0 :           mae_next_job=this%t_forcetheo%next_job(fmpi,lastiter,atoms,noco,nococonv)
      85           0 :           RETURN
      86             :        ENDIF
      87             :        !OK, now we start the MAE-loop
      88           0 :        this%l_in_forcetheo_loop = .true.
      89           0 :        this%directions_done=this%directions_done+1
      90           0 :        mae_next_job=(this%directions_done<=SIZE(this%phi)) !still angles to do
      91           0 :        IF (.NOT.mae_next_job) RETURN
      92             : 
      93           0 :        nococonv%theta=this%theta(this%directions_done)
      94           0 :        nococonv%phi=this%phi(this%directions_done)
      95           0 :        if (.not.noco%l_soc) call judft_error("Force theorem mode for MAE requires l_soc=T")
      96             :        !noco%l_soc=.true.
      97           0 :        IF (fmpi%irank .EQ. 0) THEN
      98           0 :           WRITE (*, *) "Started a Forcetheorem Loop"
      99           0 :           IF (this%directions_done.NE.1.AND.this%l_io) CALL closeXMLElement('Forcetheorem_Loop')
     100           0 :           WRITE(attributes(1),'(a)') 'MAE'
     101           0 :           WRITE(attributes(2),'(i5)') this%directions_done
     102           0 :           CALL openXMLElementPoly('Forcetheorem_Loop',(/'calculationType','No             '/),attributes)
     103             :        END IF
     104             :   END FUNCTION mae_next_job
     105             : 
     106           0 :   FUNCTION mae_eval(this,eig_id,atoms,kpts,sym,&
     107             :        cell,noco,nococonv, input,fmpi,  enpara,v,results)RESULT(skip)
     108             :     USE m_types
     109             :     IMPLICIT NONE
     110             :     CLASS(t_forcetheo_mae),INTENT(INOUT):: this
     111             :     LOGICAL :: skip
     112             :     !Stuff that might be used...
     113             :     TYPE(t_mpi),INTENT(IN)         :: fmpi
     114             : 
     115             :      
     116             :     TYPE(t_input),INTENT(IN)       :: input
     117             :     TYPE(t_noco),INTENT(IN)        :: noco
     118             :     TYPE(t_nococonv),INTENT(IN)    :: nococonv
     119             :     TYPE(t_sym),INTENT(IN)         :: sym
     120             :     TYPE(t_cell),INTENT(IN)        :: cell
     121             :     TYPE(t_kpts),INTENT(IN)        :: kpts
     122             :     TYPE(t_atoms),INTENT(IN)       :: atoms
     123             :     TYPE(t_enpara),INTENT(IN)      :: enpara
     124             :     TYPE(t_potden),INTENT(IN)      :: v
     125             :     TYPE(t_results),INTENT(IN)     :: results
     126             :     INTEGER,INTENT(IN)             :: eig_id
     127           0 :     IF (this%directions_done==0) THEN
     128           0 :        skip=.FALSE.
     129             :        RETURN
     130             :     ENDIF
     131           0 :     this%evsum(this%directions_done)=results%seigv
     132           0 :     skip=.TRUE.
     133           0 :   END FUNCTION  mae_eval
     134             : 
     135           0 :   SUBROUTINE mae_postprocess(this)
     136             :     USE m_xmlOutput
     137             :     IMPLICIT NONE
     138             :     CLASS(t_forcetheo_mae),INTENT(INOUT):: this
     139             : 
     140             :     !Locals
     141             :     INTEGER:: n
     142             :     CHARACTER(LEN=16):: attributes(3)
     143           0 :     IF (this%directions_done==0) THEN
     144           0 :        RETURN
     145             :     ENDIF
     146             : 
     147           0 :     IF (this%l_io) THEN
     148             :        !Now output the results
     149           0 :        CALL closeXMLElement('Forcetheorem_Loop')
     150           0 :        WRITE (*, *) "Finished last Forcetheorem Loop"
     151           0 :        attributes = ''
     152           0 :        WRITE(attributes(1),'(i5)') SIZE(this%evsum)
     153           0 :        WRITE(attributes(2),'(a)') 'Htr'
     154           0 :        CALL openXMLElement('Forcetheorem_MAE',(/'Angles','units '/),attributes(:2))
     155           0 :        DO n=1,SIZE(this%evsum)
     156           0 :           WRITE(attributes(1),'(f12.7)') this%theta(n)
     157           0 :           WRITE(attributes(2),'(f12.7)') this%phi(n)
     158           0 :           WRITE(attributes(3),'(f16.9)') this%evsum(n)
     159             :           CALL writeXMLElementForm('Angle',(/'theta ','phi   ','ev-sum'/),attributes,&
     160           0 :                RESHAPE((/5,3,6,12,12,16/),(/3,2/)))
     161             :        END DO
     162           0 :        CALL closeXMLElement('Forcetheorem_MAE')
     163             :     ENDIF
     164           0 :     CALL judft_end("Forcetheorem MAE")
     165             :   END SUBROUTINE mae_postprocess
     166             : 
     167           0 :   SUBROUTINE mae_dist(this,fmpi)
     168             : #ifdef CPP_MPI
     169             :     USE mpi
     170             : #endif
     171             :     USE m_types_mpi
     172             :     IMPLICIT NONE
     173             :     CLASS(t_forcetheo_mae),INTENT(INOUT):: this
     174             :     TYPE(t_mpi),INTENT(in):: fmpi
     175             : 
     176             :     INTEGER:: i,ierr
     177             : #ifdef CPP_MPI
     178           0 :     IF (fmpi%irank==0) i=SIZE(this%theta)
     179           0 :     call MPI_BCAST(i,1,MPI_INTEGER,0,fmpi%mpi_comm,ierr)
     180           0 :     IF (fmpi%irank.NE.0) ALLOCATE(this%phi(i),this%theta(i),this%evsum(i));this%evsum=0.0
     181           0 :     CALL MPI_BCAST(this%phi,i,MPI_DOUBLE_PRECISION,0,fmpi%mpi_comm,ierr)
     182           0 :     CALL MPI_BCAST(this%theta,i,MPI_DOUBLE_PRECISION,0,fmpi%mpi_comm,ierr)
     183             : #endif
     184           0 :   END SUBROUTINE mae_dist
     185           0 : END MODULE m_types_mae