root / src / Energy_GEDIIS.f90
Historique | Voir | Annoter | Télécharger (2,38 ko)
1 | 1 | pfleura2 | SUBROUTINE Energy_GEDIIS(MRESET,MSET,ci,GeomSet,GradSet,ESET,NCoord,ER_star) |
---|---|---|---|
2 | 12 | pfleura2 | !---------------------------------------------------------------------- |
3 | 12 | pfleura2 | ! Copyright 2003-2014 Ecole Normale Supérieure de Lyon, |
4 | 12 | pfleura2 | ! Centre National de la Recherche Scientifique, |
5 | 12 | pfleura2 | ! Université Claude Bernard Lyon 1. All rights reserved. |
6 | 12 | pfleura2 | ! |
7 | 12 | pfleura2 | ! This work is registered with the Agency for the Protection of Programs |
8 | 12 | pfleura2 | ! as IDDN.FR.001.100009.000.S.P.2014.000.30625 |
9 | 12 | pfleura2 | ! |
10 | 12 | pfleura2 | ! Authors: P. Fleurat-Lessard, P. Dayal |
11 | 12 | pfleura2 | ! Contact: optnpath@gmail.com |
12 | 12 | pfleura2 | ! |
13 | 12 | pfleura2 | ! This file is part of "Opt'n Path". |
14 | 12 | pfleura2 | ! |
15 | 12 | pfleura2 | ! "Opt'n Path" is free software: you can redistribute it and/or modify |
16 | 12 | pfleura2 | ! it under the terms of the GNU Affero General Public License as |
17 | 12 | pfleura2 | ! published by the Free Software Foundation, either version 3 of the License, |
18 | 12 | pfleura2 | ! or (at your option) any later version. |
19 | 12 | pfleura2 | ! |
20 | 12 | pfleura2 | ! "Opt'n Path" is distributed in the hope that it will be useful, |
21 | 12 | pfleura2 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of |
22 | 12 | pfleura2 | ! |
23 | 12 | pfleura2 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
24 | 12 | pfleura2 | ! GNU Affero General Public License for more details. |
25 | 12 | pfleura2 | ! |
26 | 12 | pfleura2 | ! You should have received a copy of the GNU Affero General Public License |
27 | 12 | pfleura2 | ! along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>. |
28 | 12 | pfleura2 | ! |
29 | 12 | pfleura2 | ! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr, |
30 | 12 | pfleura2 | ! for commercial licensing opportunities. |
31 | 12 | pfleura2 | !---------------------------------------------------------------------- |
32 | 12 | pfleura2 | |
33 | 1 | pfleura2 | IMPLICIT NONE |
34 | 1 | pfleura2 | integer, parameter :: KINT = kind(1) |
35 | 1 | pfleura2 | integer, parameter :: KREAL = kind(1.0d0) |
36 | 1 | pfleura2 | |
37 | 1 | pfleura2 | |
38 | 1 | pfleura2 | INTEGER(KINT) :: MRESET, MSET, NCoord |
39 | 1 | pfleura2 | REAL(KREAL) :: ci(MRESET), GeomSet(MRESET*NCoord), GradSet(MRESET*NCoord), ESET(MRESET) |
40 | 1 | pfleura2 | REAL(KREAL) :: ER_star, tmp |
41 | 1 | pfleura2 | |
42 | 2 | pfleura2 | INTEGER(KINT) :: I, IX, JX, INV, JNV, KX |
43 | 1 | pfleura2 | |
44 | 1 | pfleura2 | LOGICAL PRINT |
45 | 1 | pfleura2 | |
46 | 1 | pfleura2 | PRINT=.FALSE. |
47 | 1 | pfleura2 | |
48 | 1 | pfleura2 | IF (PRINT) WRITE(*,'(/,'' BEGIN Energy_GEDIIS '')') |
49 | 1 | pfleura2 | |
50 | 1 | pfleura2 | ER_star=0.D0 |
51 | 1 | pfleura2 | INV=-NCoord |
52 | 1 | pfleura2 | DO IX=1,MSET |
53 | 1 | pfleura2 | INV=INV+NCoord |
54 | 1 | pfleura2 | JNV=-NCoord |
55 | 1 | pfleura2 | DO JX=1,MSET |
56 | 1 | pfleura2 | JNV=JNV+NCoord |
57 | 1 | pfleura2 | tmp=0.D0 |
58 | 1 | pfleura2 | DO KX=1, NCoord |
59 | 1 | pfleura2 | tmp = tmp + (((GradSet(INV+KX)-GradSet(JNV+KX))*(GeomSet(INV+KX)-GeomSet(JNV+KX)))/2.D0) |
60 | 1 | pfleura2 | END DO |
61 | 1 | pfleura2 | ER_star = ER_star + ci(IX)*ci(JX)*tmp |
62 | 1 | pfleura2 | END DO |
63 | 1 | pfleura2 | END DO |
64 | 1 | pfleura2 | |
65 | 1 | pfleura2 | DO I=1, MSET |
66 | 1 | pfleura2 | ER_star = ER_star + (ci(I)*ESET(I)) |
67 | 1 | pfleura2 | END DO |
68 | 1 | pfleura2 | |
69 | 1 | pfleura2 | IF (PRINT) WRITE(*,'(/,'' END Energy_GEDIIS '',/)') |
70 | 1 | pfleura2 | |
71 | 1 | pfleura2 | END SUBROUTINE Energy_GEDIIS |