Statistiques
| Révision :

root / src / ReadInput_vasp.f90 @ 8

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

1
 SUBROUTINE ReadInput_Vasp
2

    
3
! This routine reads an input template for Vasp
4

    
5
  use VarTypes
6
  use Path_module
7
  use Io_module
8

    
9
  IMPLICIT NONE
10

    
11
  INTERFACE
12
     function valid(string) result (isValid)
13
       CHARACTER(*), intent(in) :: string
14
       logical                  :: isValid
15
     END function VALID
16
  END INTERFACE
17

    
18
  CHARACTER(LCHARS) ::  Line
19
  INTEGER(KINT) ::  Iat
20
  INTEGER(KINT) :: I,J
21

    
22
  INTEGER(KINT), ALLOCATABLE :: NbAtType(:) !na
23
  INTEGER(KINT) :: NbType, NbTypeUser
24

    
25
  REAL(KREAL) :: B(3),xtmp,ytmp,ztmp
26

    
27
  LOGICAL :: TChk
28

    
29
  LOGICAL :: Debug
30

    
31

    
32
  Debug=Valid("readinput").OR.Valid("readinput_vasp")
33

    
34
  if (debug) Call Header("Entering ReadInput_Vasp")
35

    
36
 if (Input/="VASP") THEN
37

    
38
     ! Input was not Vasp, so many parameters are missing like lattice 
39
     ! constants...
40
     ! we read them now !
41
     ALLOCATE(FFF(3,nat))
42
     ! First geometry is a bit special for VASP as we have to set
43
     ! many things
44
     IF (DEBUG) WRITE(*,*) "Reading Vasp Parameters"
45
     READ(IOIN,'(A)') Vasp_Title
46
     READ(IOIN,*) Vasp_param
47

    
48
     READ(IOIN,*) Lat_a
49
     READ(IOIN,*) Lat_b
50
     READ(IOIN,*) Lat_c
51

    
52
     Lat_a=Lat_a*Vasp_param
53
     Lat_b=Lat_b*Vasp_param
54
     Lat_c=Lat_c*Vasp_param
55

    
56
     ALLOCATE(NbAtType(nat))
57
     READ(IOIN,'(A)') Vasp_types
58
     ! First, how many different types ?
59
     NbAtType=0
60
     READ(Vasp_types,*,END=998) NbAtType
61
998  CONTINUE
62
     NbType=0
63
     DO WHILE (NbAtType(NbType+1).NE.0)
64
        NbType=NbType+1
65
     END DO
66

    
67
     ! Do we know the atom types ?
68
     IF (AtTypes(1).EQ.'  ') THEN
69
        ! user has not provided atom types... we have to find them ourselves
70
        ! by looking into the POTCAR file...
71
        INQUIRE(File="POTCAR", EXIST=Tchk)
72
        IF (.NOT.Tchk) THEN
73
           WRITE(*,*) "ERROR! No AtTypes provided, and POTCAR file not found"
74
           STOP
75
        END IF
76
        OPEN(IOTMP,File="POTCAR")
77
        DO I=1,NbType
78
           Line='Empty'
79
           DO WHILE (Line(1:2).NE.'US')
80
              READ(IOTMP,'(A)') Line
81
              Line=AdjustL(Line)
82
           END DO
83
           Line=adjustl(Line(3:))
84
           AtTypes(I)=Line(1:2)
85
        END DO
86
        if (debug) WRITE(*,'(A,100(1X,A2))') "ReadG:VASP AtTypes",AtTypes(1:NbType)
87
        CLOSE(IOTMP)
88

    
89
     ELSE  !AtTypes(1).EQ.'  '
90
        ! user has provided atom types
91
        NbTypeUser=0
92
        DO WHILE (AtTypes(NbTypeUser+1).NE.'  ')
93
           NbTypeUser=NbTypeUser+1
94
        END DO
95
        IF (NbType.NE.NbTypeUser) THEN
96
           WRITE(*,*) "ERROR Read_Geom : NbType in POSCAR do not match AtTypes"
97
           STOP
98
        END IF
99
     END IF
100

    
101
     IAt=1
102
     DO I=1,NbType
103
        DO J=1,NbAtType(I)
104
           AtName(Iat)=AtTypes(I)
105
           Iat=Iat+1
106
        END DO
107
     END DO
108
     DEALLOCATE(NbAtType)
109

    
110
     NbTypes=NbType
111

    
112
     READ(IOIN,'(A)') Vasp_comment
113
     READ(IOIN,'(A)') Vasp_direct
114
     V_direct=Adjustl(Vasp_direct)
115
     Call UpCase(V_direct)
116

    
117
! PFL 2011 Mar 8 ->
118
! We have to read the FFF flags :
119
     DO I=1,Nat
120
        READ(IOIN,*) Xtmp,ytmp,ztmp,FFF(1:3,I)
121
        DO J=1,3
122
           FFF(J,I)=AdjustL(FFF(J,I))
123
           CALL Upcase(FFF(J,I))
124
        END DO
125
     END DO
126
! <- PFL 2011 Mar 8 
127

    
128
  END IF
129

    
130
  ! In the case of VASP there is always the problem  of moving from one side
131
  ! of the box to the other...
132

    
133
     Renum=.TRUE.
134

    
135
     ! V_direct has been set in Read_geom
136
     IF (V_direct(1:6).EQ.'DIRECT') THEN
137
        Latr(1:3,1)=Lat_a
138
        Latr(1:3,2)=Lat_b
139
        Latr(1:3,3)=Lat_c
140
        B=1.
141
        CALL Gaussj(Latr,3,3,B,1,1)
142
     ELSE
143
        Latr=0.
144
        Latr(1,1)=1.d0
145
        Latr(2,2)=1.d0
146
        Latr(3,3)=1.d0
147
     END IF
148

    
149
     ! Actualization of Frozen using the FFFF... 
150
     ! Frozen has the advantage ie if given, it imposes _ALL_ the FFF flags.
151
     IF (Frozen(1).NE.0) THEN
152
        WRITE(IOOUT,*) "Frozen is given. Flags of the given POSCAR are overriden"
153
        FFF='T'
154

    
155
        NFroz=0
156
        DO WHILE (Frozen(NFroz+1).NE.0)
157
           NFroz=NFroz+1
158
           FFF(1:3,Frozen(NFroz))='F'
159
        END DO
160
     ELSE
161
        WRITE(IOOUT,*) "Frozen not given : using  Flags of the given POSCAR"
162
        NFroz=0
163
        Frozen=0
164
        DO I=1,Nat
165
           IF ((FFF(1,I).EQ.'F').OR.(FFF(2,I).EQ.'F').OR.(FFF(3,I).EQ.'F')) THEN
166
              FFF(1:3,I)='F'
167
              NFroz=NFroz+1
168
              Frozen(NFroz)=I
169
           END IF
170
        END DO
171
        WRITE(IOOUT,*) "Frozen atoms:",Frozen(1:NFroz)
172
     END IF
173

    
174
     IF (Vmd) THEN
175
        if (debug) WRITE(*,*) "DBG MAIN, L803, VMD=T,NbTypes,AtTypes",NbTypes,AtTypes(1:NbTypes)
176
        Line=""
177
        DO I=1,NbTypes
178
           Line=TRIM(Line) // " " // TRIM(AdjustL(AtTypes(I))) 
179
        END DO
180
        Vasp_Title=Trim(Line) // " " // Trim(adjustL(Vasp_Title))
181
        if (debug) WRITE(*,*) "DBG MAIN, L809, VMD=T, Vasp_Title=",TRIM(Vasp_Title)
182
     END IF
183
     Call CheckPeriodicBound
184

    
185
 if (debug) Call Header("Exiting ReadInput_Vasp")
186

    
187
   END SUBROUTINE READINPUT_VASP
188