Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 :
7 : MODULE m_xsf_io
8 : USE m_types_atoms
9 : !-----------------------------------------------
10 : ! DESC:subroutines to write xsf-files for xcrysden
11 : ! Daniel Wortmann, (06-01-26)
12 : !-----------------------------------------------
13 : ! Bohr radius a0, http://physics.nist.gov/cgi-bin/cuu/Value?eqbohrrada0
14 : REAL, PRIVATE, PARAMETER :: a0 = 0.52917720859 ! in Angstroem
15 :
16 : CONTAINS
17 : !<-- S:S: xsf_WRITE_atoms(fileno,film,amat,neq(:ntype),zatom(:ntype),pos)
18 2 : SUBROUTINE xsf_WRITE_atoms(fileno,atoms,film,amat,forceAllAtoms)
19 : !-----------------------------------------------
20 : ! Writes the crystal dimensions&atomic positions
21 : ! (last modified: 2004-00-00) D. Wortmann
22 : !-----------------------------------------------
23 : IMPLICIT NONE
24 : !<--Arguments
25 : INTEGER,INTENT(IN) :: fileno
26 : TYPE(t_atoms),INTENT(IN):: atoms
27 : LOGICAL,INTENT(IN) :: film
28 : REAL,INTENT(IN) :: amat(3,3)
29 : REAL, OPTIONAL, INTENT(IN) :: forceAllAtoms(3,atoms%nat)
30 : !>
31 : !<-- Locals
32 : INTEGER :: n,nn,na
33 : !>
34 2 : IF (film) THEN
35 1 : WRITE(fileno,*) "SLAB"
36 : ELSE
37 1 : WRITE(fileno,*) "CRYSTAL"
38 : ENDIF
39 :
40 2 : WRITE(fileno,*) "PRIMVEC"
41 : ! Write in atomic units
42 8 : WRITE(fileno,'(3(f0.7,1x))') amat(:,1)*a0
43 8 : WRITE(fileno,'(3(f0.7,1x))') amat(:,2)*a0
44 8 : WRITE(fileno,'(3(f0.7,1x))') amat(:,3)*a0
45 :
46 2 : WRITE(fileno,*) "PRIMCOORD"
47 6 : WRITE(fileno,*) SUM(atoms%neq)," 1"
48 2 : na = 1
49 6 : DO n = 1,SIZE(atoms%neq)
50 11 : DO nn = 1,atoms%neq(n)
51 5 : IF (PRESENT(forceAllAtoms)) THEN
52 0 : WRITE(fileno,'(i4,2x,6(f0.7,1x))') NINT(atoms%zatom(n)),atoms%pos(:,na)*a0,forceAllAtoms(:,na)/a0
53 : ELSE
54 20 : WRITE(fileno,'(i4,2x,3(f0.7,1x))') NINT(atoms%zatom(n)),atoms%pos(:,na)*a0
55 : END IF
56 9 : na=na+1
57 : ENDDO
58 : ENDDO
59 2 : WRITE(fileno,*)
60 2 : END SUBROUTINE xsf_WRITE_atoms
61 : !>
62 : !<-- S: xsf_write_header(fileno,twodim,desc,vec1,vec2,vec3,zero,grid)
63 0 : SUBROUTINE xsf_WRITE_header(fileno,twodim,desc,vec1,vec2,vec3,zero&
64 0 : & ,grid)
65 : !-----------------------------------------------
66 : ! writes the beginning of a gid-datablock
67 : ! (last modified: 2004-00-00) D. Wortmann
68 : !-----------------------------------------------
69 : IMPLICIT NONE
70 : !<--Arguments
71 : INTEGER,INTENT(IN) :: fileno,grid(:)
72 : LOGICAL,INTENT(IN) :: twodim
73 : REAL ,INTENT(IN) :: vec1(:),vec2(:),vec3(:),zero(:)
74 : CHARACTER(LEN =*),INTENT(IN) :: desc
75 : !>
76 :
77 0 : IF (twodim) THEN
78 0 : WRITE(fileno,*) "BEGIN_BLOCK_DATAGRID_2D"
79 0 : WRITE(fileno,*) desc
80 0 : WRITE(fileno,*) "BEGIN_DATAGRID_2D_A"
81 0 : WRITE(fileno,'(3i7)') grid(1:2)
82 0 : WRITE(fileno,'(3(f12.7,1x))') zero*a0
83 0 : WRITE(fileno,'(3(f12.7,1x))') vec1*a0
84 0 : WRITE(fileno,'(3(f12.7,1x))') vec2*a0
85 : ELSE
86 0 : WRITE(fileno,*) "BEGIN_BLOCK_DATAGRID_3D"
87 0 : WRITE(fileno,*) desc
88 0 : WRITE(fileno,*) "BEGIN_DATAGRID_3D_A"
89 0 : WRITE(fileno,'(3i7)') grid(1:3)
90 0 : WRITE(fileno,'(3(f12.7,1x))') zero*a0
91 0 : WRITE(fileno,'(3(f12.7,1x))') vec1*a0
92 0 : WRITE(fileno,'(3(f12.7,1x))') vec2*a0
93 0 : WRITE(fileno,'(3(f12.7,1x))') vec3*a0
94 : ENDIF
95 0 : END SUBROUTINE xsf_WRITE_header
96 : !>
97 : !<-- S: xsf_write_newblock(fileno,twodim,vec1,vec2,vec3,zero,grid)
98 0 : SUBROUTINE xsf_WRITE_newblock(fileno,twodim,vec1,vec2&
99 0 : & ,vec3,zero,grid)
100 : !-----------------------------------------------
101 : ! writes the beginning of a new gid-datablock for second spin
102 : ! (last modified: 2004-00-00) D. Wortmann
103 : !-----------------------------------------------
104 : IMPLICIT NONE
105 : !<--Arguments
106 : INTEGER,INTENT(IN) :: fileno,grid(:)
107 : LOGICAL,INTENT(IN) :: twodim
108 : REAL ,INTENT(IN) :: vec1(:),vec2(:),vec3(:),zero(:)
109 : !>
110 :
111 0 : IF (twodim) THEN
112 0 : WRITE(fileno,*) "END_DATAGRID_2D"
113 0 : WRITE(fileno,*) "BEGIN_DATAGRID_2D_B"
114 0 : WRITE(fileno,'(3i7)') grid(1:2)
115 0 : WRITE(fileno,'(3(f12.7,1x))') zero*a0
116 0 : WRITE(fileno,'(3(f12.7,1x))') vec1*a0
117 0 : WRITE(fileno,'(3(f12.7,1x))') vec2*a0
118 : ELSE
119 0 : WRITE(fileno,*) "END_DATAGRID_3D"
120 0 : WRITE(fileno,*) "BEGIN_DATAGRID_3D_B"
121 0 : WRITE(fileno,'(3i7)') grid(1:3)
122 0 : WRITE(fileno,'(3(f12.7,1x))') zero*a0
123 0 : WRITE(fileno,'(3(f12.7,1x))') vec1*a0
124 0 : WRITE(fileno,'(3(f12.7,1x))') vec2*a0
125 0 : WRITE(fileno,'(3(f12.7,1x))') vec3*a0
126 : ENDIF
127 0 : END SUBROUTINE xsf_WRITE_newblock
128 : !>
129 : !<-- S: xsf_write_endblock(fileno,twodim)
130 0 : SUBROUTINE xsf_write_endblock(fileno,twodim)
131 : !-----------------------------------------------
132 : !
133 : ! (last modified: 2004-00-00) D. Wortmann
134 : !-----------------------------------------------
135 : IMPLICIT NONE
136 : !<--Arguments
137 : INTEGER,INTENT(IN) :: fileno
138 : LOGICAL,INTENT(IN) :: twodim
139 : !>
140 :
141 0 : IF (twodim) THEN
142 0 : WRITE(fileno,*) "END_DATAGRID_2D"
143 0 : WRITE(fileno,*) "END_BLOCK_DATAGRID_2D"
144 : ELSE
145 0 : WRITE(fileno,*) "END_DATAGRID_3D"
146 0 : WRITE(fileno,*) "END_BLOCK_DATAGRID_3D"
147 : ENDIF
148 0 : END SUBROUTINE xsf_write_endblock
149 : !>
150 :
151 0 : SUBROUTINE xsf_WRITE_force(fileno,atoms,film,od,amat,force)
152 : !-----------------------------------------------
153 : ! Writes the crystal dimensions&force positions
154 : ! (last modified: 2004-00-00) D. Wortmann
155 : !-----------------------------------------------
156 : IMPLICIT NONE
157 : !<--Arguments
158 : INTEGER,INTENT(IN) :: fileno
159 : TYPE(t_atoms),INTENT(IN) :: atoms
160 : LOGICAL,INTENT(IN) :: film
161 : LOGICAL,INTENT(IN) :: od
162 : REAL,INTENT(IN) :: amat(3,3)
163 : INTEGER,INTENT(IN) :: force ! number of atoms + force vectors
164 : !>
165 : !<-- Locals
166 : INTEGER :: n,nn,na
167 : !>
168 0 : IF (film) THEN
169 0 : IF (od) THEN
170 0 : WRITE(fileno,*) "POLYMERE"
171 : ELSE
172 0 : WRITE(fileno,*) "SLAB"
173 : ENDIF
174 : ELSE
175 0 : WRITE(fileno,*) "CRYSTAL"
176 : ENDIF
177 :
178 0 : WRITE(fileno,*) "PRIMVEC"
179 0 : WRITE(fileno,'(3(f0.7,1x))') amat(:,1)*a0
180 0 : WRITE(fileno,'(3(f0.7,1x))') amat(:,2)*a0
181 0 : WRITE(fileno,'(3(f0.7,1x))') amat(:,3)*a0
182 :
183 0 : WRITE(fileno,*) "PRIMCOORD"
184 0 : WRITE(fileno,*) force," 1"
185 0 : na = 1
186 0 : DO n = 1,SIZE(atoms%neq)
187 0 : DO nn = 1,atoms%neq(n)
188 0 : WRITE(fileno,'(i4,2x,3(f0.7,1x))') NINT(atoms%zatom(n)),&
189 0 : & atoms%pos(:,na)*a0
190 0 : na=na+1
191 : ENDDO
192 : ENDDO
193 0 : WRITE(fileno,*)
194 0 : END SUBROUTINE xsf_WRITE_force
195 : !>
196 : !-----------------------------------------------
197 : END MODULE m_xsf_io
198 :
199 :
|