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 : module m_distance
7 : contains
8 664 : SUBROUTINE distance(irank,vol,jspins,nmzxyd,fsm,inden,outden,results,fsm_mag)
9 : use m_types
10 : use m_types_mixvector
11 : USE m_constants
12 : use m_xmlOutput
13 :
14 : implicit none
15 : integer,intent(in) :: irank,jspins,nmzxyd
16 : real,intent(in) :: vol
17 : type(t_mixvector),INTENT(IN) :: fsm
18 : TYPE(t_potden),INTENT(INOUT) :: inden,outden
19 : TYPE(t_results),INTENT(INOUT) :: results
20 : type(t_mixvector),INTENT(OUT) :: fsm_mag
21 :
22 : integer ::js
23 : REAL :: dist(6) !1:up,2:down,3:spinoff,4:total,5:magnet,6:noco
24 664 : TYPE(t_mixvector)::fmMet
25 : character(len=100)::attributes(2)
26 :
27 664 : CALL fmMet%alloc()
28 664 : IF (jspins==2) THEN
29 390 : CALL fsm_mag%alloc()
30 : ! calculate Magnetisation-difference
31 390 : CALL fsm_mag%from_density(outden,nmzxyd,swapspin=.TRUE.)
32 390 : call fmMet%from_density(inden,nmzxyd,swapspin=.true.)
33 390 : fsm_mag=fsm_mag-fmMet
34 : ENDIF
35 : ! Apply metric w to fsm and store in fmMet: w |fsm>
36 664 : fmMet=fsm%apply_metric(.FALSE.)
37 :
38 664 : dist(:) = 0.0
39 1718 : DO js = 1,jspins
40 1718 : dist(js) = fsm%multiply_dot_mask(fmMet,(/.true.,.true.,.true.,.false./),js)
41 : END DO
42 664 : IF (SIZE(outden%pw,2)>2) dist(6) = fsm%multiply_dot_mask(fmMet,(/.TRUE.,.TRUE.,.TRUE.,.FALSE./),3)
43 664 : IF (jspins.EQ.2) THEN
44 390 : dist(3) = fmMet%multiply_dot_mask(fsm_mag,(/.true.,.true.,.true.,.false./),1)
45 390 : dist(4) = dist(1) + dist(2) + 2.0e0*dist(3)
46 390 : dist(5) = dist(1) + dist(2) - 2.0e0*dist(3)
47 : ENDIF
48 :
49 4648 : results%last_distance=maxval(1000*SQRT(ABS(dist/vol)))
50 1992 : if (irank>0) return
51 : !calculate the distance of charge densities for each spin
52 996 : CALL openXMLElement('densityConvergence',(/'units'/),(/'me/bohr^3'/))
53 :
54 859 : DO js = 1,jspins
55 1581 : attributes = ''
56 527 : WRITE(attributes(1),'(i0)') js
57 527 : WRITE(attributes(2),'(f20.10)') 1000*SQRT(ABS(dist(js)/vol))
58 1581 : CALL writeXMLElementForm('chargeDensity',(/'spin ','distance'/),attributes,reshape((/4,8,1,20/),(/2,2/)))
59 859 : WRITE (oUnit,FMT=7900) js,inDen%iter,1000*SQRT(ABS(dist(js)/vol))
60 : END DO
61 :
62 332 : IF (SIZE(outden%pw,2)>2) WRITE (oUnit,FMT=7900) 3,inDen%iter,1000*SQRT(ABS(dist(6)/vol))
63 :
64 : !calculate the distance of total charge and spin density
65 : !|rho/m(o) - rho/m(i)| = |rh1(o) -rh1(i)|+ |rh2(o) -rh2(i)| +/_
66 : ! +/_2<rh2(o) -rh2(i)|rh1(o) -rh1(i)>
67 332 : IF (jspins.EQ.2) THEN
68 : CALL writeXMLElementFormPoly('overallChargeDensity',(/'distance'/),&
69 585 : (/1000*SQRT(ABS(dist(4)/vol))/),reshape((/10,20/),(/1,2/)))
70 : CALL writeXMLElementFormPoly('spinDensity',(/'distance'/),&
71 585 : (/1000*SQRT(ABS(dist(5)/vol))/),reshape((/19,20/),(/1,2/)))
72 195 : WRITE (oUnit,FMT=8000) inDen%iter,1000*SQRT(ABS(dist(4)/vol))
73 195 : WRITE (oUnit,FMT=8010) inDen%iter,1000*SQRT(ABS(dist(5)/vol))
74 :
75 : !dist/vol should always be >= 0 ,
76 : !but for dist=0 numerically you might obtain dist/vol < 0
77 : !(e.g. when calculating non-magnetic systems with jspins=2).
78 : END IF
79 332 : CALL closeXMLElement('densityConvergence')
80 :
81 :
82 : 7900 FORMAT (/,'----> distance of charge densities for spin ',i2,' it=',i5,':',f13.6,' me/bohr**3')
83 : 8000 FORMAT (/,'----> distance of charge densities for it=',i5,':', f13.6,' me/bohr**3')
84 : 8010 FORMAT (/,'----> distance of spin densities for it=',i5,':', f13.6,' me/bohr**3')
85 : 8020 FORMAT (4d25.14)
86 : 8030 FORMAT (10i10)
87 1992 : end SUBROUTINE distance
88 :
89 0 : SUBROUTINE dfpt_distance(irank,vol,jspins,nmzxyd,fsm,inden,outden,indenIm,outdenIm,results,fsm_mag)
90 : USE m_types
91 : USE m_types_mixvector
92 : USE m_constants
93 : USE m_xmlOutput
94 :
95 : IMPLICIT NONE
96 :
97 : INTEGER, INTENT(IN) :: irank,jspins,nmzxyd
98 : REAL, INTENT(IN) :: vol
99 :
100 : TYPE(t_mixvector), INTENT(IN) :: fsm
101 : TYPE(t_potden), INTENT(INOUT) :: inden,outden,indenIm,outdenIm
102 : TYPE(t_results), INTENT(INOUT) :: results
103 : TYPE(t_mixvector), INTENT(OUT) :: fsm_mag
104 :
105 : INTEGER :: js
106 : REAL :: dist(7,2)
107 :
108 0 : TYPE(t_mixvector) :: fmMet
109 :
110 0 : CALL fmMet%alloc()
111 0 : IF (jspins==2) THEN
112 0 : CALL fsm_mag%alloc()
113 : ! calculate Magnetisation-difference
114 0 : CALL fsm_mag%from_density(outden,nmzxyd,swapspin=.TRUE.,denIm=outDenIm)
115 0 : CALL fmMet%from_density(inden,nmzxyd,swapspin=.TRUE.,denIm=inDenIm)
116 0 : fsm_mag=fsm_mag-fmMet
117 : END IF
118 :
119 : ! Apply metric w to fsm and store in fmMet: w |fsm>
120 0 : fmMet=fsm%apply_metric(.TRUE.)
121 :
122 0 : dist(:,:) = 0.0
123 0 : DO js = 1,jspins
124 0 : CALL fsm%dfpt_multiply_dot_mask(fmMet,(/.TRUE.,.TRUE.,.TRUE./),js,dist(js,:))
125 : END DO
126 0 : IF (SIZE(outden%pw,2)>2) THEN
127 0 : CALL fsm%dfpt_multiply_dot_mask(fmMet,(/.TRUE.,.TRUE.,.TRUE./),3,dist(6,:),dist(7,:))
128 : END IF
129 0 : IF (jspins.EQ.2) THEN
130 0 : CALL fmMet%dfpt_multiply_dot_mask(fsm_mag,(/.TRUE.,.TRUE.,.TRUE./),1,dist(3,:))
131 0 : dist(4,:) = dist(1,:) + dist(2,:) + 2.0e0*dist(3,:)
132 0 : dist(5,:) = dist(1,:) + dist(2,:) - 2.0e0*dist(3,:)
133 : END IF
134 :
135 0 : results%last_distance=maxval(1000*SQRT(ABS(dist/vol)))
136 0 : if (irank>0) return
137 : !calculate the distance of charge densities for each spin
138 :
139 0 : DO js = 1,jspins
140 0 : WRITE (oUnit,FMT=7900) js,inDen%iter,1000*SQRT(ABS(dist(js,1)/vol))
141 0 : WRITE (oUnit,FMT=7901) js,inDen%iter,1000*SQRT(ABS(dist(js,2)/vol))
142 : END DO
143 :
144 0 : IF (SIZE(outden%pw,2)>2) THEN
145 0 : WRITE (oUnit,FMT=7900) 3,inDen%iter,1000*SQRT(ABS(dist(6,1)/vol))
146 0 : WRITE (oUnit,FMT=7901) 3,inDen%iter,1000*SQRT(ABS(dist(6,2)/vol))
147 0 : WRITE (oUnit,FMT=7900) 4,inDen%iter,1000*SQRT(ABS(dist(7,1)/vol))
148 0 : WRITE (oUnit,FMT=7901) 4,inDen%iter,1000*SQRT(ABS(dist(7,2)/vol))
149 : END IF
150 :
151 0 : IF (jspins.EQ.2) THEN
152 0 : WRITE (oUnit,FMT=8000) inDen%iter,1000*SQRT(ABS(dist(4,1)/vol))
153 0 : WRITE (oUnit,FMT=8001) inDen%iter,1000*SQRT(ABS(dist(4,2)/vol))
154 0 : WRITE (oUnit,FMT=8010) inDen%iter,1000*SQRT(ABS(dist(5,1)/vol))
155 0 : WRITE (oUnit,FMT=8011) inDen%iter,1000*SQRT(ABS(dist(5,2)/vol))
156 : END IF
157 :
158 : 7900 FORMAT (/,'----> distance of charge density perturbation real part for spin ',i2,' it=',i5,':',f13.6,' me/bohr**3')
159 : 7901 FORMAT (/,'----> distance of charge density perturbation imag part for spin ',i2,' it=',i5,':',f13.6,' me/bohr**3')
160 : 8000 FORMAT (/,'----> distance of charge density perturbation real part for it=',i5,':', f13.6,' me/bohr**3')
161 : 8001 FORMAT (/,'----> distance of charge density perturbation imag part for it=',i5,':', f13.6,' me/bohr**3')
162 : 8010 FORMAT (/,'----> distance of spin density perturbation real part for it=',i5,':', f13.6,' me/bohr**3')
163 : 8011 FORMAT (/,'----> distance of spin density perturbation imag part for it=',i5,':', f13.6,' me/bohr**3')
164 0 : END SUBROUTINE dfpt_distance
165 : end module m_distance
|
