Statistics
| Revision:

root / src / ReadInput_vasp.f90 @ 10

History | View | Annotate | Download (4.8 kB)

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
  FPBC=.TRUE.
37

    
38
 if (Input/="VASP") THEN
39

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

    
50
     READ(IOIN,*) Lat_a
51
     READ(IOIN,*) Lat_b
52
     READ(IOIN,*) Lat_c
53

    
54
     Lat_a=Lat_a*Vasp_param
55
     Lat_b=Lat_b*Vasp_param
56
     Lat_c=Lat_c*Vasp_param
57

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

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

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

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

    
112
     NbTypes=NbType
113

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

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

    
130
  END IF
131

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

    
135
     Renum=.TRUE.
136

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

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

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

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

    
187
 if (debug) Call Header("Exiting ReadInput_Vasp")
188

    
189
   END SUBROUTINE READINPUT_VASP
190