root / src / egrad_siesta.f90
Historique | Voir | Annoter | Télécharger (7,29 ko)
1 |
subroutine egrad_siesta(e,geomcart,gradcart) |
---|---|
2 |
|
3 |
! This routines calculates the energy and the gradient of |
4 |
! a molecule, using Siesta |
5 |
|
6 |
!---------------------------------------------------------------------- |
7 |
! Copyright 2003-2014 Ecole Normale Supérieure de Lyon, |
8 |
! Centre National de la Recherche Scientifique, |
9 |
! Université Claude Bernard Lyon 1. All rights reserved. |
10 |
! |
11 |
! This work is registered with the Agency for the Protection of Programs |
12 |
! as IDDN.FR.001.100009.000.S.P.2014.000.30625 |
13 |
! |
14 |
! Authors: P. Fleurat-Lessard, P. Dayal |
15 |
! Contact: optnpath@gmail.com |
16 |
! |
17 |
! This file is part of "Opt'n Path". |
18 |
! |
19 |
! "Opt'n Path" is free software: you can redistribute it and/or modify |
20 |
! it under the terms of the GNU Affero General Public License as |
21 |
! published by the Free Software Foundation, either version 3 of the License, |
22 |
! or (at your option) any later version. |
23 |
! |
24 |
! "Opt'n Path" is distributed in the hope that it will be useful, |
25 |
! but WITHOUT ANY WARRANTY; without even the implied warranty of |
26 |
! |
27 |
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
28 |
! GNU Affero General Public License for more details. |
29 |
! |
30 |
! You should have received a copy of the GNU Affero General Public License |
31 |
! along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>. |
32 |
! |
33 |
! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr, |
34 |
! for commercial licensing opportunities. |
35 |
!---------------------------------------------------------------------- |
36 |
|
37 |
use Path_module, only : Nat, renum,Order,OrderInv, Coord, ProgExe,v_direct,latr |
38 |
use Io_module |
39 |
|
40 |
IMPLICIT NONE |
41 |
|
42 |
INTERFACE |
43 |
function valid(string) result (isValid) |
44 |
CHARACTER(*), intent(in) :: string |
45 |
logical :: isValid |
46 |
END function VALID |
47 |
|
48 |
|
49 |
SUBROUTINE die(routine, msg, file, line, unit) |
50 |
|
51 |
Use VarTypes |
52 |
Use io_module |
53 |
|
54 |
implicit none |
55 |
!--------------------------------------------------------------- Input Variables |
56 |
character(len=*), intent(in) :: routine, msg |
57 |
character(len=*), intent(in), optional :: file |
58 |
integer(KINT), intent(in), optional :: line, unit |
59 |
|
60 |
END SUBROUTINE die |
61 |
|
62 |
SUBROUTINE Warning(routine, msg, file, line, unit) |
63 |
|
64 |
Use VarTypes |
65 |
Use io_module |
66 |
|
67 |
implicit none |
68 |
|
69 |
character(len=*), intent(in) :: routine, msg |
70 |
character(len=*), intent(in), optional :: file |
71 |
integer(KINT), intent(in), optional :: line, unit |
72 |
|
73 |
END SUBROUTINE Warning |
74 |
|
75 |
|
76 |
SUBROUTINE WriteList(Input,Unit) |
77 |
|
78 |
! This routine reads an input template for Siesta |
79 |
|
80 |
use VarTypes |
81 |
use Io_module |
82 |
|
83 |
IMPLICIT NONE |
84 |
|
85 |
! Input |
86 |
TYPE (Input_line), POINTER, INTENT(IN) :: Input |
87 |
INTEGER(KINT), OPTIONAL, INTENT(IN) :: Unit |
88 |
|
89 |
END SUBROUTINE WriteList |
90 |
END INTERFACE |
91 |
|
92 |
|
93 |
! Energy |
94 |
REAL(KREAL), INTENT (OUT) :: e |
95 |
! Geometry in cartesian coordinates |
96 |
REAL(KREAL), INTENT (IN) :: geomcart(Nat,3) |
97 |
! Gradient calculated at Geom geometry |
98 |
REAL(KREAL), INTENT (OUT) :: gradcart(3*NAt) |
99 |
|
100 |
! ====================================================================== |
101 |
|
102 |
character(LCHARS) :: LINE |
103 |
|
104 |
logical :: debug, TChk |
105 |
LOGICAL, SAVE :: first=.true. |
106 |
|
107 |
REAL(KREAL), ALLOCATABLE :: X(:),Y(:),Z(:) ! Nat |
108 |
REAL(KREAL), ALLOCATABLE :: GeomCartLoc(:,:) !Nat,3 |
109 |
|
110 |
INTEGER(KINT) :: iat, i, J,Idx |
111 |
|
112 |
CHARACTER(LCHARS) :: FileIn, FileOut, FileForces,FileE |
113 |
|
114 |
CHARACTER(3) :: SepIn=' < ', SepOut=' > ' |
115 |
CHARACTER(VLCHARS), SAVE :: RunCommand |
116 |
|
117 |
! ====================================================================== |
118 |
|
119 |
debug=valid('EGRAD').OR.valid('egrad_siesta') |
120 |
|
121 |
if (debug) Call Header("Entering Egrad_siesta") |
122 |
|
123 |
if (first) THEN |
124 |
First=.FALSE. |
125 |
call system("uname > Path.tmp") |
126 |
OPEN(IOTMP,FILE='Path.tmp') |
127 |
READ(IOTMP,'(A)') Line |
128 |
CLOSE(IOTMP) |
129 |
IF (index(Line,'CYGWIN').NE.0) THEN |
130 |
SepIn=' ' |
131 |
SepOut=' ' |
132 |
END IF |
133 |
END IF |
134 |
|
135 |
ALLOCATE(GeomCartLoc(Nat,3)) |
136 |
|
137 |
gradcart=0. |
138 |
E=0. |
139 |
FileIn=Trim(CalcName) // "." // Trim(ISuffix) |
140 |
FileOut=Trim(CalcName) // "." // Trim(OSuffix) |
141 |
FileForces=Trim(Siesta_Label) // ".FA" |
142 |
FileE='BASIS_ENTHALPY' |
143 |
|
144 |
RunCommand=Trim(ProgExe) // SepIn // Trim(FileIn) // SepOut // Trim(FileOut) |
145 |
|
146 |
IF (DEBUG) WRITE(*,*)'RunCommand:',TRIM(RunCommand) |
147 |
|
148 |
! we create the input file |
149 |
|
150 |
OPEN(IOTMP,File=FileIn) |
151 |
|
152 |
Call WriteList(Siesta_input,Unit=IOTMP) |
153 |
|
154 |
WRITE(IOTMP,*) |
155 |
|
156 |
IF (V_Direct=='DIRECT') THEN |
157 |
ALLOCATE(X(Nat),Y(Nat),Z(Nat)) |
158 |
X=0. |
159 |
Y=0. |
160 |
Z=0. |
161 |
DO I=1,Nat |
162 |
DO J=1,3 |
163 |
X(I)=X(I)+GeomCart(I,J)*Latr(1,J) |
164 |
Y(I)=Y(I)+GeomCart(I,J)*Latr(2,J) |
165 |
Z(I)=Z(I)+GeomCart(I,J)*Latr(3,J) |
166 |
END DO |
167 |
END DO |
168 |
GeomCartLoc(1:Nat,1)=X(1:Nat) |
169 |
GeomCartLoc(1:Nat,2)=Y(1:Nat) |
170 |
GeomCartLoc(1:Nat,3)=Z(1:Nat) |
171 |
DEALLOCATE(X,Y,Z) |
172 |
ELSE |
173 |
GeomCartLoc=GeomCart |
174 |
END IF |
175 |
|
176 |
WRITE(IOTMP,'(1X,A)') '%block AtomicCoordinatesAndAtomicSpecies' |
177 |
|
178 |
DO I=1,Nat |
179 |
If (renum) THEN |
180 |
Iat=Order(I) |
181 |
WRITE(IOTMP,'(1X,3(1X,F15.8),1X,I5,1X,A)') GeomCart(Iat,:)/Siesta_Unit_Read, IdxSpecies(Iat),TRIM(Siesta_Paste(I)) |
182 |
ELSE |
183 |
Iat=OrderInv(I) |
184 |
WRITE(IOTMP,'(1X,3(1X,F15.8),1X,I5,1X,A)') GeomCart(I,:)/Siesta_Unit_Read, IdxSpecies(Iat), TRIM(Siesta_Paste(Iat)) |
185 |
END IF |
186 |
END DO |
187 |
|
188 |
WRITE(IOTMP,'(1X,A)') '%endblock AtomicCoordinatesAndAtomicSpecies' |
189 |
WRITE(IOTMP,*) |
190 |
|
191 |
CLOSE(IOTMP) |
192 |
|
193 |
IF (debug) THEN |
194 |
WRITE(*,*) 'DBG EGRAD ' // Trim(FileIn),' COORD=',TRIM(COORD) |
195 |
call system('cat ' // Trim(FileIn)) |
196 |
END IF |
197 |
|
198 |
call system(RunCommand) |
199 |
|
200 |
if (debug) WRITE(*,*) 'DBG EGRAD, back from calculation' |
201 |
|
202 |
! Whatever the coordinate system, we read the cartesian gradient |
203 |
! and we convert it to Zmat or other if needed |
204 |
|
205 |
! in Siesta, the forces are in the file 'Label'.FA so this is easy to read :) |
206 |
OPEN(IOTMP,FILE=FileForces, STATUS='old') |
207 |
! firt line is the atom number |
208 |
READ(IOTMP,'(A)') LINE |
209 |
|
210 |
if (debug) WRITE(*,*) "GradCart reading - renum=",Renum |
211 |
DO I=1,Nat |
212 |
Iat=I |
213 |
IF (renum) Iat=Order(I) |
214 |
READ(IOTMP,'(6X,3(F12.6))') GradCart(3*Iat-2:3*Iat) |
215 |
if (debug) WRITE(*,*) "I,Iat,GradCart:",I,Iat,GradCart(3*Iat-2:3*Iat) |
216 |
END DO |
217 |
|
218 |
! Siesta gives the Forces in eV/Ang, so we convert it into the |
219 |
! gradient in au/Angstrom |
220 |
gradCart=-1.0d0*ev2au*gradCart |
221 |
|
222 |
CLOSE(IOTMP) |
223 |
|
224 |
! We now have to read the energy |
225 |
|
226 |
INQUIRE(File=FileE,EXIST=TChk) |
227 |
If (Tchk) THEN |
228 |
! We have a BASIS_ENTHALPY file. Great. |
229 |
! Energy is the last number on the second line |
230 |
OPEN(IOTMP,File=FileE,Status='Old') |
231 |
READ(IOTMP,*) Line |
232 |
READ(IOTMP,'(A)') Line |
233 |
if (debug) WRITE(*,*) "Line E:",TRIM(LINE) |
234 |
Idx=INDEX(TRIM(LINE),' ',BACK=.TRUE.) |
235 |
Line=Line(Idx+1:) |
236 |
if (debug) WRITE(*,*) "Line E:",TRIM(LINE) |
237 |
Read(Line,*) E |
238 |
ELSE |
239 |
! We do not have this file... we have to look for it in the .out file |
240 |
FileE=FileOut |
241 |
OPEN(IOTMP,File=FileE,Status='Old') |
242 |
! We search for "siesta: Total =" |
243 |
Line="" |
244 |
DO WHILE (INDEX(Line,"siesta: Total =")/=1) |
245 |
READ(IOTMP,*) Line |
246 |
END DO |
247 |
|
248 |
Idx=INDEX(TRIM(LINE),' ',BACK=.TRUE.) |
249 |
Line=Line(Idx+1:) |
250 |
Read(Line,*) E |
251 |
END IF |
252 |
CLOSE (IOTMP) |
253 |
|
254 |
WRITE(*,*) 'E=',E |
255 |
WRITE(*,*) 'Gradcart=' |
256 |
DO I=1,Nat |
257 |
WRITE(*,'(1X,3(1X,F15.8))') GradCart(3*I-2:3*I) |
258 |
END DO |
259 |
|
260 |
DeAllocate(GeomCartLoc) |
261 |
|
262 |
! Call Die('Egrad_Siesta','Ah ah.',UNIT=IOOUT) |
263 |
if (debug) Call header("Egrad_siesta Over") |
264 |
|
265 |
|
266 |
|
267 |
RETURN |
268 |
|
269 |
! ====================================================================== |
270 |
end subroutine egrad_siesta |