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