Statistiques
| Révision :

root / src / ReadInput_siesta.f90 @ 6

Historique | Voir | Annoter | Télécharger (12,4 ko)

1
 SUBROUTINE ReadInput_siesta
2

    
3
! This routine reads an input template for Siesta
4

    
5
  use VarTypes
6
  use Path_module
7
  use Io_module
8

    
9
  IMPLICIT NONE
10

    
11
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
12
!
13
  INTERFACE
14
!
15
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16

    
17
     function valid(string) result (isValid)
18
       CHARACTER(*), intent(in) :: string
19
       logical                  :: isValid
20
     END function VALID
21

    
22
    FUNCTION SearchInput(Input,String,Line,Clean)  Result (Found)
23

    
24
      Use Vartypes
25
      use io_module
26
! Input
27
      TYPE (Input_line), POINTER, INTENT(IN) :: Input
28
      CHARACTER(*), INTENT(IN) :: String
29
      CHARACTER(*), OPTIONAL, INTENT(IN) :: Clean
30

    
31
! Output
32
      TYPE (Input_line), POINTER, INTENT(OUT) :: Line
33

    
34
      LOGICAL :: Found
35

    
36
    END FUNCTION SearchInput
37

    
38
    FUNCTION InString(Line,String,Case,Clean,Back)  Result(Pos)
39

    
40
      Use VarTypes
41

    
42
      implicit none
43
! Input
44
      CHARACTER(*), INTENT(IN) :: Line
45
      CHARACTER(*), INTENT(IN) :: String
46
      LOGICAL, OPTIONAL, INTENT(IN) :: Case
47
      LOGICAL, OPTIONAL, INTENT(IN) :: Back
48
      CHARACTER(*), OPTIONAL, INTENT(IN) :: Clean
49

    
50
! Output
51
! the position of String in Line (the first one) unless Back is present
52
      INTEGER(KINT) :: Pos
53
    END FUNCTION InString
54

    
55
    SUBROUTINE die(routine, msg, file, line, unit)
56

    
57
      Use VarTypes
58
      Use io_module
59

    
60
      implicit none
61
!--------------------------------------------------------------- Input Variables
62
      character(len=*), intent(in)           :: routine, msg
63
      character(len=*), intent(in), optional :: file
64
      integer(KINT), intent(in), optional      :: line, unit
65

    
66
    END SUBROUTINE die
67

    
68
    SUBROUTINE Warning(routine, msg, file, line, unit)
69

    
70
      Use VarTypes
71
      Use io_module
72

    
73
      implicit none
74

    
75
      character(len=*), intent(in)           :: routine, msg
76
      character(len=*), intent(in), optional :: file
77
      integer(KINT), intent(in), optional      :: line, unit
78

    
79
    END SUBROUTINE Warning
80

    
81

    
82
 SUBROUTINE WriteList(Input,Unit)
83

    
84
! This routine reads an input template for Siesta
85

    
86
  use VarTypes
87
  use Io_module
88

    
89
  IMPLICIT NONE
90

    
91
! Input
92
      TYPE (Input_line), POINTER, INTENT(IN) :: Input
93
      INTEGER(KINT), OPTIONAL, INTENT(IN) :: Unit
94

    
95
    END SUBROUTINE WriteList
96

    
97
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
98
!
99
 END  INTERFACE
100
!
101
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
102

    
103

    
104
  CHARACTER(132) ::  Line,Line2
105
  INTEGER(KINT) ::  Idx
106
  INTEGER(KINT) ::  IAt,I
107
  INTEGER(KINT) :: IoRead, ITmp
108
  REAL(KREAL) :: Xtmp, Ytmp, Ztmp
109
  
110
  LOGICAL :: Debug
111
  LOGICAL :: FSpecies, FCoord
112

    
113
  TYPE(Input_Line), POINTER :: Search,Bla
114

    
115
  Debug=Valid("readinput").OR.Valid("readinput_siesta")
116

    
117
 if (debug) Call Header("Entering ReadInput_Siesta")
118

    
119
  ! We read the Siesta input file
120

    
121
     ALLOCATE(Siesta_Input)
122
     NULLIFY(Siesta_Input%next)
123
     NULLIFY(Siesta_Input%prev)
124
     Current => Siesta_Input
125

    
126
     FSpecies=.FALSE.
127
     FCoord=.FALSE.
128

    
129
     READ(IOIN,'(A)',iostat=IoRead) Line
130

    
131
     DO WHILE (IoRead==0)
132
        Line=AdjustL(Line)
133
        if (debug) WRITE(*,*) 'Line:', Line
134
        current%Line=TRIM(Line)
135
        ALLOCATE(current%next)
136
        Current%next%prev => Current
137
        Current => Current%next
138
        current%line="toto"
139
        Nullify(Current%next)
140

    
141
        READ(IOIN,'(A)',iostat=IoRead) Line
142
     END DO
143
! With this procedure, the last current is not valid and should be deleted.
144
       Bla => Current%prev
145
       nullify(Bla%next)
146
       deallocate(Current)
147
       current => Bla
148

    
149
     if (debug) THEN
150
        WRITE(*,*) 'Input just read'
151
        Call WriteList(Siesta_input,Unit=IOOUT)
152
     END IF
153

    
154
! We analyse the input
155

    
156
! We look for the NumberofAtoms
157
     If (SearchInput(Siesta_Input,"NUMBEROFATOMS",Search,Clean=".-_")) THEN
158
        Line=AdjustL(Search%line)
159
        Idx=Index(Line," ")
160
        Line2=Trim(AdjustL(Line(Idx+1:)))
161
        Read(Line2,*) IAt
162
        if (Iat/=Nat) THEN
163
           Call Die('ReadInput_siesta','Nat in FDF sample different from  Nat Path input', Unit=IOOUT)
164
        END IF
165
     ELSE
166
! There is no atom number defined !!!
167
           Call Warning('ReadInput_siesta','No NumberOfAtoms in FDF sample', Unit=IOOUT)
168
           WRITE(current%Line,'(1X,"NumberOfAtoms ",I5)') Nat
169
           ALLOCATE(current%next)
170
           Current%next%prev => Current
171
           Current => Current%next
172
           Nullify(Current%next)
173
         
174
        END IF
175

    
176
! We look for the NumberofSpecies
177
        IF (SearchInput(Siesta_Input,"NUMBEROFSPECIES",Search,Clean=".-_")) THEN
178
           Line=AdjustL(Search%line)
179
           Idx=Index(Line," ")
180
           Line2=Trim(AdjustL(Line(Idx+1:)))
181
           Read(Line2,*) Siesta_NbSpecies
182
           ALLOCATE(ListSpecies(Siesta_NbSpecies))
183
           ALLOCATE(Siesta_SpeciesName(Siesta_NbSpecies))
184
        END IF
185

    
186
! We look for SystemLabel
187
        If (SearchInput(Siesta_Input,"SYSTEMLABEL",Search,Clean=".-_")) THEN
188
           Line=AdjustL(Search%line)
189
           Idx=Index(Line," ")
190
           Siesta_Label=Trim(adjustl(Line(Idx+1:)))
191
        ELSE
192
           Siesta_label='siesta'
193
        END IF
194

    
195
! We look for the ChemicalSpeciesLabel block
196
        IF (SearchInput(Siesta_Input,"CHEMICALSPECIESLABEL",Search,Clean=".-_")) THEN
197
           if (.NOT.ALLOCATED(IdxSpecies)) ALLOCATE(IdxSpecies(NAt))
198
           I=0
199
           Search => Search%next
200
           DO WHILE (InString(Search%line,'ENDBLOCK',Case=.FALSE.,Clean=".-_")==0)
201
              I=I+1
202
              if (I>Siesta_NbSpecies) THEN
203
                 Call Die('ReadInput_siesta:Reading ChemicalSpeciesLabel','Found more line in this block than NbSpecies !')
204
              END IF
205
              Line=AdjustL(Search%Line)
206
              Read(Line,*) ITmp
207
              Idx=Index(Line,' ')
208
              Line=AdjustL(Line(Idx+1:))
209
              Read(Line,*) Ztmp
210
              ListSpecies(ITmp)=ZTmp
211
              Idx=Index(Line,' ')
212
              Line=AdjustL(Line(Idx+1:))
213
              Idx=Index(Line,' ')
214
              Siesta_SpeciesName(ITmp)=Line(1:Idx-1)
215
              Search => Search%next
216
           END DO
217
           IF (I/=Siesta_NbSpecies) Call Die('ReadInput_siesta:Reading ChemicalSpeciesLabel', &
218
                'Number of lines in this block different from NbSpecies')
219
        ELSE
220
           Call Die('ReadInput_siesta:Reading ChemicalSpeciesLabel', &
221
                'Block ChemicalSpeciesLabel is mandatory !')
222
        END IF
223

    
224

    
225
! We look for the AtomicCoordinatesAndAtomicSpecies  block
226
        IF (SearchInput(Siesta_Input,"ATOMICCOORDINATESANDATOMICSPECIES",Search,Clean=".-_")) THEN
227
           ALLOCATE(Siesta_Paste(Nat))
228
           Current=>Search
229
           DO I=1,NAt
230
              Search => Search%next
231
              Read(Search%line,*) XTmp,YTmp,ZTmp,IdxSpecies(I)
232
! We give a name to this atom
233
              IF (AtName(I)/="") THEN
234
!                    Write(Line,'(A,I5,1X,A2,1X,A32)') 'AtName & SpeciesName for atom ',I,AtName(I), &
235
!                         TRIM(Siesta_SpeciesName(IdxSpecies(I)))
236
!                    WRITE(*,'(1X,A)') Line
237
                 If (InString(Atname(I),TRIM(Siesta_SpeciesName(IdxSpecies(I))))==0) THEN
238
                    Write(Line,'(A,I5,1X,A2,1X,A32)') 'AtName /= SpeciesName for atom ',I,AtName(I), &
239
                         TRIM(Siesta_SpeciesName(IdxSpecies(I)))
240
                    Call Die('Readinput_siesta:Reading AtomicCoordinatesAndAtomicSpecies',Line,Unit=IOOUT)
241
                 END IF
242
              ELSE
243
                 AtName(I)=AdjustL(Trim(Siesta_SpeciesName(IdxSpecies(I))))
244
              END IF
245
! we look for something else at the end of the line
246
! We save everything but the x,y,z, and species description              
247
              Line=AdjustL(search%line)
248
! We skip x
249
              Idx=Index(Line,' ')
250
              Line=AdjustL(Line(Idx+1:))
251
! we skip y
252
              Idx=Index(Line,' ')
253
              Line=AdjustL(Line(Idx+1:))
254
! we skip z
255
              Idx=Index(Line,' ')
256
              Line=AdjustL(Line(Idx+1:))
257
! we skip species
258
              Idx=Index(Line,' ')
259
              Line=AdjustL(Line(Idx+1:))
260
              Siesta_Paste(I)=TRIM(Line)
261
           END DO
262
           if (debug) THEN
263
              WRITE(*,*) 'Input before deletion of coord block'
264
              Call WriteList(Siesta_input)
265
           END IF
266
! We will now delete this block from our input sample as it will then be
267
! written directly by Opt'n Path
268
! Search%next point on %endblock
269
           search => search%next
270
           IF (ASSOCIATED(Search%next)) THEN
271
! we are not at the end of the input file
272
              if (ASSOCIATED(Current%Prev)) THEN
273
                 Search%next%prev => current%prev
274
                 current%prev%next => search%next
275
              ELSE
276
! the coordinate block is at the begining of the input
277
                 siesta_input => Search%next
278
                 Nullify(Siesta_Input%Prev)
279
              END IF
280
           ELSE
281
! the coordinate block is the last part of the input
282
              nullify(current%prev%next)
283
           END IF
284
           if (debug) THEN
285
              WRITE(*,*) 'Input after deletion of coord block 1'
286
              Call WriteList(Siesta_input)
287
           END IF
288

    
289
           DO I=1,Nat+2
290
              bla=>current
291
              current=> current%next
292
              deallocate(bla)
293
           END DO
294
           if (debug) THEN
295
              WRITE(*,*) 'Input after deletion of coord block 2'
296
              Call WriteList(Siesta_input)
297
           END IF
298
        ELSE
299
           IF (SearchInput(Siesta_Input,"ZMATRIX",Search,Clean=".-_")) THEN
300
              call Die('ReadInput_Siesta','For now, I need the full block'//&
301
                   'AtomicCoordinatesAndAtomicSpecies, ZMatrix not yet handled.')
302
           ELSE
303
              call Die('ReadInput_Siesta','For now, I need the full block' //&
304
              'AtomicCoordinatesAndAtomicSpecies.')
305
           END IF
306
        END IF
307

    
308
        IF (SearchInput(Siesta_Input,"ATOMICCOORDINATESFORMAT",Search,Clean=".-_")) THEN
309
           Line=Adjustl(Search%Line)
310
           Idx=Index(Line,' ')
311
           Line=AdjustL(Line(Idx+1:))
312
           Call UpCase(Line)
313
           SELECT CASE (Line) 
314
              CASE ('ANG','NOTSCALEDCARTESIANANG')
315
                 Siesta_Unit_Read=1.d0
316
              CASE ('FRACTIONAL','SCALEDBYLATTICEVECTORS')
317
              CASE ('BOHR','NOTSCALEDCARTESIANBOHR')
318
                 Siesta_Unit_Read=a0
319
                 IF (INPUT=='SIESTA') THEN
320
! We have read the coordinates, but not the unit. This is corrected here
321
                    XyZGeomI=XyzGeomI*a0
322
                 END IF
323
            END SELECT
324
         END IF
325

    
326
        IF (SearchInput(Siesta_Input,"ATOMICCOORFORMATOUT",Search,Clean=".-_")) THEN
327
           Line=Adjustl(Search%Line)
328
           Idx=Index(Line,' ')
329
           Line=AdjustL(Line(Idx+1:))
330
           Call UpCase(Line)
331
           SELECT CASE (Line) 
332
              CASE ('ANG','NOTSCALEDCARTESIANANG')
333
                 Siesta_Unit_Write=1.d0
334
              CASE ('FRACTIONAL','SCALEDBYLATTICEVECTORS')
335
              CASE ('BOHR','NOTSCALEDCARTESIANBOHR')
336
                 Siesta_Unit_Write=Unit
337
            END SELECT
338
         END IF
339

    
340
         IF (SearchInput(Siesta_Input,"LATTICECONSTANT",Search,Clean=".-_")) THEN
341
           Line=Adjustl(Search%Line)
342
! We discar the label
343
           Idx=Index(Line,' ')
344
           Line=AdjustL(Line(Idx+1:))
345
! we read the value
346
           Read(Line,*) Siesta_LatticeConstant
347
! We discard the value
348
           Idx=Index(Line,' ')
349
           Line=AdjustL(Line(Idx+1:))
350
! We read the unit
351
           Call UpCase(Line)
352
           SELECT CASE (Line) 
353
              CASE ('ANG')
354
                 Siesta_Lat_Unit=1.d0
355
              CASE ('BOHR')
356
                 Siesta_Lat_Unit=Unit
357
            END SELECT
358
! for now!
359
            Call Die('ReadInput_siesta:LatticeConstant',"For now, periodic calculations are NOT possible in Opt'n Path")
360

    
361
         END IF
362

    
363
         IF (SearchInput(Siesta_Input,"LATTICEVECTORS",Search,Clean=".-_")) THEN
364

    
365
            Call Die('ReadInput_siesta:LatticeVectors',"For now, periodic calculations are NOT possible in Opt'n Path")
366

    
367
         END IF
368

    
369
         IF (SearchInput(Siesta_Input,"LATTICEPARAMETERS",Search,Clean=".-_")) THEN
370

    
371
            Call Die('ReadInput_siesta:LatticeParameters',"For now, periodic calculations are NOT possible in Opt'n Path")
372

    
373
         END IF
374

    
375
         IF (SearchInput(Siesta_Input,"SUPERCELL",Search,Clean=".-_")) THEN
376

    
377
            Call Die('ReadInput_siesta:SuperCell',"SuperCell  NOT possible in Opt'n Path")
378

    
379
         END IF
380

    
381
!         Call Die('Readinput_siesta:fin',' Lecture finie')
382

    
383
     if (debug) Call Header("Exiting ReadInput_Siesta")
384

    
385
   END SUBROUTINE READINPUT_SIESTA