Statistiques
| Révision :

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