root / src / ReadAnaList.f90 @ 12
Historique | Voir | Annoter | Télécharger (5,47 ko)
1 | 7 | pfleura2 | SUBROUTINE ReadAnaList |
---|---|---|---|
2 | 7 | pfleura2 | ! This routines read a list of geometrical variables to monitor |
3 | 7 | pfleura2 | ! This is inspired from Xyz2Path (that was inspired by Xyz2scan ...) |
4 | 7 | pfleura2 | |
5 | 12 | pfleura2 | !---------------------------------------------------------------------- |
6 | 12 | pfleura2 | ! Copyright 2003-2014 Ecole Normale Supérieure de Lyon, |
7 | 12 | pfleura2 | ! Centre National de la Recherche Scientifique, |
8 | 12 | pfleura2 | ! Université Claude Bernard Lyon 1. All rights reserved. |
9 | 12 | pfleura2 | ! |
10 | 12 | pfleura2 | ! This work is registered with the Agency for the Protection of Programs |
11 | 12 | pfleura2 | ! as IDDN.FR.001.100009.000.S.P.2014.000.30625 |
12 | 12 | pfleura2 | ! |
13 | 12 | pfleura2 | ! Authors: P. Fleurat-Lessard, P. Dayal |
14 | 12 | pfleura2 | ! Contact: optnpath@gmail.com |
15 | 12 | pfleura2 | ! |
16 | 12 | pfleura2 | ! This file is part of "Opt'n Path". |
17 | 12 | pfleura2 | ! |
18 | 12 | pfleura2 | ! "Opt'n Path" is free software: you can redistribute it and/or modify |
19 | 12 | pfleura2 | ! it under the terms of the GNU Affero General Public License as |
20 | 12 | pfleura2 | ! published by the Free Software Foundation, either version 3 of the License, |
21 | 12 | pfleura2 | ! or (at your option) any later version. |
22 | 12 | pfleura2 | ! |
23 | 12 | pfleura2 | ! "Opt'n Path" is distributed in the hope that it will be useful, |
24 | 12 | pfleura2 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of |
25 | 12 | pfleura2 | ! |
26 | 12 | pfleura2 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
27 | 12 | pfleura2 | ! GNU Affero General Public License for more details. |
28 | 12 | pfleura2 | ! |
29 | 12 | pfleura2 | ! You should have received a copy of the GNU Affero General Public License |
30 | 12 | pfleura2 | ! along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>. |
31 | 12 | pfleura2 | ! |
32 | 12 | pfleura2 | ! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr, |
33 | 12 | pfleura2 | ! for commercial licensing opportunities. |
34 | 12 | pfleura2 | !---------------------------------------------------------------------- |
35 | 7 | pfleura2 | |
36 | 12 | pfleura2 | |
37 | 7 | pfleura2 | use VarTypes |
38 | 7 | pfleura2 | use Path_module |
39 | 7 | pfleura2 | use Io_module |
40 | 7 | pfleura2 | |
41 | 7 | pfleura2 | IMPLICIT NONE |
42 | 7 | pfleura2 | |
43 | 7 | pfleura2 | |
44 | 7 | pfleura2 | INTERFACE |
45 | 7 | pfleura2 | function valid(string) result (isValid) |
46 | 7 | pfleura2 | CHARACTER(*), intent(in) :: string |
47 | 7 | pfleura2 | logical :: isValid |
48 | 7 | pfleura2 | END function VALID |
49 | 7 | pfleura2 | |
50 | 7 | pfleura2 | SUBROUTINE die(routine, msg, file, line, unit) |
51 | 7 | pfleura2 | |
52 | 7 | pfleura2 | Use VarTypes |
53 | 7 | pfleura2 | Use io_module |
54 | 7 | pfleura2 | |
55 | 7 | pfleura2 | implicit none |
56 | 7 | pfleura2 | |
57 | 7 | pfleura2 | character(len=*), intent(in) :: routine, msg |
58 | 7 | pfleura2 | character(len=*), intent(in), optional :: file |
59 | 7 | pfleura2 | integer(KINT), intent(in), optional :: line, unit |
60 | 7 | pfleura2 | |
61 | 7 | pfleura2 | END SUBROUTINE die |
62 | 7 | pfleura2 | |
63 | 7 | pfleura2 | END INTERFACE |
64 | 7 | pfleura2 | |
65 | 8 | pfleura2 | LOGICAL :: Debug |
66 | 7 | pfleura2 | INTEGER(KINT) :: At1,At2,At3,At4 |
67 | 7 | pfleura2 | INTEGER(KINT) :: I,Idx,J |
68 | 7 | pfleura2 | |
69 | 7 | pfleura2 | CHARACTER(LCHARS) :: Line |
70 | 7 | pfleura2 | |
71 | 7 | pfleura2 | Debug=Valid('ReadAnaList') |
72 | 7 | pfleura2 | If (Debug) Call Header("Entering ReadAnaList") |
73 | 7 | pfleura2 | |
74 | 7 | pfleura2 | Allocate(Bary) |
75 | 7 | pfleura2 | Nullify(Bary%Next) |
76 | 7 | pfleura2 | CurBary => Bary |
77 | 7 | pfleura2 | |
78 | 7 | pfleura2 | ALLOCATE(GeomList) |
79 | 7 | pfleura2 | Nullify(GeomList%Next) |
80 | 7 | pfleura2 | CurVar => GeomList |
81 | 7 | pfleura2 | |
82 | 7 | pfleura2 | NbCom=0 |
83 | 7 | pfleura2 | NbVar=0 |
84 | 8 | pfleura2 | FormAna='(1X,F8.3' |
85 | 7 | pfleura2 | DO I=1, Nb |
86 | 7 | pfleura2 | READ(IOIN,'(A)') Line |
87 | 7 | pfleura2 | Line=AdjustL(Line) |
88 | 7 | pfleura2 | Call Upcase(Line) |
89 | 7 | pfleura2 | |
90 | 7 | pfleura2 | SELECT CASE (Line(1:1)) |
91 | 7 | pfleura2 | CASE ('B') |
92 | 7 | pfleura2 | ! this is a bond |
93 | 7 | pfleura2 | CurVar%Type="BOND" |
94 | 7 | pfleura2 | Idx=Index(Line," ") |
95 | 7 | pfleura2 | Line=Line(Idx+1:) |
96 | 7 | pfleura2 | Read(Line,*) At1, At2 |
97 | 7 | pfleura2 | CurVar%At1=At1 |
98 | 7 | pfleura2 | CurVar%At2=At2 |
99 | 7 | pfleura2 | CurVar%Value=0. |
100 | 7 | pfleura2 | ! CurVar%PrintFactor=1. |
101 | 7 | pfleura2 | Curvar%SignDihedral=1 |
102 | 7 | pfleura2 | if (debug) THEN |
103 | 7 | pfleura2 | WRITE(*,'("# b ",2I3)') At1,At2 |
104 | 7 | pfleura2 | END IF |
105 | 7 | pfleura2 | FormAna=TRIM(FormAna) //',1X,F7.3' |
106 | 7 | pfleura2 | Allocate(CurVar%Next) |
107 | 7 | pfleura2 | CurVar => CurVar%Next |
108 | 7 | pfleura2 | Nullify(CurVar%Next) |
109 | 7 | pfleura2 | CASE ('A') |
110 | 7 | pfleura2 | ! this is a valence angle |
111 | 7 | pfleura2 | CurVar%Type="ANGLE" |
112 | 7 | pfleura2 | Idx=Index(Line," ") |
113 | 7 | pfleura2 | Line=Line(Idx+1:) |
114 | 7 | pfleura2 | Read(Line,*) At1, At2,At3 |
115 | 7 | pfleura2 | CurVar%At1=At1 |
116 | 7 | pfleura2 | CurVar%At2=At2 |
117 | 7 | pfleura2 | CurVar%At3=At3 |
118 | 7 | pfleura2 | CurVar%Value=0. |
119 | 7 | pfleura2 | ! CurVar%PrintFactor=180./Pi |
120 | 7 | pfleura2 | Curvar%SignDihedral=1 |
121 | 7 | pfleura2 | if (debug) THEN |
122 | 7 | pfleura2 | WRITE(*,'("# a ",4(I3))') At1,At2,At3 |
123 | 7 | pfleura2 | END IF |
124 | 7 | pfleura2 | FormAna=TRIM(FormAna) //',1X,F7.2' |
125 | 7 | pfleura2 | Allocate(CurVar%Next) |
126 | 7 | pfleura2 | CurVar => CurVar%Next |
127 | 7 | pfleura2 | Nullify(CurVar%Next) |
128 | 7 | pfleura2 | CASE ('D') |
129 | 7 | pfleura2 | ! this is a dihedral |
130 | 7 | pfleura2 | CurVar%Type="DIHEDRAL" |
131 | 7 | pfleura2 | Idx=Index(Line," ") |
132 | 7 | pfleura2 | Line=Line(Idx+1:) |
133 | 7 | pfleura2 | Read(Line,*) At1, At2,At3,At4 |
134 | 7 | pfleura2 | CurVar%At1=At1 |
135 | 7 | pfleura2 | CurVar%At2=At2 |
136 | 7 | pfleura2 | CurVar%At3=At3 |
137 | 7 | pfleura2 | CurVar%At4=At4 |
138 | 7 | pfleura2 | CurVar%Value=0. |
139 | 7 | pfleura2 | ! CurVar%PrintFactor=180./Pi |
140 | 7 | pfleura2 | Curvar%SignDihedral=1 |
141 | 7 | pfleura2 | if (debug) THEN |
142 | 7 | pfleura2 | WRITE(*,'("# d ",4(I3))') At1,At2,At3,At4 |
143 | 7 | pfleura2 | END IF |
144 | 8 | pfleura2 | FormAna=TRIM(FormAna) //',1X,F7.2' |
145 | 7 | pfleura2 | Allocate(CurVar%Next) |
146 | 7 | pfleura2 | CurVar => CurVar%Next |
147 | 7 | pfleura2 | Nullify(CurVar%Next) |
148 | 7 | pfleura2 | CASE ('C') |
149 | 7 | pfleura2 | NbCom=NbCom+1 |
150 | 7 | pfleura2 | Idx=Index(Line," ") |
151 | 7 | pfleura2 | Line=Line(Idx+1:) |
152 | 7 | pfleura2 | READ(Line,*) At1 |
153 | 7 | pfleura2 | Allocate(CurBary%ListAtoms(0:At1)) |
154 | 7 | pfleura2 | Allocate(CurBary%Weights(1:At1)) |
155 | 7 | pfleura2 | CurBary%Weights=1. |
156 | 7 | pfleura2 | CurBary%ListAtoms(0)=At1 |
157 | 7 | pfleura2 | Idx=Index(Line," ") |
158 | 7 | pfleura2 | Line=Line(Idx+1:) |
159 | 7 | pfleura2 | READ(Line,*) CurBary%ListAtoms(1:At1) |
160 | 7 | pfleura2 | if (debug) THEN |
161 | 7 | pfleura2 | WRITE(*,'("# c ",I4,20(I3))') At1, & |
162 | 7 | pfleura2 | (CurBary%ListAtoms(j),j=1,At1) |
163 | 7 | pfleura2 | END IF |
164 | 7 | pfleura2 | Allocate(CurBary%Next) |
165 | 7 | pfleura2 | CurBary => CurBary%Next |
166 | 7 | pfleura2 | Nullify(CurBary%Next) |
167 | 7 | pfleura2 | |
168 | 7 | pfleura2 | CASE Default |
169 | 7 | pfleura2 | Call Die('ReadAnaList','Variable not recognized: ' //Line, Unit=IOOUT) |
170 | 7 | pfleura2 | END SELECT |
171 | 7 | pfleura2 | |
172 | 7 | pfleura2 | END DO |
173 | 7 | pfleura2 | |
174 | 7 | pfleura2 | NbVar=Nb-NbCom |
175 | 7 | pfleura2 | |
176 | 7 | pfleura2 | CurVar => GeomList |
177 | 7 | pfleura2 | I=0 |
178 | 7 | pfleura2 | |
179 | 7 | pfleura2 | Allocate(PrintGeomFactor(NbVar)) |
180 | 7 | pfleura2 | DO WHILE (associated(CurVar%Next)) |
181 | 7 | pfleura2 | I=I+1 |
182 | 7 | pfleura2 | SELECT CASE (CurVar%TYPE) |
183 | 7 | pfleura2 | CASE ('ANGLE','DIHEDRAL') |
184 | 7 | pfleura2 | PrintGeomFactor(I)=180./pi |
185 | 7 | pfleura2 | CASE DEFAULT |
186 | 7 | pfleura2 | PrintGeomFactor(I)=1. |
187 | 7 | pfleura2 | END SELECT |
188 | 7 | pfleura2 | CurVar => CurVar%Next |
189 | 7 | pfleura2 | END DO |
190 | 7 | pfleura2 | |
191 | 7 | pfleura2 | FormAna=Trim(FormAna) // ',1X,F7.2,1X,F15.6)' |
192 | 7 | pfleura2 | |
193 | 7 | pfleura2 | |
194 | 7 | pfleura2 | ! if (debug) WRITE(*,*) "NbVar, NbCom,Nb",NbVar,NbCom,Nb |
195 | 7 | pfleura2 | |
196 | 7 | pfleura2 | if (debug) Call Header(" Exiting ReadAnaList") |
197 | 7 | pfleura2 | |
198 | 7 | pfleura2 | END SUBROUTINE ReadAnaList |