1!
2! Copyright (C) 2004-2009 Quantum ESPRESSO 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!---------------------------------------------------------------
9program ld1
10  !---------------------------------------------------------------
11  !
12  !     atomic self-consistent local-density program
13  !     atomic rydberg units are used : e^2=2, m=1/2, hbar=1
14  !     psi(r) = rR(r), where R(r) is the radial part of the wfct
15  !     rho(r) = psi(r)^2 => rho(r) = (true charge density)*(4\pi r^2)
16  !                       The same applies to the core charge
17  !---------------------------------------------------------------
18  !
19  USE mp_global,         ONLY : mp_startup, mp_global_end
20  USE environment,       ONLY : environment_start
21  USE ld1inc,            ONLY : iswitch, write_coulomb, grid, lgipaw_reconstruction
22  USE radial_grids,      ONLY : deallocate_radial_grid
23  !
24  implicit none
25  CHARACTER (LEN=9) :: code = 'LD1'
26  !
27  !   write initialization information
28  !
29  call mp_startup( )
30  call environment_start ( code )
31  !
32  !    read input, possible pseudopotential and set the main variables
33  !
34  call ld1_readin ( )
35  call ld1_setup ( )
36  !
37  !   four possible working mode:
38  !
39  if (iswitch.eq.1) then
40     !
41     !   all-electron calculation
42     !
43     call all_electron(.true.,1)
44     if ( write_coulomb ) call write_ae_pseudo ( )
45     !
46  elseif (iswitch.eq.2) then
47     !
48     !   pseudopotential test
49     !
50     call run_test ( )
51     call ld1_writeout ( )
52     !
53  elseif (iswitch.eq.3) then
54     !
55     !  pseudopotential generation and test
56     !
57     call all_electron(.false.,1)
58     call gener_pseudo ( )
59     !if(.not. lgipaw_reconstruction)
60     call run_test ( )
61     call ld1_writeout ( )
62     !
63  elseif (iswitch.eq.4) then
64     !
65     ! LDA-1/2 correction to the input pseudopotential
66     !
67     call run_lda_half ( )
68     call ld1_writeout ( )
69     !
70  else
71     call errore('ld1','iswitch not implemented',1)
72  endif
73  call deallocate_radial_grid( grid )
74
75  call mp_global_end()
76
77end program ld1
78!
79