Statistiques
| Révision :

root / src / ReadInput_siesta.f90 @ 9

Historique | Voir | Annoter | Télécharger (12,86 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(Siesta_SpeciesMass(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,*) Idx
210
              Siesta_SpeciesMass(ITmp)=Idx
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
! We look for the Mass number also
243
                 IF (Atome(I)/=Siesta_SpeciesMass(IdxSpecies(I))) THEN
244
                    Write(Line,'(A,I5,1X,I5,1X,I5)') 'AtMass /= SpeciesMass for atom ',I,Atome(I), &
245
                         Siesta_SpeciesMass(IdxSpecies(I))
246
                    Call Die('ReadInput_siesta:Reading AtomicCoordinatesAndAtomicSpecies',Line,Unit=IOOUT)
247
                 END IF
248
              ELSE
249
                 AtName(I)=AdjustL(Trim(Siesta_SpeciesName(IdxSpecies(I))))
250
                 Atome(I)=Siesta_SpeciesMass(IdxSpecies(I))
251
              END IF
252
! we look for something else at the end of the line
253
! We save everything but the x,y,z, and species description              
254
              Line=AdjustL(search%line)
255
! We skip x
256
              Idx=Index(Line,' ')
257
              Line=AdjustL(Line(Idx+1:))
258
! we skip y
259
              Idx=Index(Line,' ')
260
              Line=AdjustL(Line(Idx+1:))
261
! we skip z
262
              Idx=Index(Line,' ')
263
              Line=AdjustL(Line(Idx+1:))
264
! we skip species
265
              Idx=Index(Line,' ')
266
              Line=AdjustL(Line(Idx+1:))
267
              Siesta_Paste(I)=TRIM(Line)
268
           END DO
269
           if (debug) THEN
270
              WRITE(*,*) 'Input before deletion of coord block'
271
              Call WriteList(Siesta_input)
272
           END IF
273
! We will now delete this block from our input sample as it will then be
274
! written directly by Opt'n Path
275
! Search%next point on %endblock
276
           search => search%next
277
           IF (ASSOCIATED(Search%next)) THEN
278
! we are not at the end of the input file
279
              if (ASSOCIATED(Current%Prev)) THEN
280
                 Search%next%prev => current%prev
281
                 current%prev%next => search%next
282
              ELSE
283
! the coordinate block is at the begining of the input
284
                 siesta_input => Search%next
285
                 Nullify(Siesta_Input%Prev)
286
              END IF
287
           ELSE
288
! the coordinate block is the last part of the input
289
              nullify(current%prev%next)
290
           END IF
291
           if (debug) THEN
292
              WRITE(*,*) 'Input after deletion of coord block 1'
293
              Call WriteList(Siesta_input)
294
           END IF
295

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

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

    
333
        IF (SearchInput(Siesta_Input,"ATOMICCOORFORMATOUT",Search,Clean=".-_")) THEN
334
           Line=Adjustl(Search%Line)
335
           Idx=Index(Line,' ')
336
           Line=AdjustL(Line(Idx+1:))
337
           Call UpCase(Line)
338
           SELECT CASE (Line) 
339
              CASE ('ANG','NOTSCALEDCARTESIANANG')
340
                 Siesta_Unit_Write=1.d0
341
              CASE ('FRACTIONAL','SCALEDBYLATTICEVECTORS')
342
              CASE ('BOHR','NOTSCALEDCARTESIANBOHR')
343
                 Siesta_Unit_Write=Unit
344
            END SELECT
345
         END IF
346

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

    
368
         END IF
369

    
370
         IF (SearchInput(Siesta_Input,"LATTICEVECTORS",Search,Clean=".-_")) THEN
371

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

    
374
         END IF
375

    
376
         IF (SearchInput(Siesta_Input,"LATTICEPARAMETERS",Search,Clean=".-_")) THEN
377

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

    
380
         END IF
381

    
382
         IF (SearchInput(Siesta_Input,"SUPERCELL",Search,Clean=".-_")) THEN
383

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

    
386
         END IF
387

    
388
!         Call Die('Readinput_siesta:fin',' Lecture finie')
389

    
390
     if (debug) Call Header("Exiting ReadInput_Siesta")
391

    
392
   END SUBROUTINE READINPUT_SIESTA