Révision 7 src/WriteInput_siesta.f90

WriteInput_siesta.f90 (revision 7)
1
 SUBROUTINE ReadInput_siesta
1
 SUBROUTINE WriteInput_siesta(GeomCart,FileUnit)
2 2

  
3
! This routine reads an input template for Siesta
3
! This routine writes an input for Siesta
4 4

  
5 5
  use VarTypes
6 6
  use Path_module
......
14 14
       logical                  :: isValid
15 15
     END function VALID
16 16

  
17
    FUNCTION SearchInput(Input,String,Line,Clean)  Result (Found)
18 17

  
19
      Use Vartypes
20
      use io_module
21
! Input
22
      TYPE (Input_line), POINTER, INTENT(IN) :: Input
23
      CHARACTER(*), INTENT(IN) :: String
24
      CHARACTER(*), OPTIONAL, INTENT(IN) :: Clean
18
     SUBROUTINE WriteList(Input,Unit)
19
        ! This routine reads an input template for Siesta
25 20

  
26
! Output
27
      TYPE (Input_line), POINTER, INTENT(OUT) :: Line
21
       use VarTypes
22
       use Io_module
28 23

  
29
      LOGICAL :: Found
24
       IMPLICIT NONE
30 25

  
31
    END FUNCTION SearchInput
26
     ! Input
27
       TYPE (Input_line), POINTER, INTENT(IN) :: Input
28
       INTEGER(KINT), OPTIONAL, INTENT(IN) :: Unit
29
       
30
     END SUBROUTINE WriteList
32 31

  
33
    SUBROUTINE die(routine, msg, file, line, unit)
34

  
35
      Use VarTypes
36
      Use io_module
37

  
38
      implicit none
39
!--------------------------------------------------------------- Input Variables
40
      character(len=*), intent(in)           :: routine, msg
41
      character(len=*), intent(in), optional :: file
42
      integer(KINT), intent(in), optional      :: line, unit
43

  
44
    END SUBROUTINE die
45

  
46
    SUBROUTINE Warning(routine, msg, file, line, unit)
47

  
48
      Use VarTypes
49
      Use io_module
50

  
51
      implicit none
52
!--------------------------------------------------------------- Input Variables
53
      character(len=*), intent(in)           :: routine, msg
54
      character(len=*), intent(in), optional :: file
55
      integer(KINT), intent(in), optional      :: line, unit
56

  
57
    END SUBROUTINE Warning
58

  
59 32
  END INTERFACE
60 33

  
61

  
62
  CHARACTER(132) ::  Line,LineUp,Line2
63
  INTEGER(KINT) :: LineL, Idx
64
  INTEGER(KINT) :: ISpec, IAt,I
65
  INTEGER(KINT) :: IoRead, ITmp, JTmp
66
  REAL(KREAL) :: Xtmp, Ytmp, Ztmp
34
!Input
35
 ! Geometry in cartesian coordinates
36
  REAL(KREAL), INTENT (IN) :: geomcart(Nat,3)
37
! Unit to write to
38
  INTEGER(KINT), INTENT(IN) :: FileUnit
67 39
  
68 40
  LOGICAL :: Debug
69
  LOGICAL :: FSpecies, FCoord
41
  INTEGER(KINT) :: I,Iat
70 42

  
71
  TYPE(Input_Line), POINTER :: Search,Bla
43
  Debug=Valid("WriteInput").OR.Valid("WriteInput_siesta")
72 44

  
73
  Debug=Valid("readinput").OR.Valid("readinput_siesta")
45
  if (debug) Call Header("Entering WriteInput_Siesta")
74 46

  
75
 if (debug) Call Header("Entering ReadInput_Siesta")
76 47

  
77
  ! We read the Siesta input file
48
  Call WriteList(Siesta_input,Unit=FileUnit)
78 49

  
79
     ALLOCATE(Siesta_Input)
80
     NULLIFY(Siesta_Input%next)
81
     NULLIFY(Siesta_Input%prev)
82
     Current => Siesta_Input
50
  WRITE(FileUnit,*) 
83 51

  
84
     FSpecies=.FALSE.
85
     FCoord=.FALSE.
52
  WRITE(FileUnit,'(1X,A)')  '%block AtomicCoordinatesAndAtomicSpecies' 
86 53

  
87
     READ(IOIN,'(A)',iostat=IoRead) Line
54
  DO I=1,Nat
55
     If (renum) THEN
56
        Iat=Order(I)
57
        WRITE(FileUnit,'(1X,3(1X,F15.8),1X,I5,1X,A)') GeomCart(Iat,:)/Siesta_Unit_Read, IdxSpecies(Iat),TRIM(Siesta_Paste(I))
58
     ELSE
59
        Iat=OrderInv(I)
60
        WRITE(FileUnit,'(1X,3(1X,F15.8),1X,I5,1X,A)') GeomCart(I,:)/Siesta_Unit_Read, IdxSpecies(Iat), TRIM(Siesta_Paste(Iat))
61
     END IF
62
  END DO
88 63

  
89
     DO WHILE (IoRead==0)
90
        Line=AdjustL(Line)
91
        if (debug) WRITE(*,*) 'Line:', Line
92
        current%Line=TRIM(Line)
93
        ALLOCATE(current%next)
94
        Current%next%prev => Current
95
        Current => Current%next
96
        Nullify(Current%next)
64
  WRITE(FileUnit,'(1X,A)')  '%endblock AtomicCoordinatesAndAtomicSpecies'
65
  WRITE(FileUnit,*) 
97 66

  
98
        READ(IOIN,'(A)',iostat=IoRead) Line
99
     END DO
100 67

  
101
! We analyse the input
102 68

  
103
! We look for the NumberofAtoms
104
        If (SearchInput(Siesta_Input,"NUMBEROFATOMS",Search,Clean=".-_")) THEN
105
           Line=AdjustL(Search%line)
106
           Idx=Index(Line," ")
107
           Line2=Trim(AdjustL(Line(Idx+1:)))
108
           Read(Line2,*) IAt
109
           if (Iat/=Nat) THEN
110
              Call Die('ReadInput_siesta','Nat in FDF sample different from  Nat Path input', Unit=IOOUT)
111
           END IF
112
        ELSE
113
! There is no atom number defined !!!
114
           Call Warning('ReadInput_siesta','No NumberOfAtoms in FDF sample', Unit=IOOUT)
115
           WRITE(current%Line,'(1X,"NumberOfAtoms ",I5)') Nat
116
           ALLOCATE(current%next)
117
           Current%next%prev => Current
118
           Current => Current%next
119
           Nullify(Current%next)
120
         
121
        END IF
122

  
123
! We look for the NumberofSpecies
124
        IF (SearchInput(Siesta_Input,"NUMBEROFSPECIES",Search,Clean=".-_")) THEN
125
           Line=AdjustL(Search%line)
126
           Idx=Index(Line," ")
127
           Line2=Trim(AdjustL(Line(Idx+1:)))
128
           Read(Line2,*) Siesta_NbSpecies
129
        END IF
130

  
131
! We look for SystemLabel
132
        If (SearchInput(Siesta_Input,"SYSTEMLABEL",Search,Clean=".-_")) THEN
133
           Line=AdjustL(Search%line)
134
           Idx=Index(Line," ")
135
           Siesta_Label=Trim(adjustl(Line(Idx+1:)))
136
        ELSE
137
           Siesta_label='siesta'
138
        END IF
139

  
140
! We look for the ChemicalSpeciesLabel block
141
        IF (SearchInput(Siesta_Input,"CHEMICALSPECIESLABEL",Search,Clean=".-_")) THEN
142
           ALLOCATE(ListSpecies(Siesta_NbSpecies))
143
           ALLOCATE(Siesta_SpeciesName(Siesta_NbSpecies))
144
           ALLOCATE(IdxSpecies(NAt))
145
           DO I=1,Siesta_NbSpecies
146
              Search => Search%next
147
              Line=AdjustL(Search%Line)
148
              Read(Line,*) ITmp
149
              Idx=Index(Line,' ')
150
              Line=AdjustL(Line(Idx+1:))
151
              Read(Line,*) Ztmp
152
              ListSpecies(ITmp)=ZTmp
153
              Idx=Index(Line,' ')
154
              Line=AdjustL(Line(Idx+1:))
155
              Idx=Index(Line,' ')
156
              Siesta_SpeciesName(ITmp)=Line(1:Idx-1)
157
           END DO
158
           if (Debug) THEN
159
              WRITE(*,*) 'Found ',Siesta_NbSpecies,' species'
160
              DO I=1,Siesta_NbSpecies
161
                 WRITE(*,*) I, ListSpecies(I),TRIM(Siesta_speciesName(I))
162
              END DO
163
        END IF
164

  
165

  
166
! We look for the AtomicCoordinatesAndAtomicSpecies  block
167
        IF (SearchInput(Siesta_Input,"ATOMICCOORDINATESANDATOMICSPECIES",Search,Clean=".-_")) THEN
168
           ALLOCATE(Siesta_Paste(Nat))
169
           Current=>Search
170
           DO I=1,NAt
171
              Search => Search%next
172
              Read(Search%line,*) XTmp,YTmp,ZTmp,IdxSpecies(I)
173
! We save everything but the x,y,z, and species description              
174
              Line=AdjustL(search%line)
175
! We skip x
176
              Idx=Index(Line,' ')
177
              Line=AdjustL(Line(Idx+1:))
178
! we skip y
179
              Idx=Index(Line,' ')
180
              Line=AdjustL(Line(Idx+1:))
181
! we skip z
182
              Idx=Index(Line,' ')
183
              Line=AdjustL(Line(Idx+1:))
184
! we skip species
185
              Idx=Index(Line,' ')
186
              Line=AdjustL(Line(Idx+1:))
187
              Siesta_Paste(I)=TRIM(Line)
188
           END DO
189
! We will now delete this block from our input sample as it will then be
190
! written directly by Opt'n Path
191
! Search%next point on %endblock
192
           search => search%next
193
           IF (ASSOCIATED(Search%next)) THEN
194
! we are not at the end of the input file
195
              if (ASSOCIATED(Current%Prev)) THEN
196
                 Search%next%prev => current%prev
197
              ELSE
198
! the coordinate block is at the begining of the input
199
                 siesta_input => Search%next
200
                 Nullify(Siesta_Input%Prev)
201
              END IF
202
           ELSE
203
! the coordinate block is the last part of the input
204
              nullify(current%prev%next)
205
           END IF
206
              DO I=1,Nat+2
207
                 bla=>current
208
                 current=> current%next
209
                 deallocate(bla)
210
              END DO
211
        ELSE
212
           IF (SearchInput(Siesta_Input,"ZMATRIX",Search,Clean=".-_")) THEN
213
              call Die('ReadInput_Siesta','For now, I need the full block'//&
214
                   'AtomicCoordinatesAndAtomicSpecies, ZMatrix not yet handled.')
215
           ELSE
216
              call Die('ReadInput_Siesta','For now, I need the full block' //&
217
              'AtomicCoordinatesAndAtomicSpecies.')
218
           END IF
219
        END IF
220

  
221
        IF (SearchInput(Siesta_Input,"ATOMICCOORDINATESFORMAT",Search,Clean=".-_")) THEN
222
           Line=Adjustl(Search%Line)
223
           Idx=Index(Line,' ')
224
           Line=AdjustL(Line(Idx+1:))
225
           Call UpCase(Line)
226
           SELECT CASE (Line) 
227
              CASE ('ANG','NOTSCALEDCARTESIANANG')
228
                 Siesta_Unit_Read=1.d0
229
              CASE ('FRACTIONAL','SCALEDBYLATTICEVECTORS')
230
              CASE ('BOHR','NOTSCALEDCARTESIANBOHR')
231
                 Siesta_Unit_Read=a0
232
            END SELECT
233
         END IF
234

  
235
        IF (SearchInput(Siesta_Input,"ATOMICCOORFORMATOUT",Search,Clean=".-_")) THEN
236
           Line=Adjustl(Search%Line)
237
           Idx=Index(Line,' ')
238
           Line=AdjustL(Line(Idx+1:))
239
           Call UpCase(Line)
240
           SELECT CASE (Line) 
241
              CASE ('ANG','NOTSCALEDCARTESIANANG')
242
                 Siesta_Unit_Write=1.d0
243
              CASE ('FRACTIONAL','SCALEDBYLATTICEVECTORS')
244
              CASE ('BOHR','NOTSCALEDCARTESIANBOHR')
245
                 Siesta_Unit_Write=Unit
246
            END SELECT
247
         END IF
248

  
249
         IF (SearchInput(Siesta_Input,"LATTICECONSTANT",Search,Clean=".-_")) THEN
250
           Line=Adjustl(Search%Line)
251
! We discar the label
252
           Idx=Index(Line,' ')
253
           Line=AdjustL(Line(Idx+1:))
254
! we read the value
255
           Read(Line,*) Siesta_LatticeConstant
256
! We discard the value
257
           Idx=Index(Line,' ')
258
           Line=AdjustL(Line(Idx+1:))
259
! We read the unit
260
           Call UpCase(Line)
261
           SELECT CASE (Line) 
262
              CASE ('ANG')
263
                 Siesta_Lat_Unit=1.d0
264
              CASE ('BOHR')
265
                 Siesta_Lat_Unit=Unit
266
            END SELECT
267
! for now!
268
            Call Die('ReadInput_siesta:LatticeConstant',"For now, periodic calculations are NOT possible in Opt'n Path")
269

  
270
         END IF
271

  
272
         IF (SearchInput(Siesta_Input,"LATTICEVECTORS",Search,Clean=".-_")) THEN
273

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

  
276
         END IF
277

  
278
         IF (SearchInput(Siesta_Input,"LATTICEPARAMETERS",Search,Clean=".-_")) THEN
279

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

  
282
         END IF
283

  
284
         IF (SearchInput(Siesta_Input,"SUPERCELL",Search,Clean=".-_")) THEN
285

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

  
288
         END IF
289

  
290
         Call Die('Readinput_siesta:fin',' Lecture finie')
291

  
292
     if (debug) Call Header("Exiting ReadInput_Siesta")
293

  
294
   END SUBROUTINE READINPUT_SIESTA
69
  if (debug) Call Header("Exiting WriteInput_Siesta")
70
  
71
END SUBROUTINE WRITEINPUT_SIESTA

Formats disponibles : Unified diff