root / src / egrad_ext.f90 @ 12
Historique | Voir | Annoter | Télécharger (3,61 ko)
1 | 1 | pfleura2 | subroutine egrad_ext(e,geomcart,gradcart) |
---|---|---|---|
2 | 1 | pfleura2 | |
3 | 1 | pfleura2 | ! This routines calculates the energy and the gradient of |
4 | 1 | pfleura2 | ! a molecule, using an external code |
5 | 1 | 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 | 1 | pfleura2 | |
37 | 12 | pfleura2 | |
38 | 8 | pfleura2 | use Path_module, only : Nat, renum,Order,OrderInv,AtName, Coord,ProgExe |
39 | 1 | pfleura2 | use Io_module |
40 | 1 | pfleura2 | |
41 | 1 | pfleura2 | ! |
42 | 1 | pfleura2 | IMPLICIT NONE |
43 | 1 | pfleura2 | |
44 | 1 | pfleura2 | ! Energy (calculated if F300K=.F., else estimated) |
45 | 1 | pfleura2 | REAL(KREAL), INTENT (OUT) :: e |
46 | 1 | pfleura2 | ! Nb degree of freedom |
47 | 1 | pfleura2 | ! Geometry at which gradient is calculated (cf FActual also) |
48 | 1 | pfleura2 | REAL(KREAL), INTENT (IN) :: geomcart(Nat,3) |
49 | 1 | pfleura2 | ! Gradient calculated at Geom geometry |
50 | 1 | pfleura2 | REAL(KREAL), INTENT (OUT) :: gradcart(3*Nat) |
51 | 1 | pfleura2 | |
52 | 1 | pfleura2 | ! ====================================================================== |
53 | 1 | pfleura2 | |
54 | 1 | pfleura2 | |
55 | 1 | pfleura2 | logical :: debug |
56 | 1 | pfleura2 | |
57 | 2 | pfleura2 | REAL(KREAL) :: Pi |
58 | 1 | pfleura2 | |
59 | 2 | pfleura2 | INTEGER(KINT) :: iat, i, n3at |
60 | 1 | pfleura2 | |
61 | 1 | pfleura2 | ! |
62 | 1 | pfleura2 | CHARACTER(132) :: FileIn,FileOut |
63 | 1 | pfleura2 | |
64 | 2 | pfleura2 | CHARACTER(VLCHARS), SAVE :: RunCommand |
65 | 2 | pfleura2 | ! LOGICAL, SAVE :: FCopyRstrt=.False., FOrderChecked=.False. |
66 | 1 | pfleura2 | |
67 | 1 | pfleura2 | |
68 | 1 | pfleura2 | |
69 | 1 | pfleura2 | ! ====================================================================== |
70 | 1 | pfleura2 | |
71 | 1 | pfleura2 | LOGICAL, EXTERNAL :: valid |
72 | 1 | pfleura2 | |
73 | 1 | pfleura2 | ! ====================================================================== |
74 | 1 | pfleura2 | |
75 | 1 | pfleura2 | |
76 | 1 | pfleura2 | Pi=dacos(-1.0d0) |
77 | 1 | pfleura2 | n3at=3*nat |
78 | 1 | pfleura2 | |
79 | 1 | pfleura2 | debug=valid('EGRAD') |
80 | 1 | pfleura2 | if (debug) WRITE(*,*) '================ Entering Egrad_ext ====================' |
81 | 1 | pfleura2 | |
82 | 1 | pfleura2 | RunCommand=Trim(Adjustl(ProgExe)) |
83 | 1 | pfleura2 | FileIn=Trim(CalcName) // Trim(ISuffix) |
84 | 1 | pfleura2 | FileOut=Trim(CalcName) // Trim(OSuffix) |
85 | 1 | pfleura2 | |
86 | 1 | pfleura2 | IF (DEBUG) WRITE(*,*)'RunCommand:',TRIM(RunCommand) |
87 | 1 | pfleura2 | |
88 | 1 | pfleura2 | ! we create the input file |
89 | 1 | pfleura2 | |
90 | 1 | pfleura2 | OPEN(IOTMP,File=FileIn) |
91 | 1 | pfleura2 | |
92 | 1 | pfleura2 | WRITE(IOTMP,'(1X,I10)') NAt |
93 | 1 | pfleura2 | WRITE(IOTMP,'(1X,A)') Coord |
94 | 1 | pfleura2 | |
95 | 1 | pfleura2 | DO I=1,Nat |
96 | 1 | pfleura2 | If (renum) THEN |
97 | 1 | pfleura2 | Iat=Order(I) |
98 | 1 | pfleura2 | WRITE(IOTMP,'(1X,A10,3(1X,F15.8),A)') Trim(AtName(I)),GeomCart(Iat,:) |
99 | 1 | pfleura2 | ELSE |
100 | 1 | pfleura2 | Iat=OrderInv(I) |
101 | 1 | pfleura2 | WRITE(IOTMP,'(1X,A10,3(1X,F15.8),A)') Trim(AtName(Iat)),GeomCart(I,:) |
102 | 1 | pfleura2 | END IF |
103 | 1 | pfleura2 | END DO |
104 | 1 | pfleura2 | |
105 | 1 | pfleura2 | call system(RunCommand) |
106 | 1 | pfleura2 | |
107 | 1 | pfleura2 | if (debug) WRITE(*,*) 'DBG EGRAD, back from calculation' |
108 | 1 | pfleura2 | |
109 | 1 | pfleura2 | OPEN(IOTMP,FILE=FileOut, STATUS='old') |
110 | 1 | pfleura2 | ! We first search for the forces |
111 | 1 | pfleura2 | READ(IOTMP,*) e |
112 | 1 | pfleura2 | DO I=1,Nat |
113 | 1 | pfleura2 | Iat=I |
114 | 1 | pfleura2 | IF (renum) Iat=Order(I) |
115 | 1 | pfleura2 | READ(IOTMP,*) GradCart(3*Iat-2:3*Iat) |
116 | 1 | pfleura2 | END DO |
117 | 1 | pfleura2 | |
118 | 1 | pfleura2 | CLOSE(IOTMP) |
119 | 1 | pfleura2 | |
120 | 1 | pfleura2 | |
121 | 1 | pfleura2 | if (debug) WRITE(*,*) '================ Egrad_ext Over ====================' |
122 | 1 | pfleura2 | |
123 | 1 | pfleura2 | RETURN |
124 | 1 | pfleura2 | |
125 | 2 | pfleura2 | !999 CONTINUE |
126 | 2 | pfleura2 | ! if (.NOT.Ftmp) WRITE(*,*) 'We should not be here !!!!' |
127 | 2 | pfleura2 | ! STOP |
128 | 1 | pfleura2 | ! ====================================================================== |
129 | 1 | pfleura2 | end subroutine egrad_ext |