LCOV - code coverage report
Current view: top level - forcetheorem - ssdisp.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 58 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 8 0.0 %

          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_ssdisp
       8             : 
       9             :   USE m_types
      10             :   USE m_types_forcetheo
      11             :   USE m_judft
      12             :   TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_ssdisp
      13             :      INTEGER :: q_done
      14             :      REAL,ALLOCATABLE:: qvec(:,:)
      15             :      REAL,ALLOCATABLE:: evsum(:)
      16             :    CONTAINS
      17             :      PROCEDURE :: start   =>ssdisp_start
      18             :      PROCEDURE :: next_job=>ssdisp_next_job 
      19             :      PROCEDURE :: eval    =>ssdisp_eval
      20             :      PROCEDURE :: postprocess => ssdisp_postprocess
      21             :      PROCEDURE :: init   => ssdisp_init !not overloaded
      22             :      PROCEDURE :: dist   => ssdisp_dist !not overloaded
      23             :   END TYPE t_forcetheo_ssdisp
      24             : 
      25             : CONTAINS
      26             : 
      27           0 :   SUBROUTINE ssdisp_init(this,q)
      28             :     USE m_calculator
      29             :     USE m_constants
      30             :     IMPLICIT NONE
      31             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
      32             :     REAL,INTENT(in)                     :: q(:,:)
      33             :     
      34           0 :     ALLOCATE(this%qvec(3,SIZE(q,2)))
      35           0 :     this%qvec=q
      36             :     
      37           0 :     ALLOCATE(this%evsum(SIZE(q,2)))
      38           0 :     this%evsum=0
      39           0 :   END SUBROUTINE ssdisp_init
      40             : 
      41           0 :   SUBROUTINE ssdisp_start(this,potden,l_io)
      42             :     USE m_types_potden
      43             :     IMPLICIT NONE
      44             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
      45             :     TYPE(t_potden) ,INTENT(INOUT)          :: potden
      46             :     LOGICAL,INTENT(IN)                     :: l_io
      47           0 :     this%q_done=0
      48           0 :     CALL this%t_forcetheo%start(potden,l_io) !call routine of basis type
      49             : 
      50           0 :     IF (SIZE(potden%pw,2)<2) RETURN
      51             :     !Average out magnetic part of potential/charge in INT+Vacuum
      52           0 :     potden%pw(:,1)=(potden%pw(:,1)+potden%pw(:,2))/2.0
      53           0 :     potden%pw(:,2)=potden%pw(:,1)
      54             :     
      55           0 :     potden%vacz(:,:,1)=(potden%vacz(:,:,1)+potden%vacz(:,:,2))/2.0
      56           0 :     potden%vacxy(:,:,:,1)=(potden%vacxy(:,:,:,1)+potden%vacxy(:,:,:,2))/2.0
      57           0 :     potden%vacz(:,:,2)=potden%vacz(:,:,1)
      58           0 :     potden%vacxy(:,:,:,2)=potden%vacxy(:,:,:,1)
      59             :     !Off diagonal part
      60           0 :     IF (SIZE(potden%pw,2)==3) THEN
      61           0 :        potden%pw(:,3)=0.0
      62           0 :        potden%vacz(:,:,3:)=0.0
      63           0 :        potden%vacxy(:,:,:,3)=0.0
      64             :     END IF
      65             :     
      66             :   END SUBROUTINE  ssdisp_start
      67             : 
      68           0 :   LOGICAL FUNCTION ssdisp_next_job(this,lastiter,atoms,noco)
      69             :     USE m_types_setup
      70             :     USE m_xmlOutput
      71             :     USE m_constants
      72             :     IMPLICIT NONE
      73             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
      74             :     LOGICAL,INTENT(IN)                  :: lastiter
      75             :     TYPE(t_atoms),INTENT(IN)            :: atoms
      76             :     !Stuff that might be modified...
      77             :     TYPE(t_noco),INTENT(INOUT) :: noco
      78             :     INTEGER                    :: itype
      79           0 :     IF (.NOT.lastiter) THEN
      80           0 :        ssdisp_next_job=this%t_forcetheo%next_job(lastiter,atoms,noco)
      81           0 :        RETURN
      82             :     ENDIF
      83             :     !OK, now we start the SSDISP-loop
      84           0 :     this%q_done=this%q_done+1
      85           0 :     ssdisp_next_job=(this%q_done<=SIZE(this%qvec,2)) !still q-vectors to do
      86           0 :     IF (.NOT.ssdisp_next_job) RETURN
      87             :     
      88             :     !Now modify the noco-file
      89           0 :     noco%qss=this%qvec(:,this%q_done)
      90             :     !Modify the alpha-angles
      91           0 :     DO iType = 1,atoms%ntype
      92           0 :        noco%alph(iType) = noco%alphInit(iType) + tpi_const*dot_PRODUCT(noco%qss,atoms%taual(:,SUM(atoms%neq(:itype-1))+1))
      93             :     END DO
      94           0 :     IF (.NOT.this%l_io) RETURN
      95           0 :     IF (this%q_done.NE.1) CALL closeXMLElement('Forcetheorem_Loop_SSDISP')
      96           0 :     CALL openXMLElementPoly('Forcetheorem_Loop_SSDISP',(/'Q-vec'/),(/this%q_done/))
      97           0 :   END FUNCTION ssdisp_next_job
      98             : 
      99           0 :   SUBROUTINE ssdisp_postprocess(this)
     100             :     USE m_xmlOutput
     101             :     IMPLICIT NONE
     102             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
     103             : 
     104             :     !Locals
     105             :     INTEGER:: n,q
     106             :     CHARACTER(LEN=12):: attributes(4)
     107           0 :     IF (this%q_done==0) RETURN
     108             :     !Now output the results
     109           0 :     IF (this%l_io) THEN
     110           0 :        CALL closeXMLElement('Forcetheorem_Loop_SSDISP')
     111           0 :        CALL openXMLElementPoly('Forcetheorem_SSDISP',(/'qvectors'/),(/SIZE(this%evsum)/))
     112           0 :        DO q=1,SIZE(this%evsum)
     113           0 :           WRITE(attributes(1),'(i5)') q
     114           0 :           WRITE(attributes(2),'(f12.7)') this%evsum(q) 
     115             :           CALL writeXMLElementForm('Entry',(/'q     ','ev-sum'/),attributes(1:2),&
     116           0 :                RESHAPE((/1,6,5,12/),(/2,2/)))
     117             :        ENDDO
     118           0 :        CALL closeXMLElement('Forcetheorem_SSDISP')
     119             :     ENDIF
     120           0 :     CALL judft_end("Forcetheorem:SpinSpiralDispersion")
     121             :   END SUBROUTINE ssdisp_postprocess
     122             : 
     123           0 :   SUBROUTINE ssdisp_dist(this,mpi)
     124             :     USE m_types_mpi
     125             :     IMPLICIT NONE
     126             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
     127             :     TYPE(t_mpi),INTENT(in):: mpi
     128             :     
     129             :     INTEGER:: q,ierr
     130             : #ifdef CPP_MPI    
     131             :     INCLUDE 'mpif.h'
     132           0 :     IF (mpi%irank==0) q=SIZE(this%qvec,2)
     133           0 :     CALL MPI_BCAST(q,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
     134           0 :     IF (mpi%irank.NE.0) ALLOCATE(this%qvec(3,q),this%evsum(q));this%evsum=0.0
     135           0 :     CALL MPI_BCAST(this%qvec,3*q,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     136             : #endif    
     137           0 :   END SUBROUTINE ssdisp_dist
     138             : 
     139           0 :   FUNCTION ssdisp_eval(this,eig_id,DIMENSION,atoms,kpts,sym,&
     140             :        cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip)
     141             :      USE m_types
     142             :      USE m_ssomat
     143             :     IMPLICIT NONE
     144             :     CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
     145             :     LOGICAL :: skip
     146             :     !Stuff that might be used...
     147             :     TYPE(t_mpi),INTENT(IN)         :: mpi
     148             :     TYPE(t_dimension),INTENT(IN)   :: dimension
     149             :     TYPE(t_oneD),INTENT(IN)        :: oneD
     150             :     TYPE(t_input),INTENT(IN)       :: input
     151             :     TYPE(t_noco),INTENT(IN)        :: noco
     152             :     TYPE(t_sym),INTENT(IN)         :: sym
     153             :     TYPE(t_cell),INTENT(IN)        :: cell
     154             :     TYPE(t_kpts),INTENT(IN)        :: kpts
     155             :     TYPE(t_atoms),INTENT(IN)       :: atoms
     156             :     TYPE(t_enpara),INTENT(IN)      :: enpara
     157             :     TYPE(t_potden),INTENT(IN)      :: v
     158             :     TYPE(t_results),INTENT(IN)     :: results
     159             :     INTEGER,INTENT(IN)             :: eig_id
     160           0 :     skip=.FALSE.
     161           0 :     IF (this%q_done==0) RETURN
     162             :   
     163           0 :     this%evsum(this%q_done)=results%seigv
     164           0 :     skip=.TRUE.
     165           0 :   END FUNCTION  ssdisp_eval
     166             : 
     167             :   
     168           0 : END MODULE m_types_ssdisp

Generated by: LCOV version 1.13