1!
2! Copyright (C) 2004 PWSCF group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!
9!---------------------------------------------------------------------
10      subroutine read_pseudo_rrkj3 (ios)
11!---------------------------------------------------------------------
12!
13!     This routine reads from input the quantities which defines
14!     a multiprojector pseudopotential. It can be in the
15!     Vanderbilt form or in the norm-conserving form
16!
17use kinds, only : dp
18use funct, only: set_dft_from_indices
19use radial_grids, only: do_mesh
20use ld1inc, only : file_pseudo, title, pseudotype, nlcc, rel, zval, etots, &
21                   grid, ikk, betas, bmat, qq, qvan, rcloc, vpsloc, rhos, &
22                   rhoc, phis, lmax, nwfs, nbeta, rcut, rcutus, &
23                   els, nns, lls, ocs
24   implicit none
25
26      integer :: &
27             nb,mb, &  ! counters on beta functions
28             n,     &  ! counter on mesh points
29             ir,    &  ! counters on mesh points
30             ios,   &  ! I/O control: ios /= 0 means error
31             iunps    ! the unit with the pseudopotential
32      integer :: iexch, icorr, igcx, igcc
33
34      logical :: reldum
35
36      real(DP):: xmin, dx, rmax, zmesh ! auxliary mesh data
37      integer :: mesh
38
39      if (file_pseudo.eq.' ') return
40
41      iunps=29
42      open(unit=iunps,file=file_pseudo,status='unknown', &
43         &  form='formatted', err=50, iostat=ios)
4450    call errore('read_pseudo_rrkj3','opening file_pseudo',abs(ios))
45
46      read( iunps, '(a75)', err=100, iostat=ios ) title
47
48      read( iunps, '(i5)',err=100, iostat=ios ) pseudotype
49      if (pseudotype /= 2 .and. pseudotype /= 3) &
50         call errore('read_pseudo_rrkj3','pseudotype is wrong',1)
51
52      read( iunps, '(2l5)',err=100, iostat=ios ) reldum, nlcc
53      if (reldum.and.rel.eq.0) call errore('read_pseudo_rrkj3', &
54   &    'relativistic pseudopotential and non relativistic calculation',-1)
55      if (.not.reldum.and.rel.gt.0) call errore('read_pseudo_rrkj3', &
56   &    'non relativistic pseudopotential and relativistic calculation',-1)
57
58      read( iunps, '(4i5)',err=100, iostat=ios ) iexch, icorr, igcx, igcc
59      call set_dft_from_indices(iexch, icorr, igcx, igcc, 0, 0)
60
61      read( iunps, '(2e17.11,i5)') zval, etots, lmax
62
63      read( iunps, '(4e17.11,i5)',err=100, iostat=ios ) xmin,rmax,zmesh,dx,mesh
64
65      call do_mesh(rmax,zmesh,xmin,dx,0,grid)
66      if (mesh.ne.grid%mesh) &
67          call errore ('read_pseudo_rrkj3','wrong meah dimensions',1)
68
69      read( iunps, '(2i5)', err=100, iostat=ios ) nwfs, nbeta
70      read( iunps, '(1p4e19.11)', err=100, iostat=ios ) &
71                                    ( rcut(nb), nb=1,nwfs )
72      read( iunps, '(1p4e19.11)', err=100, iostat=ios ) &
73                                    ( rcutus(nb), nb=1,nwfs )
74
75      do nb=1,nwfs
76         read(iunps,'(a2,2i3,f6.2)',err=100,iostat=ios) &
77                          els(nb), nns(nb), lls(nb), ocs(nb)
78      enddo
79      do nb=1,nbeta
80         read ( iunps, '(i6)',err=100, iostat=ios ) ikk(nb)
81         read ( iunps, '(1p4e19.11)',err=100, iostat=ios ) &
82                            ( betas(ir,nb), ir=1,ikk(nb))
83         do ir=ikk(nb)+1,grid%mesh
84            betas(ir,nb)=0.0_dp
85         enddo
86         do mb=1,nb
87            read( iunps, '(1p4e19.11)', err=100, iostat=ios ) &
88                  bmat(nb,mb)
89            bmat(mb,nb)=bmat(nb,mb)
90            if (pseudotype.eq.3) then
91              read(iunps,'(1p4e19.11)',err=100,iostat=ios) &
92                  qq(nb,mb)
93              qq(mb,nb)=qq(nb,mb)
94              read(iunps,'(1p4e19.11)',err=100,iostat=ios)   &
95                 (qvan(n,nb,mb),n=1,grid%mesh)
96              do n=1,grid%mesh
97                 qvan(n,mb,nb)=qvan(n,nb,mb)
98              enddo
99            else
100              qq(nb,mb)=0.0_dp
101              qq(mb,nb)=0.0_dp
102              do n=1,grid%mesh
103                 qvan(n,mb,nb)=0.0_dp
104                 qvan(n,nb,mb)=0.0_dp
105              enddo
106            endif
107         enddo
108      enddo
109!
110!   reads the local potential
111!
112      read( iunps, '(1p4e19.11)',err=100, iostat=ios ) rcloc, &
113                             ( vpsloc(ir), ir=1,grid%mesh )
114!
115!     reads the atomic charge
116!
117      read( iunps, '(1p4e19.11)', err=100, iostat=ios ) &
118                               ( rhos(ir,1), ir=1,grid%mesh )
119!
120!  if present reads the core charge
121!
122      if ( nlcc ) then
123         read( iunps, '(1p4e19.11)', err=100, iostat=ios ) &
124                               ( rhoc(ir), ir=1,grid%mesh )
125      else
126         rhoc = 0.0_dp
127      endif
128!
129!    read the pseudo wavefunctions of the atom
130!
131      read( iunps, '(1p4e19.11)', err=100, iostat=ios ) &
132                   ((phis(ir,nb),ir=1,grid%mesh),nb=1,nwfs)
133100   continue
134      !
135      ! do not stop with error message here: return error code instead
136      !
137      !call errore('read_pseudo_rrkj3','Reading pseudo file', &
138      !                                         abs(ios))
139      close(iunps)
140
141      return
142      end subroutine read_pseudo_rrkj3
143