1!
2! Copyright (C) 2001-2006 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!----------------------------------------------------------------------------
9SUBROUTINE init_run()
10  !----------------------------------------------------------------------------
11  !
12  USE klist,              ONLY : nkstot
13  USE symme,              ONLY : sym_rho_init
14  USE wvfct,              ONLY : nbnd, et, wg, btype
15  USE control_flags,      ONLY : lmd, gamma_only, smallmem, ts_vdw
16  USE gvect,              ONLY : g, gg, mill, gcutm, ig_l2g, ngm, ngm_g, &
17                                 gshells, gstart ! to be comunicated to the Solvers if gamma_only
18  USE gvecs,              ONLY : gcutms, ngms
19  USE cell_base,          ONLY : at, bg, set_h_ainv
20  USE cellmd,             ONLY : lmovecell
21  USE dynamics_module,    ONLY : allocate_dyn_vars
22  USE paw_variables,      ONLY : okpaw
23  USE paw_init,           ONLY : paw_init_onecenter, allocate_paw_internals
24#if defined(__MPI)
25  USE paw_init,           ONLY : paw_post_init
26#endif
27  USE bp,                 ONLY : allocate_bp_efield, bp_global_map
28  USE fft_base,           ONLY : dfftp, dffts
29  USE funct,              ONLY : dft_is_hybrid
30  USE recvec_subs,        ONLY : ggen, ggens
31  USE wannier_new,        ONLY : use_wannier
32  USE dfunct,             ONLY : newd
33  USE esm,                ONLY : do_comp_esm, esm_init
34  USE tsvdw_module,       ONLY : tsvdw_initialize
35  USE Coul_cut_2D,        ONLY : do_cutoff_2D, cutoff_fact
36  !
37  IMPLICIT NONE
38  !
39  CALL start_clock( 'init_run' )
40  !
41  ! ... calculate limits of some indices, used in subsequent allocations
42  !
43  CALL pre_init()
44  !
45  ! ... determine the data structure for fft arrays
46  !
47  CALL data_structure( gamma_only )
48  !
49  ! ... print a summary and a memory estimate before starting allocating
50  !
51  CALL summary()
52  CALL memory_report()
53  !
54  ! ... allocate memory for G- and R-space fft arrays
55  !
56  CALL allocate_fft()
57  !
58  ! ... generate reciprocal-lattice vectors and fft indices
59  !
60  IF( smallmem ) THEN
61     CALL ggen( dfftp, gamma_only, at, bg, gcutm, ngm_g, ngm, &
62          g, gg, mill, ig_l2g, gstart, no_global_sort = .TRUE. )
63  ELSE
64     CALL ggen( dfftp, gamma_only, at, bg, gcutm, ngm_g, ngm, &
65       g, gg, mill, ig_l2g, gstart )
66  END IF
67  CALL ggens( dffts, gamma_only, at, g, gg, mill, gcutms, ngms )
68  if (gamma_only) THEN
69     ! ... Solvers need to know gstart
70     call export_gstart_2_solvers(gstart)
71  END IF
72  !
73  IF (do_comp_esm) CALL esm_init()
74  !
75  ! ... setup the 2D cutoff factor
76  !
77  IF (do_cutoff_2D) CALL cutoff_fact()
78  !
79  CALL gshells ( lmovecell )
80  !
81  ! ... variable initialization for parallel symmetrization
82  !
83  CALL sym_rho_init (gamma_only )
84  !
85  ! ... allocate memory for all other arrays (potentials, wavefunctions etc)
86  !
87  CALL allocate_nlpot()
88  IF (okpaw) THEN
89     CALL allocate_paw_internals()
90     CALL paw_init_onecenter()
91  ENDIF
92  CALL allocate_locpot()
93  CALL allocate_bp_efield()
94  CALL bp_global_map()
95  !
96  call plugin_initbase()
97  !
98  ALLOCATE( et( nbnd, nkstot ) , wg( nbnd, nkstot ), btype( nbnd, nkstot ) )
99  !
100  et(:,:) = 0.D0
101  wg(:,:) = 0.D0
102  !
103  btype(:,:) = 1
104  !
105  IF (ts_vdw) THEN
106     CALL tsvdw_initialize()
107     CALL set_h_ainv()
108  END IF
109  !
110  CALL allocate_wfc_k()
111  CALL openfil()
112  !
113  CALL hinit0()
114  !
115  CALL potinit()
116  !
117  CALL newd()
118  !
119  CALL wfcinit()
120  !
121  IF(use_wannier) CALL wannier_init()
122  !
123#if defined(__MPI)
124  ! Cleanup PAW arrays that are only used for init
125  IF (okpaw) CALL paw_post_init() ! only parallel!
126#endif
127  !
128  IF ( lmd ) CALL allocate_dyn_vars()
129  !
130  CALL stop_clock( 'init_run' )
131  !
132  RETURN
133  !
134END SUBROUTINE init_run
135  !
136!----------------------------------------------------------------------------
137SUBROUTINE pre_init()
138  !----------------------------------------------------------------------------
139  !
140  USE ions_base,        ONLY : nat, nsp, ityp
141  USE uspp_param,       ONLY : upf, lmaxkb, nh, nhm, nbetam
142  USE uspp,             ONLY : nkb, nkbus
143  IMPLICIT NONE
144  INTEGER :: na, nt, nb
145  !
146  !     calculate the number of beta functions for each atomic type
147  !
148  lmaxkb = - 1
149  DO nt = 1, nsp
150     !
151     nh (nt) = 0
152     !
153     ! do not add any beta projector if pseudo in 1/r fmt (AF)
154     IF ( upf(nt)%tcoulombp ) CYCLE
155     !
156     DO nb = 1, upf(nt)%nbeta
157        nh (nt) = nh (nt) + 2 * upf(nt)%lll(nb) + 1
158        lmaxkb = MAX (lmaxkb, upf(nt)%lll(nb) )
159     ENDDO
160     !
161  ENDDO
162  !
163  ! calculate the maximum number of beta functions
164  !
165  nhm = MAXVAL (nh (1:nsp))
166  nbetam = MAXVAL (upf(:)%nbeta)
167  !
168  ! calculate the number of beta functions of the solid
169  !
170  nkb = 0
171  nkbus = 0
172  do na = 1, nat
173     nt = ityp(na)
174     nkb = nkb + nh (nt)
175     if (upf(nt)%tvanp) nkbus = nkbus + nh (nt)
176  enddo
177
178
179END SUBROUTINE pre_init
180