1!
2! Copyright (C) 2002-2008 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!
9!==============================================================================
10!***  Molecular Dynamics using Density-Functional Theory                   ****
11!***  this is the main routine driver for Car-Parrinello simulations       ****
12!******************************************************************************
13!***  See the documentation coming with the Quantum ESPRESSO distribution  ****
14!***  for credits, references, appropriate citation of this code           ****
15!******************************************************************************
16!
17!----------------------------------------------------------------------------
18PROGRAM main
19  !----------------------------------------------------------------------------
20  !
21  USE input,         ONLY : iosys_pseudo, iosys
22  USE io_global,     ONLY : ionode, ionode_id
23  USE environment,   ONLY : environment_start
24  USE check_stop,    ONLY : check_stop_init
25  USE mp_global,     ONLY : mp_startup
26  USE mp_world,      ONLY : world_comm
27  USE mp_images,     ONLY : intra_image_comm
28  USE mp_pools,      ONLY : intra_pool_comm
29  USE mp_bands,      ONLY : intra_bgrp_comm, inter_bgrp_comm
30  USE read_input,    ONLY : read_input_file
31  USE command_line_options, ONLY : input_file_, ndiag_
32  !
33  IMPLICIT NONE
34  !
35  include 'laxlib.fh'
36  !
37  LOGICAL :: diag_in_band_group = .true.
38  !
39  ! ... program starts here
40  !
41  ! ... initialize MPI (parallel processing handling)
42  !
43  CALL mp_startup ( )
44  CALL laxlib_start ( ndiag_, world_comm, intra_bgrp_comm, &
45       do_distr_diag_inside_bgrp_ = diag_in_band_group )
46  CALL set_mpi_comm_4_solvers( intra_pool_comm, intra_bgrp_comm, &
47       inter_bgrp_comm )
48  !
49  ! ... start the environment
50  !
51  CALL environment_start( 'CP' )
52  !
53  ! reading plugin arguments
54  !
55  IF(ionode) CALL plugin_arguments()
56  CALL plugin_arguments_bcast(ionode_id,intra_image_comm)
57  !
58  ! ... open, read, close the input file
59  !
60  CALL read_input_file( 'CP', input_file_ )
61  !
62  ! ... read in pseudopotentials files and then
63  ! ... copy pseudopotential parameters into internal variables
64  !
65  CALL iosys_pseudo()
66  !
67  ! ... copy-in input parameters from input_parameter module
68  !
69  CALL iosys()
70  !
71  ! call to void routine for user define / plugin patches initializations
72  ! temporary moved to init_run
73!  CALL plugin_initialization()
74  !
75  CALL check_stop_init()
76  !
77  CALL cpr_loop( 1 )
78  !
79  CALL laxlib_end()
80  CALL stop_cp_run()
81  !
82END PROGRAM main
83