← Back to branch summary

~aakhtar/siesta/spglib-inclusion

« back to all changes in this revision

Viewing changes to Util/pseudo-xml/xml2psf_helper.f

  • Committer: Alberto Garcia
  • Date: 2016-06-23 10:02:59 UTC
  • mto: (462.26.1 4.1-ag)
  • mto: This revision was merged to the branch mainline in revision 469.
  • Revision ID: albertog@icmab.es-20160623100259-mewju7fsd2toyp1r
Tags: 4.0-release, v4.0
Release of siesta-4.0

* Update Docs/release_notes.4.0

* Update list of contributors.

* Add some more documentation and comments, and clarify notes in
  output for the recet electric-field/slab-dipole-correction fix.

* Remove Util/pseudo-xml

* Other minor changes in README files


  
                

        

Show diffs side-by-side

added added

removed removed

Lines of Context:
Util/pseudo-xml/xml2psf_helper.f
1
 
! ---
2
 
! Copyright (C) 1996-2016       The SIESTA group
3
 
!  This file is distributed under the terms of the
4
 
!  GNU General Public License: see COPYING in the top directory
5
 
!  or http://www.gnu.org/copyleft/gpl.txt .
6
 
! See Docs/Contributors.txt for a list of contributors.
7
 
! ---
8
 
        subroutine xml2psf_helper( psxml, p )
9
 
 
10
 
! Translate the more complete xml format and data structure 
11
 
! into the old Siesta type for the pseudopotential
12
 
 
13
 
        use m_pseudo_types
14
 
        use pseudopotential
15
 
 
16
 
        implicit none 
17
 
 
18
 
        integer, parameter  :: dp = selected_real_kind(14)
19
 
 
20
 
 
21
 
        type(pseudo_t), intent(in)                 :: psxml
22
 
        type(pseudopotential_t), intent(out)       :: p
23
 
 
24
 
        integer          :: position, i, il, ir, lmax, lshellint
25
 
        character(len=1) :: ispp, lshell
26
 
        logical          :: polarized
27
 
        real(dp)         :: zeld(0:4), zelu(0:4)
28
 
        real(dp)         :: r2
29
 
 
30
 
 
31
 
        p%name         = psxml%header%symbol
32
 
        p%nr           = psxml%pot(1)%V%grid%npts
33
 
        p%nrval        = p%nr + 1
34
 
        p%zval         = psxml%header%zval
35
 
! relativistic and correlation are not needed in Siesta, so they are
36
 
! not translated
37
 
        select case(psxml%header%xcfunctionalparametrization)
38
 
          case('Ceperley-Alder')
39
 
             p%icorr = 'ca'
40
 
          case('Wigner')
41
 
             p%icorr = 'wi'
42
 
          case('Hedin-Lundqvist')
43
 
             p%icorr = 'hl'
44
 
          case('Gunnarson-Lundqvist')
45
 
             p%icorr = 'gl'
46
 
          case('von Barth-Hedin')
47
 
             p%icorr = 'bh'
48
 
          case('Perdew-Burke-Ernzerhof')
49
 
             p%icorr = 'pb'
50
 
          case('RPBE - Hammer et al')
51
 
             p%icorr = 'rp'
52
 
          case('revPBE Zhang+Yang')
53
 
             p%icorr = 'rv'
54
 
          case('Becke-Lee-Yang-Parr')
55
 
             p%icorr = 'bl'
56
 
          case('Dion-et-al')
57
 
             p%icorr = 'vw'
58
 
          case('Wu-Cohen')
59
 
             p%icorr = 'wc'
60
 
          case('Perdew-Burke-Ernzerhof-solid')
61
 
             p%icorr = 'ps'
62
 
        end select
63
 
 
64
 
        select case(psxml%header%relativistic)
65
 
          case(.true.)
66
 
            p%irel    = 'rel'
67
 
            ispp      = 'r'
68
 
            polarized = .false.
69
 
          case(.false.)
70
 
            select case(psxml%header%polarized)
71
 
              case(.true.)
72
 
                p%irel    = 'isp'
73
 
                ispp      = 's'
74
 
                polarized = .true.
75
 
              case(.false.)
76
 
                p%irel    = 'nrl'
77
 
                ispp      = ' '
78
 
                polarized = .false.
79
 
            end select
80
 
        end select
81
 
 
82
 
        select case(psxml%header%core_corrections)
83
 
          case("yes")
84
 
            p%nicore = 'pcec'
85
 
          case("no")
86
 
            p%nicore = 'nc'
87
 
        end select
88
 
 
89
 
        p%a            = psxml%pot(1)%V%grid%step
90
 
        p%b            = psxml%pot(1)%V%grid%scale
91
 
 
92
 
        p%method(1)    = psxml%header%creator
93
 
        p%method(2)    = psxml%header%date
94
 
        read(psxml%header%flavor,'(4a10)') (p%method(i),i=3,6) 
95
 
 
96
 
        p%npotu        = psxml%npots_up
97
 
        p%npotd        = psxml%npots_down
98
 
 
99
 
! Allocate the radial variables and semilocal potentials
100
 
        allocate(p%r(1:p%nrval))
101
 
        allocate(p%chcore(1:p%nrval))
102
 
        allocate(p%chval(1:p%nrval))
103
 
 
104
 
        if (p%npotd.gt.0) then
105
 
           allocate(p%vdown(1:p%npotd,1:p%nrval))
106
 
           allocate(p%ldown(1:p%npotd))
107
 
        endif
108
 
 
109
 
        if (p%npotu.gt.0) then
110
 
           allocate(p%vup(1:p%npotu,1:p%nrval))
111
 
           allocate(p%lup(1:p%npotu))
112
 
        endif
113
 
! ---
114
 
 
115
 
! Calculate the points of the logarithmic radial grid 
116
 
        do 30 ir = 1, p%nrval
117
 
          p%r(ir) = p%b * (exp(p%a*(ir-1))-1)
118
 
 30     enddo
119
 
! ---
120
 
 
121
 
! Translate the valence charge density and the pseudo-core charge density,
122
 
! and define the value at the first point of the logarithmic grid
123
 
        p%chcore(2:p%nrval) = psxml%core_charge%data(1:p%nr)
124
 
        p%chval(2:p%nrval)  = psxml%valence_charge%data(1:p%nr)
125
 
        r2=p%r(2)/(p%r(3)-p%r(2))
126
 
        p%chcore(1) = p%chcore(2) - r2*(p%chcore(3)-p%chcore(2))
127
 
        p%chval(1) = p%chval(2) - r2*(p%chval(3)-p%chval(2))
128
 
! ---
129
 
 
130
 
        zeld(:) = 0.0d0
131
 
        zelu(:) = 0.0d0
132
 
 
133
 
        do il = 1, p%npotd
134
 
          lshell = psxml%pot(il)%l
135
 
          select case(lshell)
136
 
            case('s') 
137
 
              lshellint = 0
138
 
            case('p') 
139
 
              lshellint = 1
140
 
            case('d') 
141
 
              lshellint = 2
142
 
            case('f') 
143
 
              lshellint = 3
144
 
          end select
145
 
          p%ldown(il) = lshellint
146
 
          p%vdown(il,2:p%nrval) = psxml%pot(il)%V%data(1:p%nr)
147
 
          zeld(lshellint) = psxml%pot(il)%occupation
148
 
        enddo
149
 
 
150
 
        do il = 1, p%npotu
151
 
          lshell = psxml%pot(p%npotd+il)%l
152
 
          select case(lshell)
153
 
            case('s') 
154
 
              lshellint = 0
155
 
            case('p') 
156
 
              lshellint = 1
157
 
            case('d') 
158
 
              lshellint = 2
159
 
            case('f') 
160
 
              lshellint = 3
161
 
          end select
162
 
          p%lup(il) = lshellint
163
 
          p%vup(il,2:p%nrval) = psxml%pot(p%npotd+il)%V%data(1:p%nr)
164
 
          zelu(lshellint) = psxml%pot(p%npotd+il)%occupation
165
 
        enddo
166
 
 
167
 
        p%text = ' '
168
 
        position = 1
169
 
        lmax = max(p%npotd, p%npotu)
170
 
        do 240 il = 1, lmax
171
 
           if ( .not. polarized) then
172
 
              write(p%text(position:),9070) 
173
 
     .                                      psxml%pot(il)%n,
174
 
     .                                      psxml%pot(il)%l,
175
 
     .                                      zeld(il-1)+zelu(il-1), 
176
 
     .                                      ispp, 
177
 
     .                                      psxml%pot(il)%cutoff
178
 
 9070         format(i1,a1,f5.2,a1,' r=',f5.2,'/')
179
 
              position = position + 17
180
 
           else
181
 
              write(p%text(position:),9090)
182
 
     .                                      psxml%pot(il)%n,
183
 
     .                                      psxml%pot(il)%l,
184
 
     .                                      zeld(il-1), 
185
 
     .                                      zelu(il-1), 
186
 
     .                                      ispp, 
187
 
     .                                      psxml%pot(il)%cutoff
188
 
 9090         format(i1,a1,f4.2,',',f4.2,a1,f4.2,'/')
189
 
              position = position + 17
190
 
           end if
191
 
  240   enddo
192
 
 
193
 
       
194
 
! For debugging -------------------------------------------------------
195
 
!        write(6,*)p%name
196
 
!        write(6,*)p%nr
197
 
!        write(6,*)p%nrval
198
 
!        write(6,*)p%zval
199
 
!        write(6,*)p%icorr
200
 
!        write(6,*)p%irel
201
 
!        write(6,*)p%nicore
202
 
!        write(6,*)p%a
203
 
!        write(6,*)p%b
204
 
!        write(6,*)p%method(1)
205
 
!        write(6,*)p%method(2)
206
 
!        write(6,*)p%method(3)
207
 
!        write(6,*)p%method(4)
208
 
!        write(6,*)p%method(5)
209
 
!        write(6,*)p%method(6)
210
 
!        write(6,*)p%text
211
 
!        write(6,*)p%npotu
212
 
!        write(6,*)p%npotd
213
 
!        write(6,'(4f20.12)')p%r(1:4)
214
 
!        write(6,'(4f20.12)')p%r(101:104)
215
 
!        write(6,'(4f20.12)')p%vdown(1,1:4)
216
 
!        write(6,'(4f20.12)')p%vdown(2,1:4)
217
 
!        write(6,'(4f20.12)')p%vdown(3,1:4)
218
 
!        write(6,'(4f20.12)')p%vdown(4,1:4)
219
 
!        write(6,'(4f20.12)')p%vup(1,1:4)
220
 
!        write(6,'(4f20.12)')p%vup(2,1:4)
221
 
!        write(6,'(4f20.12)')p%vup(3,1:4)
222
 
!        write(6,'(4f20.12)')p%chcore(1:4)
223
 
!        write(6,'(4f20.12)')p%chval(1:4)
224
 
!        write(6,*)p%ldown
225
 
!        write(6,*)p%lup
226
 
!         do ir = 1, p%nrval
227
 
!           write(6,*)p%r(ir), pseudo%pswf(1)%V%data(ir)
228
 
!         enddo
229
 
! -----
230
 
        end subroutine xml2psf_helper