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!----------------------------------------------------------------------------
9MODULE path_read_namelists_module
10  !----------------------------------------------------------------------------
11  !
12  !  ... this module handles the reading of input namelists
13  !  ... written by: Carlo Cavazzoni
14  !  --------------------------------------------------
15  !
16  USE kinds,     ONLY : DP
17  USE path_input_parameters_module
18  !
19  IMPLICIT NONE
20  !
21  SAVE
22  !
23  PRIVATE
24  !
25  PUBLIC :: path_read_namelist
26  !
27  ! ... modules needed by read_xml.f90
28  !
29  !  ----------------------------------------------
30  !
31  CONTAINS
32     !
33     !=----------------------------------------------------------------------=!
34     !
35     !  Variables initialization for Namelist PATH
36     !
37     !=----------------------------------------------------------------------=!
38     !
39     !-----------------------------------------------------------------------
40     SUBROUTINE path_defaults( )
41       !-----------------------------------------------------------------------
42       !
43       USE path_input_parameters_module
44       !
45       IMPLICIT NONE
46       !
47       !
48       ! ... ( 'full' | 'coarse-grained' )
49       !
50       ! ... defaults for "path" optimisations variables
51       !
52         restart_mode  = 'from_scratch'
53         string_method  = 'neb'
54         num_of_images  = 0
55         first_last_opt = .FALSE.
56         use_masses     = .FALSE.
57         use_freezing   = .FALSE.
58         opt_scheme     = 'quick-min'
59         temp_req       = 0.0_DP
60         ds             = 1.0_DP
61         path_thr       = 0.05_DP
62         CI_scheme      = 'no-CI'
63         k_max          = 0.1_DP
64         k_min          = 0.1_DP
65         fixed_tan      = .FALSE.
66         nstep_path    = 1
67         !
68         lfcpopt              = .FALSE.
69         fcp_mu               = 0.0_DP
70         fcp_relax            = 'mdiis'
71         fcp_relax_step       = 0.1_DP
72         fcp_relax_crit       = 0.001_DP
73         fcp_mdiis_size       = 4
74         fcp_mdiis_step       = 0.2_DP
75         fcp_tot_charge_first = 0.0_DP
76         fcp_tot_charge_last  = 0.0_DP
77       !
78       ! for reading ions namelist we need to set calculation=relax
79       !
80       RETURN
81       !
82     END SUBROUTINE
83     !
84     !=----------------------------------------------------------------------=!
85     !
86     !  Broadcast variables values for Namelist NEB
87     !
88     !=----------------------------------------------------------------------=!
89     !
90     !-----------------------------------------------------------------------
91     SUBROUTINE path_bcast()
92       !-----------------------------------------------------------------------
93       !
94       USE io_global, ONLY: ionode_id
95       USE mp,        ONLY: mp_bcast
96       USE mp_world,  ONLY: world_comm
97       USE path_input_parameters_module
98       !
99       IMPLICIT NONE
100       !
101       ! ... "path" variables broadcast
102       !
103       CALL mp_bcast( restart_mode,         ionode_id, world_comm )
104       CALL mp_bcast( string_method,        ionode_id, world_comm )
105       CALL mp_bcast( num_of_images,        ionode_id, world_comm )
106       CALL mp_bcast( first_last_opt,       ionode_id, world_comm )
107       CALL mp_bcast( use_masses,           ionode_id, world_comm )
108       CALL mp_bcast( use_freezing,         ionode_id, world_comm )
109       CALL mp_bcast( fixed_tan,            ionode_id, world_comm )
110       CALL mp_bcast( CI_scheme,            ionode_id, world_comm )
111       CALL mp_bcast( opt_scheme,           ionode_id, world_comm )
112       CALL mp_bcast( temp_req,             ionode_id, world_comm )
113       CALL mp_bcast( ds,                   ionode_id, world_comm )
114       CALL mp_bcast( k_max,                ionode_id, world_comm )
115       CALL mp_bcast( k_min,                ionode_id, world_comm )
116       CALL mp_bcast( path_thr,             ionode_id, world_comm )
117       CALL mp_bcast( nstep_path,           ionode_id, world_comm )
118       CALL mp_bcast( lfcpopt,              ionode_id, world_comm )
119       CALL mp_bcast( fcp_mu,               ionode_id, world_comm )
120       CALL mp_bcast( fcp_relax,            ionode_id, world_comm )
121       CALL mp_bcast( fcp_relax_step,       ionode_id, world_comm )
122       CALL mp_bcast( fcp_relax_crit,       ionode_id, world_comm )
123       CALL mp_bcast( fcp_mdiis_size,       ionode_id, world_comm )
124       CALL mp_bcast( fcp_mdiis_step,       ionode_id, world_comm )
125       CALL mp_bcast( fcp_tot_charge_first, ionode_id, world_comm )
126       CALL mp_bcast( fcp_tot_charge_last,  ionode_id, world_comm )
127       !
128       RETURN
129       !
130     END SUBROUTINE
131     !
132     !
133     !-----------------------------------------------------------------------
134     SUBROUTINE path_checkin( )
135       !-----------------------------------------------------------------------
136       !
137       USE path_input_parameters_module
138       !
139       IMPLICIT NONE
140       !
141       CHARACTER(LEN=20) :: sub_name = ' path_checkin '
142       INTEGER           :: i
143       LOGICAL           :: allowed = .FALSE.
144       !
145       !
146       ! ... general "path" variables checkin
147              IF ( ds < 0.0_DP ) &
148          CALL errore( sub_name,' ds out of range ',1)
149       IF ( temp_req < 0.0_DP ) &
150          CALL errore( sub_name,' temp_req out of range ',1)
151       !
152       allowed = .FALSE.
153       DO i = 1, SIZE( opt_scheme_allowed )
154          IF ( TRIM( opt_scheme ) == &
155               opt_scheme_allowed(i) ) allowed = .TRUE.
156       END DO
157       IF ( .NOT. allowed ) &
158          CALL errore( sub_name, ' opt_scheme '''// &
159                     & TRIM( opt_scheme )//''' not allowed ', 1 )
160       !
161       !
162       ! ... NEB(SM) specific checkin
163       !
164       IF ( k_max < 0.0_DP )  CALL errore( sub_name, 'k_max out of range', 1 )
165       IF ( k_min < 0.0_DP )  CALL errore( sub_name, 'k_min out of range', 1 )
166       IF ( k_max < k_min ) CALL errore( sub_name, 'k_max < k_min', 1 )
167       !
168!       IF ( nstep_path < 1 ) CALL errore ( sub_name, 'step_path out of range', 1 )
169       !
170       allowed = .FALSE.
171       DO i = 1, SIZE( CI_scheme_allowed )
172          IF ( TRIM( CI_scheme ) == CI_scheme_allowed(i) ) allowed = .TRUE.
173       END DO
174       !
175       IF ( .NOT. allowed ) &
176          CALL errore( sub_name, ' CI_scheme ''' // &
177                      & TRIM( CI_scheme ) //''' not allowed ', 1 )
178       !
179       !
180       ! ... FCP algorithm
181       !
182       allowed = .FALSE.
183       DO i = 1, SIZE( fcp_relax_allowed )
184          IF ( TRIM( fcp_relax ) == fcp_relax_allowed(i) ) allowed = .TRUE.
185       END DO
186       !
187       IF ( .NOT. allowed ) &
188          CALL errore( sub_name, ' fcp_relax ''' // &
189                      & TRIM( fcp_relax ) //''' not allowed ', 1 )
190       !
191       RETURN
192       !
193     END SUBROUTINE
194     !
195     !=----------------------------------------------------------------------=!
196     !
197     !  Namelist parsing main routine
198     !
199     !=----------------------------------------------------------------------=!
200     !
201     !-----------------------------------------------------------------------
202     SUBROUTINE path_read_namelist(unit)
203       !-----------------------------------------------------------------------
204       !
205       !  this routine reads data from standard input and puts them into
206       !  module-scope variables (accessible from other routines by including
207       !  this module, or the one that contains them)
208       !  ----------------------------------------------
209       !
210       ! ... declare modules
211       !
212       USE io_global, ONLY : ionode, ionode_id
213       USE mp,        ONLY : mp_bcast
214       USE mp_world,  ONLY : world_comm
215       !
216       IMPLICIT NONE
217       !
218       ! ... declare variables
219       !
220       INTEGER, intent(in) :: unit
221       !
222       !
223       ! ... declare other variables
224       !
225       INTEGER :: ios
226       !
227       ! ... end of declarations
228       !
229       !  ----------------------------------------------
230       !
231       !
232       ! ... default settings for all namelists
233       !
234       CALL path_defaults( )
235       !
236       ! ... Here start reading standard input file
237       !
238       ! ... PATH namelist
239       !
240       ios = 0
241       IF ( ionode ) THEN
242          !
243          READ( unit, path, iostat = ios )
244          !
245       END IF
246       CALL mp_bcast( ios, ionode_id, world_comm )
247       IF( ios /= 0 ) THEN
248          CALL errore( ' path_read_namelists ', &
249                     & ' reading namelist path ', ABS(ios) )
250       END IF
251       !
252       CALL path_bcast( )
253       CALL path_checkin( )
254       !
255       RETURN
256       !
257     END SUBROUTINE path_read_namelist
258     !
259END MODULE path_read_namelists_module
260