rrkj2upf.f90 7.3 KB
Newer Older
giannozz's avatar
giannozz committed
1 2 3 4 5 6 7 8 9
!
! Copyright (C) 2001 PWSCF group
! This file is distributed under the terms of the
! GNU General Public License. See the file 'License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
!---------------------------------------------------------------------
10
PROGRAM rrkj2upf
giannozz's avatar
giannozz committed
11 12 13 14 15 16
  !---------------------------------------------------------------------
  !
  !     Convert a pseudopotential written in "rrkj3" format
  !     (Rabe-Rappe-Kaxiras-Joannopoulos with 3 Bessel functions)
  !     to unified pseudopotential format
  !
17 18
  IMPLICIT NONE
  CHARACTER(len=256) filein, fileout
giannozz's avatar
giannozz committed
19
  !
20
  !
giannozz's avatar
giannozz committed
21
  IF ( trim(filein) == ' ') &
22
       CALL errore ('rrkj2upf', 'usage: rrkj2upf "file-to-be-converted"', 1)
23 24 25 26
  CALL get_file ( filein )
  OPEN (unit = 1, file = filein, status = 'old', form = 'formatted')
  CALL read_rrkj(1)
  CLOSE (1)
giannozz's avatar
giannozz committed
27 28 29 30

  ! convert variables read from rrkj3 format into those needed
  ! by the upf format - add missing quantities

31
  CALL convert_rrkj
giannozz's avatar
giannozz committed
32 33

  fileout=trim(filein)//'.UPF'
34
  PRINT '(''Output PP file in UPF format :  '',a)', fileout
giannozz's avatar
giannozz committed
35

36
  OPEN(unit=2,file=fileout,status='unknown',form='formatted')
37
  CALL write_upf_v1(2)
38
  CLOSE (unit=2)
giannozz's avatar
giannozz committed
39

40 41 42
STOP
20 WRITE (6,'("rrkj2upf: error reading pseudopotential file name")')
   STOP
giannozz's avatar
giannozz committed
43

44
END PROGRAM rrkj2upf
giannozz's avatar
giannozz committed
45

46
MODULE rrkj3
giannozz's avatar
giannozz committed
47 48
  !
  ! All variables read from RRKJ3 file format
49
  !
giannozz's avatar
giannozz committed
50 51 52
  ! trailing underscore means that a variable with the same name
  ! is used in module 'upf' containing variables to be written
  !
53 54 55
  CHARACTER(len=75):: titleps
  CHARACTER (len=2), ALLOCATABLE :: els_(:)
  INTEGER :: pseudotype_, iexch_, icorr_, igcx_, igcc_, mesh_, &
giannozz's avatar
giannozz committed
56
       nwfs_, nbeta_, lmax_
57
  LOGICAL :: rel_, nlcc_
58
  real (8) :: zp_, etotps_, xmin, rmax, zmesh, dx, rcloc_
59 60
  INTEGER, ALLOCATABLE:: lchi_(:), nns_(:), ikk2_(:)
  real (8), ALLOCATABLE :: rcut_(:), rcutus_(:), oc_(:), &
giannozz's avatar
giannozz committed
61 62
       beta(:,:), dion_(:,:), qqq_(:,:), ddd(:,:), qfunc_(:,:,:), &
       rho_atc_(:), rho_at_(:), chi_(:,:), vloc_(:)
63 64
END MODULE rrkj3
!
giannozz's avatar
giannozz committed
65
!     ----------------------------------------------------------
66
SUBROUTINE read_rrkj(iunps)
giannozz's avatar
giannozz committed
67
  !     ----------------------------------------------------------
68 69 70 71 72
  !
  USE rrkj3
  IMPLICIT NONE
  INTEGER :: iunps
  INTEGER :: nb, mb, n, ir, ios
giannozz's avatar
giannozz committed
73 74

  !---  > Start the header reading
75 76 77 78 79 80 81
  READ (iunps, '(a75)', err = 100) titleps
  READ (iunps, *, err = 100)  pseudotype_
  READ (iunps, *, err = 100) rel_, nlcc_
  READ (iunps, *, err=100) iexch_, icorr_, igcx_, igcc_
  READ (iunps, '(2e17.11,i5)') zp_, etotps_, lmax_
  READ (iunps, '(4e17.11,i5)', err=100) xmin, rmax, zmesh, dx, mesh_
  READ (iunps, *, err=100) nwfs_, nbeta_
giannozz's avatar
giannozz committed
82

83 84 85
  ALLOCATE(rcut_(nwfs_), rcutus_(nwfs_))
  READ (iunps, *, err=100) (rcut_(nb), nb=1,nwfs_)
  READ (iunps, *, err=100) (rcutus_(nb), nb=1,nwfs_)
giannozz's avatar
giannozz committed
86

87 88 89
  ALLOCATE(els_(nwfs_), nns_(nwfs_), lchi_(nwfs_), oc_(nwfs_))
  DO nb = 1, nwfs_
     READ (iunps, '(a2,2i3,f6.2)', err = 100) els_(nb), &
giannozz's avatar
giannozz committed
90
          nns_(nb), lchi_(nb) , oc_(nb)
91
  ENDDO
giannozz's avatar
giannozz committed
92

93 94 95 96 97 98
  ALLOCATE(ikk2_(nbeta_))
  ALLOCATE(beta( mesh_,nbeta_))
  ALLOCATE(dion_(nbeta_,nbeta_))
  ALLOCATE(ddd (nbeta_,nbeta_))
  ALLOCATE(qqq_(nbeta_,nbeta_))
  ALLOCATE(qfunc_(mesh_,nbeta_,nbeta_))
giannozz's avatar
giannozz committed
99

100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
  DO nb = 1, nbeta_
     READ (iunps, *, err = 100) ikk2_(nb)
     READ (iunps, *, err = 100) (beta (ir, nb) , ir = 1,ikk2_(nb) )
     DO ir = ikk2_(nb) + 1, mesh_
        beta (ir, nb) = 0.d0
     ENDDO
     DO mb = 1, nb
        READ (iunps, *, err = 100) dion_(nb, mb)
        dion_(mb, nb) = dion_(nb, mb)
        IF (pseudotype_==3) THEN
           READ (iunps, *, err = 100) qqq_(nb, mb)
           qqq_(mb, nb) = qqq_(nb, mb)
           READ (iunps, *, err = 100) (qfunc_(n,nb, mb), n = 1, mesh_)
           DO n = 1, mesh_
              qfunc_(n, mb, nb) = qfunc_(n, nb, mb)
           ENDDO
        ELSE
           qqq_(nb, mb) = 0.d0
           qqq_(mb, nb) = 0.d0
           DO n = 1, mesh_
              qfunc_(n, nb, mb) = 0.d0
              qfunc_(n, mb, nb) = 0.d0
           ENDDO
        ENDIF
     ENDDO
  ENDDO
giannozz's avatar
giannozz committed
126 127 128
  !
  !     read the local potential
  !
129 130
  ALLOCATE(vloc_(mesh_))
  READ (iunps, *, err = 100) rcloc_, (vloc_(ir ) , ir = 1, mesh_ )
giannozz's avatar
giannozz committed
131 132 133
  !
  !     read the atomic charge
  !
134 135
  ALLOCATE(rho_at_(mesh_))
  READ (iunps, *, err=100) (rho_at_(ir), ir=1,mesh_)
giannozz's avatar
giannozz committed
136 137 138
  !
  !     if present read the core charge
  !
139 140 141 142
  ALLOCATE(rho_atc_(mesh_))
  IF (nlcc_) THEN
     READ (iunps, *, err=100) (rho_atc_(ir), ir=1, mesh_)
  ENDIF
giannozz's avatar
giannozz committed
143 144 145
  !
  !     read the pseudo wavefunctions of the atom
  !
146 147
  ALLOCATE(chi_(mesh_,nwfs_))
  READ (iunps, *, err=100) ( (chi_(ir,nb), ir = 1,mesh_) , nb = 1, nwfs_)
giannozz's avatar
giannozz committed
148 149
  !
  !     ----------------------------------------------------------
150
  WRITE (6,'(a)') 'Pseudopotential successfully read'
giannozz's avatar
giannozz committed
151 152
  !     ----------------------------------------------------------
  !
153 154 155
  RETURN
100 WRITE (6,'("read_rrkj: error reading pseudopotential file")')
    STOP
giannozz's avatar
giannozz committed
156

157
END SUBROUTINE read_rrkj
giannozz's avatar
giannozz committed
158

159
SUBROUTINE convert_rrkj
giannozz's avatar
giannozz committed
160 161
  !     ----------------------------------------------------------
  !
162 163 164 165 166
  USE rrkj3
  USE upf
  USE constants, ONLY : fpi
  IMPLICIT NONE
  INTEGER i, n
167
  real(8) :: x
giannozz's avatar
giannozz committed
168 169


170 171
  WRITE(generated, '("Generated using Andrea Dal Corso code (rrkj3)")')
  WRITE(date_author,'("Author: Andrea Dal Corso   Generation date: unknown")')
giannozz's avatar
giannozz committed
172
  comment = 'Info:'//titleps
173
  IF (rel_) THEN
giannozz's avatar
giannozz committed
174
     rel = 1
175
  ELSE
giannozz's avatar
giannozz committed
176
     rel = 0
177
  ENDIF
giannozz's avatar
giannozz committed
178 179
  rcloc = rcloc_
  nwfs = nwfs_
180 181 182 183
  ALLOCATE( els(nwfs), oc(nwfs), epseu(nwfs))
  ALLOCATE(lchi(nwfs), nns(nwfs) )
  ALLOCATE(rcut (nwfs), rcutus (nwfs))
  DO i=1, nwfs
giannozz's avatar
giannozz committed
184 185 186 187 188 189
     nns (i)  = nns_(i)
     lchi(i)  = lchi_(i)
     rcut(i)  = rcut_(i)
     rcutus(i)= rcutus_(i)
     oc (i)   = oc_(i)
     els(i)   = els_(i)
giannozz's avatar
giannozz committed
190
     epseu(i) = 0.0d0
191 192
  ENDDO
  DEALLOCATE (els_, oc_, rcutus_, rcut_, nns_)
giannozz's avatar
giannozz committed
193

194 195
  psd  = titleps (7:8)
  IF (pseudotype_==3) THEN
giannozz's avatar
giannozz committed
196
     pseudotype = 'US'
197
  ELSE
giannozz's avatar
giannozz committed
198
     pseudotype = 'NC'
199
  ENDIF
giannozz's avatar
giannozz committed
200 201 202
  nlcc = nlcc_
  zp = zp_
  etotps = etotps_
giannozz's avatar
giannozz committed
203 204
  ecutrho=0.0d0
  ecutwfc=0.0d0
giannozz's avatar
giannozz committed
205 206 207 208
  lmax = lmax_
  mesh = mesh_
  nbeta = nbeta_
  ntwfc = 0
209 210 211 212
  DO i=1, nwfs
     IF (oc(i) > 1.0d-12) ntwfc = ntwfc + 1
  ENDDO
  ALLOCATE( elsw(ntwfc), ocw(ntwfc), lchiw(ntwfc) )
giannozz's avatar
giannozz committed
213
  n = 0
214 215
  DO i=1, nwfs
     IF (oc(i) > 1.0d-12) THEN
giannozz's avatar
giannozz committed
216 217 218 219
        n = n + 1
        elsw(n) = els(i)
        ocw (n) = oc (i)
        lchiw(n)=lchi(i)
220 221
     ENDIF
  ENDDO
giannozz's avatar
giannozz committed
222 223 224 225 226
  iexch = iexch_
  icorr = icorr_
  igcx  = igcx_
  igcc  = igcc_

227 228
  ALLOCATE(rab(mesh))
  ALLOCATE(  r(mesh))
giannozz's avatar
giannozz committed
229
  ! define logarithmic mesh
230 231
  DO i = 1, mesh
     x = xmin + dble(i-1) * dx
giannozz's avatar
giannozz committed
232 233
     r  (i) = exp(x) / zmesh
     rab(i) = dx * r(i)
234
  ENDDO
giannozz's avatar
giannozz committed
235

236
  ALLOCATE (rho_atc(mesh))
giannozz's avatar
giannozz committed
237
  ! rrkj rho_core(r) =  4pi*r^2*rho_core(r) UPF
giannozz's avatar
giannozz committed
238
  rho_atc (:) = rho_atc_(:) / fpi / r(:)**2
239
  DEALLOCATE (rho_atc_)
giannozz's avatar
giannozz committed
240

241
  ALLOCATE (vloc0(mesh))
giannozz's avatar
giannozz committed
242
  vloc0 = vloc_
243
  DEALLOCATE (vloc_)
giannozz's avatar
giannozz committed
244

245
  ALLOCATE(ikk2(nbeta), lll(nbeta))
giannozz's avatar
giannozz committed
246 247
  ikk2 = ikk2_
  lll  = lchi_
248 249
  DEALLOCATE (ikk2_, lchi_)
!  kkbeta  = 0
giannozz's avatar
giannozz committed
250
!  do nb=1,nbeta
251
!     kkbeta  = max (kkbeta , ikk2(nb) )
giannozz's avatar
giannozz committed
252
!  end do
253
  ALLOCATE(betar(mesh,nbeta))
giannozz's avatar
giannozz committed
254
  betar = 0.0d0
255
  DO i=1, nbeta
giannozz's avatar
giannozz committed
256
     betar(1:ikk2(i),i) = beta(1:ikk2(i),i)
257 258
  ENDDO
  DEALLOCATE (beta)
giannozz's avatar
giannozz committed
259

260
  ALLOCATE(dion(nbeta,nbeta))
giannozz's avatar
giannozz committed
261
  dion = dion_
262
  DEALLOCATE (dion_)
giannozz's avatar
giannozz committed
263

264
  ALLOCATE(qqq(nbeta,nbeta))
giannozz's avatar
giannozz committed
265
  qqq = qqq_
266
  DEALLOCATE (qqq_)
giannozz's avatar
giannozz committed
267

268
  ALLOCATE(qfunc(mesh,nbeta,nbeta))
giannozz's avatar
giannozz committed
269 270 271 272 273
  qfunc = qfunc_

  nqf = 0
  nqlc= 0

274
  ALLOCATE (rho_at(mesh))
giannozz's avatar
giannozz committed
275
  rho_at = rho_at_
276
  DEALLOCATE (rho_at_)
giannozz's avatar
giannozz committed
277

278
  ALLOCATE (chi(mesh,ntwfc))
giannozz's avatar
giannozz committed
279
  n = 0
280 281
  DO i=1, nwfs
     IF (oc(i) > 1.0d-12) THEN
giannozz's avatar
giannozz committed
282 283
        n = n + 1
        chi(:,n) = chi_(:,i)
284 285 286
     ENDIF
  ENDDO
  DEALLOCATE (chi_)
giannozz's avatar
giannozz committed
287

288 289
  RETURN
END SUBROUTINE convert_rrkj
giannozz's avatar
giannozz committed
290