← Back to branch summary

~nickpapior/siesta/trunk-kpoint-dos

« back to all changes in this revision

Viewing changes to Util/Vibra/Vibra/recoor.f

  • Committer: Alberto Garcia
  • Date: 2004-11-25 18:49:43 UTC
  • Revision ID: Arch-1:siesta@uam.es--2004%siesta-devel--reference--0.11--patch-1
Siesta 0.11 -- imported from CVS
Import from cvs using date instead of siesta-0-11-release tag, since
the Pseudo structure was not properly integrated at that time and
did not get the tag.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Util/Vibra/Vibra/recoor.f
 
1
      subroutine recoor(overflow, cell, alat, xa, isa, xmass, na) 
 
2
 
 
3
c *******************************************************************
 
4
c Reads atomic coordinates and format in which they are given, to be
 
5
c transformed into Bohr cartesian for internal handling. 
 
6
c It also shifts them all according to AtomicCoordinatesOrigin.
 
7
c
 
8
c Written by E. Artacho, December 1997, on the original piece of the
 
9
c redata subroutine written by P. Ordejon in December 1996.
 
10
c ********* INPUT ***************************************************
 
11
c logical overflow          : true if some dimension is too small
 
12
c integer na                : number of atoms
 
13
c double precision cell(3,3): Lattice (supercell) vectors
 
14
c double precision alat     : Lattice constant (in Bohr) 
 
15
c ********* OUTPUT **************************************************
 
16
c double precision xa(3,na) : atomic coordinates in Bohr cartesian
 
17
c integer isa(na)           : atomic species of different atoms
 
18
c integer xmass(na)         : atomic masses of different atoms
 
19
c *******************************************************************
 
20
 
 
21
      implicit          none
 
22
      logical           overflow
 
23
      integer           na
 
24
      integer           isa(na)
 
25
      double precision  xa(3,na), cell(3,3), alat, xmass(na)
 
26
 
 
27
c Internal variables and arrays
 
28
 
 
29
      character         acf*22, acf_defect*22
 
30
      logical           leqi
 
31
      integer           iscale, ia, i, ix, iunit
 
32
      double precision  origin(3), xac(3)
 
33
 
 
34
 
 
35
 
 
36
c enable FDF input/output
 
37
 
 
38
      include 'fdf/fdfdefs.h'
 
39
 
 
40
      data origin /3*0.d0/
 
41
 
 
42
C format of atomic coordinates
 
43
 
 
44
      acf_defect = 'NotScaledCartesianBohr'
 
45
      acf = fdf_string('AtomicCoordinatesFormat',acf_defect)
 
46
      if (leqi(acf,'NotScaledCartesianBohr')) then
 
47
        iscale = 0
 
48
        write(6,'(a,a)')
 
49
     .   'recoor: Atomic-coordinates input format  = ',
 
50
     .   'Cartesian coordinates'
 
51
        write(6,'(a,a)')
 
52
     .   'recoor:                                    ',
 
53
     .   '(in Bohr units)'
 
54
      else if (leqi(acf,'NotScaledCartesianAng')) then
 
55
        iscale = 1
 
56
        write(6,'(a,a)')
 
57
     .   'recoor: Atomic-coordinates input format  = ',
 
58
     .   'Cartesian coordinates'
 
59
        write(6,'(a,a)')
 
60
     .   'recoor:                                    ',
 
61
     .   '(in Angstroms)'
 
62
      else if (leqi(acf,'ScaledCartesian')) then
 
63
        if (alat.eq.0.d0) then
 
64
           write(6,"(/,2a)") 'recoor: ERROR: Explicit lattice ',
 
65
     .       'constant is needed for ScaledCartesian format'
 
66
           stop 'recoor: ERROR: Explicit lattice constant needed'
 
67
        endif
 
68
        iscale = 2
 
69
        write(6,'(a,a)')
 
70
     .   'recoor: Atomic-coordinates input format  = ',
 
71
     .   'Cartesian coordinates'
 
72
        write(6,'(a,a)')
 
73
     .   'recoor:                                    ',
 
74
     .   '(in units of alat)'
 
75
      else if (leqi(acf,'ScaledByLatticeVectors') .or. 
 
76
     .         leqi(acf,'Fractional') ) then
 
77
        if (alat.eq.0.d0) then
 
78
           write(6,"(/,2a)") 'recoor: ERROR: Explicit lattice ',
 
79
     .       'constant is needed for Fractional format'
 
80
           stop 'recoor: ERROR: Explicit lattice constant needed'
 
81
        endif
 
82
        iscale = 3
 
83
        write(6,'(a,a)')
 
84
     .   'recoor: Atomic-coordinates input format  = ',
 
85
     .   'Ref. to lattice vectors'
 
86
      else
 
87
        write(6,"(/,'recoor: ',72(1h*))")
 
88
        write(6,"('recoor:                  INPUT ERROR')")
 
89
        write(6,'(a)') 'recoor: '
 
90
        write(6,'(2a)') 'recoor: You must use one of the following',
 
91
     .                            ' coordinate scaling options:'
 
92
        write(6,'(a)') 'recoor:     - NotScaledCartesianBohr         '
 
93
        write(6,'(a)') 'recoor:     - NotScaledCartesianAng          '
 
94
        write(6,'(a)') 'recoor:     - ScaledCartesian                '
 
95
        write(6,'(2a)') 'recoor:     - ScaledByLatticeVectors ',
 
96
     .                                               '(or Fractional)'
 
97
        write(6,"('recoor: ',72(1h*))")
 
98
        stop 'recoor: ERROR: Wrong atomic-coordinate input format'
 
99
      endif
 
100
 
 
101
 
 
102
c read atomic coordinates and species
 
103
 
 
104
      if (.not. overflow) then
 
105
 
 
106
        if ( fdf_block('AtomicCoordinatesAndAtomicSpecies',iunit) )
 
107
     .    then
 
108
          do ia = 1,na
 
109
            read(iunit,*) (xa(i,ia), i=1,3), isa(ia), xmass(ia)
 
110
          enddo
 
111
        else
 
112
          write(6,"(/,'recoor: ',72(1h*))")
 
113
          write(6,"('recoor:                  INPUT ERROR')")
 
114
          write(6,'(a)')
 
115
     .    'recoor:   You must specify the atomic coordinates'
 
116
          write(6,"('recoor: ',72(1h*))")
 
117
          stop 'recoor: ERROR: Atomic coordinates missing'
 
118
        endif
 
119
 
 
120
        if ( fdf_block('AtomicCoordinatesOrigin',iunit) ) then
 
121
          read(iunit,*) (origin(i),i=1,3)
 
122
          do ia = 1,na
 
123
            do i = 1,3
 
124
              xa(i,ia) = xa(i,ia) + origin(i)
 
125
            enddo
 
126
          enddo
 
127
        endif
 
128
 
 
129
 
 
130
c Scale atomic coordinates
 
131
c   Coord. option = 0 => Do nothing
 
132
c   Coord. option = 1 => Multiply by 1./0.529177 (Ang --> Bohr)
 
133
c   Coord. option = 2 => Multiply by lattice constant
 
134
c   Coord. option = 3 => Multiply by lattice vectors
 
135
 
 
136
        if (iscale .eq. 1) then
 
137
          do ia = 1,na
 
138
            do ix = 1,3
 
139
              xa(ix,ia) = 1.d0 / 0.529177d0 * xa(ix,ia)
 
140
            enddo
 
141
          enddo
 
142
        elseif (iscale .eq. 2) then
 
143
          do ia = 1,na
 
144
            do ix = 1,3
 
145
              xa(ix,ia) = alat * xa(ix,ia)
 
146
            enddo
 
147
          enddo
 
148
        elseif (iscale .eq. 3) then
 
149
          do ia = 1,na
 
150
            do ix = 1,3
 
151
              xac(ix) = xa(ix,ia)
 
152
            enddo
 
153
            do ix = 1,3
 
154
              xa(ix,ia) = cell(ix,1) * xac(1) +
 
155
     .                    cell(ix,2) * xac(2) +
 
156
     .                    cell(ix,3) * xac(3)
 
157
            enddo
 
158
          enddo
 
159
        endif
 
160
 
 
161
        write(6,'(a)') 'recoor: Atomic coordinates (Bohr) and species'
 
162
        do ia = 1,na
 
163
          write(6,"('recoor: ',i4,2x,3f10.5,i3)")
 
164
     .                    ia,(xa(ix,ia),ix=1,3),isa(ia)
 
165
        enddo
 
166
 
 
167
      endif
 
168
 
 
169
      return
 
170
      end