distance.F90 3.72 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_distance
contains
8
  SUBROUTINE distance(irank,vol,jspins,fsm,inden,outden,results,fsm_mag)
9 10 11
    use m_types
    use m_types_mixvector
    use m_xmlOutput
12
 
13
    implicit none
14
    integer,intent(in)             :: irank,jspins
15
    real,intent(in)                :: vol
16
    type(t_mixvector),INTENT(IN)   :: fsm
17
    TYPE(t_potden),INTENT(INOUT)   :: inden,outden
18
    TYPE(t_results),INTENT(INOUT)  :: results
19
    type(t_mixvector),INTENT(OUT)  :: fsm_mag
Daniel Wortmann's avatar
Daniel Wortmann committed
20
    
21 22
    integer         ::js
    REAL            :: dist(6) !1:up,2:down,3:spinoff,4:total,5:magnet,6:noco
Daniel Wortmann's avatar
Daniel Wortmann committed
23
    TYPE(t_mixvector)::fmMet
24
    character(len=100)::attributes(2)
25
    
26
    CALL fmMet%alloc()
Daniel Wortmann's avatar
Daniel Wortmann committed
27 28 29 30
    IF (jspins==2) THEN
       CALL fsm_mag%alloc()
       ! calculate Magnetisation-difference
       CALL fsm_mag%from_density(outden,swapspin=.TRUE.)
31 32
       call fmMet%from_density(inden,swapspin=.true.)
       fsm_mag=fsm_mag-fmMet
Daniel Wortmann's avatar
Daniel Wortmann committed
33
    ENDIF
34
    ! Apply metric w to fsm and store in fmMet:  w |fsm>
35 36 37
    fmMet=fsm%apply_metric()
  
    dist(:) = 0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
38
    DO js = 1,jspins
39 40
       dist(js) = fsm%multiply_dot_mask(fmMet,(/.true.,.true.,.true.,.false./),js)
    END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
41
    IF (SIZE(outden%pw,2)>2) dist(6) = fsm%multiply_dot_mask(fmMet,(/.TRUE.,.TRUE.,.TRUE.,.FALSE./),3)
Daniel Wortmann's avatar
Daniel Wortmann committed
42
    IF (jspins.EQ.2) THEN
43
       dist(3) = fmMet%multiply_dot_mask(fsm_mag,(/.true.,.true.,.true.,.false./),1)
44 45
       dist(4) = dist(1) + dist(2) + 2.0e0*dist(3)
       dist(5) = dist(1) + dist(2) - 2.0e0*dist(3)
Daniel Wortmann's avatar
Daniel Wortmann committed
46 47
    ENDIF
    
48
    results%last_distance=maxval(1000*SQRT(ABS(dist/vol)))
49
    if (irank>0) return
50 51 52
    !calculate the distance of charge densities for each spin
    CALL openXMLElement('densityConvergence',(/'units'/),(/'me/bohr^3'/))
    
Daniel Wortmann's avatar
Daniel Wortmann committed
53
    DO js = 1,jspins         
54 55 56 57
       attributes = ''
       WRITE(attributes(1),'(i0)') js
       WRITE(attributes(2),'(f20.10)') 1000*SQRT(ABS(dist(js)/vol))
       CALL writeXMLElementForm('chargeDensity',(/'spin    ','distance'/),attributes,reshape((/4,8,1,20/),(/2,2/)))
58
       WRITE ( 6,FMT=7900) js,inDen%iter,1000*SQRT(ABS(dist(js)/vol))
59 60
    END DO
    
61
    IF (abs(dist(6))>1E-15) WRITE (6,FMT=7900) 3,inDen%iter,1000*SQRT(ABS(dist(6)/vol))
62 63 64 65
    
    !calculate the distance of total charge and spin density
    !|rho/m(o) - rho/m(i)| = |rh1(o) -rh1(i)|+ |rh2(o) -rh2(i)| +/_
    !                        +/_2<rh2(o) -rh2(i)|rh1(o) -rh1(i)>
Daniel Wortmann's avatar
Daniel Wortmann committed
66
    IF (jspins.EQ.2) THEN
67 68 69 70
       CALL writeXMLElementFormPoly('overallChargeDensity',(/'distance'/),&
            (/1000*SQRT(ABS(dist(4)/vol))/),reshape((/10,20/),(/1,2/)))
       CALL writeXMLElementFormPoly('spinDensity',(/'distance'/),&
            (/1000*SQRT(ABS(dist(5)/vol))/),reshape((/19,20/),(/1,2/)))
71 72
       WRITE ( 6,FMT=8000) inDen%iter,1000*SQRT(ABS(dist(4)/vol))
       WRITE ( 6,FMT=8010) inDen%iter,1000*SQRT(ABS(dist(5)/vol))
73 74 75 76 77 78
       
       !dist/vol should always be >= 0 ,
       !but for dist=0 numerically you might obtain dist/vol < 0
       !(e.g. when calculating non-magnetic systems with jspins=2).
    END IF
    CALL closeXMLElement('densityConvergence')
79 80


81 82 83 84 85 86 87
7900  FORMAT (/,'---->    distance of charge densities for spin ',i2,'                 it=',i5,':',f13.6,' me/bohr**3')
8000 FORMAT (/,'---->    distance of charge densities for it=',i5,':', f13.6,' me/bohr**3')
8010 FORMAT (/,'---->    distance of spin densities for it=',i5,':', f13.6,' me/bohr**3')
8020 FORMAT (4d25.14)
8030  FORMAT (10i10)
  end SUBROUTINE distance
end module m_distance