1!
2! Copyright (C) 2001-2020 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!-----------------------------------------------------------------------
10SUBROUTINE read_conf_from_file( stop_on_error, nat, nsp, tau, alat, at )
11  !-----------------------------------------------------------------------
12  !
13  USE kinds,           ONLY : DP
14  USE constants,       ONLY : eps8
15  USE io_global,       ONLY : stdout, ionode, ionode_id
16  USE io_files,        ONLY : restart_dir, xmlfile
17  USE mp,              ONLY : mp_bcast
18  USE mp_images,       ONLY : intra_image_comm
19  USE qexsd_module,    ONLY : qexsd_readschema
20  USE qexsd_copy,      ONLY : qexsd_copy_atomic_structure
21  USE qes_types_module,ONLY : output_type
22  USE qes_libs_module, ONLY : qes_reset
23  USE qes_bcast_module,ONLY : qes_bcast
24  !
25  IMPLICIT NONE
26  !
27  LOGICAL, INTENT(in)    :: stop_on_error
28  INTEGER, INTENT(in)    :: nat
29  INTEGER, INTENT(in)    :: nsp
30  REAL(DP),INTENT(out)   :: alat
31  REAL(DP),INTENT(out)   :: at(3,3)
32  REAL(DP),INTENT(inout) :: tau(3,nat)
33  !
34  ! ... local variables
35  !
36  TYPE ( output_type) :: output_obj
37  !
38  INTEGER :: ierr, nat_, ibrav_
39  INTEGER, ALLOCATABLE :: ityp_(:)
40  REAL(dp), ALLOCATABLE :: tau_(:,:)
41  CHARACTER (LEN=3) :: atm_(nsp)
42  !
43  WRITE( stdout, '(/5X,"Atomic positions and unit cell read from directory:", &
44                &  /,5X,A)') TRIM(restart_dir())
45  !
46  ! ... check if restart file is present, if so read config parameters
47  !
48  IF (ionode) CALL qexsd_readschema ( xmlfile(), ierr, output_obj )
49  CALL mp_bcast(ierr, ionode_id, intra_image_comm)
50  IF ( ierr /= 0 .AND. stop_on_error ) CALL errore ( 'read_conf_from_file', &
51       'fatal error reading xml file', ABS(ierr) )
52  IF (ierr /= 0 ) THEN
53     !
54     WRITE( stdout, '(5X,"Nothing found: ", &
55                       & "using input atomic positions and unit cell",/)' )
56     !
57  ELSE
58     !
59     CALL qes_bcast(output_obj, ionode_id, intra_image_comm)
60     CALL qexsd_copy_atomic_structure (output_obj%atomic_structure, nsp, &
61          atm_, nat_, tau_, ityp_, alat, at(:,1), at(:,2), at(:,3), ibrav_ )
62     CALL qes_reset (output_obj)
63     IF ( nat_ /= nat ) CALL errore('read_conf_from_file','bad number of atoms',1)
64     at(:,:) = at(:,:) / alat
65     tau_(:,1:nat) = tau_(:,1:nat)/alat
66     IF ( SUM ( (tau_(:,1:nat)-tau(:,1:nat))**2 ) > eps8 ) THEN
67        WRITE( stdout, '(5X,"Atomic positions from file used, from input discarded")' )
68        tau(:,1:nat) = tau_(:,1:nat)
69     END IF
70     DEALLOCATE ( tau_, ityp_ )
71     WRITE( stdout, * )
72     !
73  END IF
74  !
75  RETURN
76  !
77END SUBROUTINE read_conf_from_file
78