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