~albertog/siesta/efield-2.5-jjunquera

« back to all changes in this revision

Viewing changes to Util/COOP/subs.f90

  • Committer: Alberto Garcia
  • Date: 2007-11-22 21:31:50 UTC
  • mfrom: (unknown (missing))
  • Revision ID: Arch-1:siesta@uam.es--2006%siesta-devel--reference--2.5--patch-1
Merged COOP/COHP functionality
Merged the COOP/COHP/PDOS code from the 2.1 branch complex.

��-- Functionality changes:

* The wavefunction file is now in WFSX format (well-packed, single-precision, and thus
significantly smaller). The Util/wfsx2wfs program can be used to re-generate the old format.

* The xijo array (for relative positions between interacting orbitals) is always produced.

-- New features:

Option COOP.Write triggers the creation of a wavefunction file (for the SCF-k-point set)
and an HSX file (enhanced HS format) that can later be processed by Util/COOP/mprop
for the off-line generation of COOP/COHP/(P)DOS.

(replayed patch-1 of outlier branch ref-2.4)


Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
module subs
 
2
 
 
3
use precision
 
4
 
 
5
public :: ival, manual, orbital, txt2wrd, die
 
6
 
 
7
private
 
8
 
 
9
CONTAINS     
 
10
 
 
11
 
 
12
      function ival(txt)
 
13
        character(len=*), intent(in) :: txt
 
14
        integer                      :: ival
 
15
 
 
16
        integer  :: tmp, iostat
 
17
 
 
18
        ival = -1
 
19
!!        read(txt,fmt=*,iostat=iostat) tmp
 
20
        read(txt,fmt="(i10)",iostat=iostat) tmp
 
21
        ! Sometimes the above read succeeds
 
22
        ! for non-numeric strings...
 
23
!!!!        if (tmp== 0 .or. iostat /= 0) then
 
24
        if (iostat /= 0) then
 
25
           ! Not an integer, return -1 flag
 
26
           return
 
27
        endif
 
28
 
 
29
        ival = tmp
 
30
 
 
31
      end function ival
 
32
 
 
33
      subroutine txt2wrd (txt, wrd, nw, pepe)
 
34
      implicit none
 
35
 
 
36
      character(len=*), intent(in)   :: txt
 
37
      character(len=20), intent(out) :: wrd(:)
 
38
      integer, intent(out) :: nw
 
39
      integer, intent(in) :: pepe
 
40
 
 
41
      character(len=len(txt)+1) taux
 
42
      integer  ::  i1, i2, nmaxwords
 
43
 
 
44
      nmaxwords = size(wrd)
 
45
 
 
46
      taux=txt // " "
 
47
      nw=0
 
48
      do while (len_trim(taux).ne.0)
 
49
        nw=nw+1
 
50
        if (nw.gt.nmaxwords) STOP "overflow in txt2wrd"
 
51
        i1=verify(taux,' ')
 
52
        i2=index(taux(i1+1:),' ')+i1
 
53
        wrd(nw)=taux(i1:i2-1)
 
54
        taux(i1:i2-1)=repeat(' ',i2-i1)
 
55
      enddo
 
56
      end subroutine txt2wrd
 
57
 
 
58
      subroutine orbital (txt, ia, c, n, l, k)
 
59
        implicit none
 
60
      character(len=*), intent(in) :: txt
 
61
      character(len=*), intent(out) :: c
 
62
      integer, intent(out) ::  ia, n, l, k
 
63
 
 
64
      character(len=len(txt)) ::  atx, ntx
 
65
      integer :: i_, i0, lng, il
 
66
 
 
67
      atx=txt
 
68
      ntx=txt
 
69
      lng=len_trim(txt)
 
70
!
 
71
!     Error flag set
 
72
!
 
73
      ia=-1
 
74
!
 
75
!     Defaults meaning "not specified"
 
76
!
 
77
      c='  '
 
78
      n=-1
 
79
      l=-1
 
80
      k=-1
 
81
 
 
82
      i_=index(txt,'_')
 
83
      if (i_.eq.1) return  ! Error
 
84
 
 
85
      i0=i_-1
 
86
      if (i_.eq.0) i0=lng
 
87
      ntx=txt(1:i0)//repeat(' ',20-i0)
 
88
      ia=ival(ntx)
 
89
      if (ia.eq.-1) then   ! Label specified
 
90
        if (i0.gt.2) return  ! No more stuff
 
91
        ia=0
 
92
        c=txt(1:i0)
 
93
      endif
 
94
 
 
95
      if (i_.eq.0) return
 
96
 
 
97
      ! Now search for shell info
 
98
 
 
99
      ! Angular momentum
 
100
      atx=txt(i_+1:20)//repeat(' ',i_)
 
101
      lng=len_trim(atx)
 
102
      il=scan(atx,'spdfgh')
 
103
      if ((il.ne.0).and.(il.ne.1).and.(scan(atx,'spdfgh',back=.true.).eq.il)) then
 
104
        l=index('spdfgh',atx(il:il))-1
 
105
      else
 
106
        ia=-1   ! error flag
 
107
        return
 
108
      endif
 
109
 
 
110
      ! n quantum number
 
111
      ntx=atx(1:il-1)//repeat(' ',20-il+1)
 
112
      n=ival(ntx)
 
113
      if (n.eq.-1) then  !! error
 
114
        ia=-1
 
115
        return
 
116
      endif
 
117
 
 
118
      ! m quantum number (actually index)
 
119
      if (il.eq.lng) then
 
120
        k=-1
 
121
      else
 
122
        k=0
 
123
        ntx=atx(il+1:20)//repeat(' ',il)
 
124
        if (l.eq.1) then
 
125
          if (trim(ntx).eq.'y') k=1
 
126
          if (trim(ntx).eq.'z') k=2
 
127
          if (trim(ntx).eq.'x') k=3
 
128
        endif
 
129
        if (l.eq.2) then
 
130
          if (trim(ntx).eq.'xy') k=1
 
131
          if (trim(ntx).eq.'yz') k=2
 
132
          if (trim(ntx).eq.'z2') k=3
 
133
          if (trim(ntx).eq.'xz') k=4
 
134
          if (trim(ntx).eq.'x2-y2') k=5
 
135
        endif
 
136
        if (k.eq.0) then
 
137
          k=ival(ntx)
 
138
          if ((k.eq.-1).or.(k.le.0).or.(k.gt.2*l+1)) then
 
139
             ! Signal error
 
140
            ia=-1
 
141
            return
 
142
          endif
 
143
        endif
 
144
      endif
 
145
 
 
146
      endsubroutine orbital
 
147
 
 
148
      subroutine manual
 
149
 
 
150
      write(6,"('* MPROP PROGRAM')")
 
151
      write(6,"('  Miquel Llunell, Universitat de Barcelona, 2005')")
 
152
      write(6,"('  Alberto Garcia, ICMAB-CSIC, 2007')")
 
153
      write(6,*)
 
154
      write(6,"('    MPROP calculates both DOS projections and COOP curves')")
 
155
      write(6,"('    using output files obtained with SIESTA. The atomic orbital (AO)')")
 
156
      write(6,"('    sets are defined in an input file (MLabel.mpr).')")
 
157
      write(6,"('  ')")
 
158
      write(6,*) "Usage: mprop [ options ] MPROP_FILE_BASENAME"
 
159
      write(6,*) "Options:"
 
160
      write(6,*) "           -h:  print manual                    "
 
161
      write(6,*) "           -d:  debug                    "
 
162
      write(6,*) "           -l:  print summary of energy information         "
 
163
      write(6,*) "   -s SMEAR  :  set value of smearing parameter (default 0.5 eV)"
 
164
      write(6,*) "   -m Min_e  :  set lower bound of energy range                    "
 
165
      write(6,*) "   -M Max_e  :  set upper bound of energy range                    "
 
166
      write(6,*)
 
167
      write(6,"('* .mpr FILE STRUCTURE')")
 
168
      write(6,"('         SLabel                   # Name of the siesta output files')")
 
169
      write(6,"('         DOS/COOP                # Define the curve type to be calculated')")
 
170
      write(6,"('    /-[ If DOS selected; as many blocks as projections wanted ]')")
 
171
      write(6,"('    |    projection_name         # DOS projection name')")
 
172
      write(6,"('    \-   Subset of AO (*)        # Subset of orbitals included')")
 
173
      write(6,"('    /-[ If COOP selected; as many blocks as projections wanted ]')")
 
174
      write(6,"('    |    curve_name              # COOP curve name')")
 
175
      write(6,"('    |    Subset I of AO (*)      # Reference atoms or orbitals')")
 
176
      write(6,"('    |    d1 d2                   # Distance range')")
 
177
      write(6,"('    \-   Subset II of AO (*)     # Neighbour atoms or orbitals')")
 
178
      write(6,"('     (*) See below how to define subsets of AO')")
 
179
      write(6,"('* INPUT FILES')")
 
180
      write(6,"('    [output files from SIESTA >=  2.4.1]')")
 
181
      write(6,"('    SLabel.WFSX and SLabel.HSX (new format)')")
 
182
      write(6,*)
 
183
      write(6,"('* OUTPUT FORMAT')")
 
184
      write(6,*) 
 
185
      write(6,*) " SLabel.alldos  :  full-range approximate DOS curve"
 
186
      write(6,*) " SLabel.ados    :  specified-range approximate DOS curve"
 
187
      write(6,*) " SLabel.intdos  :  full-range integrated-DOS curve"
 
188
      write(6,*) " MLabel.CurveName.pdos    :  PDOS curves"
 
189
      write(6,*) " MLabel.CurveName.coop    :  COOP curves"
 
190
      write(6,*) " MLabel.CurveName.cohp    :  COHP curves"
 
191
      write(6,"('    [A control .stt file will always be generated]')")
 
192
      write(6,*)
 
193
      write(6,"('* PROJECTION AND CURVES NAMES')")
 
194
      write(6,"('    Alphanumerical string up to 30 char. with no spaces')")
 
195
      write(6,"('* SUBSET OF AO USING ORDER NUMBERS')")
 
196
      write(6,"('    List of integer numbers preceeded by a + symbol')")
 
197
      write(6,"('    Each number refers to one AO in the final list of AO of SIESTA')")
 
198
      write(6,"('    Example: + 23 65 78')")
 
199
      write(6,"('* SUBSET OF AO USING ATOM_SHELL NOTATION')")
 
200
      write(6,"('    List of atoms and shell groups of AO')")
 
201
      write(6,"('    General notation: ATOM_SHELL')")
 
202
      write(6,"('     > ATOM:  Atomic symbol refers to all the atoms of that type')")
 
203
      write(6,"('              Integer number refers to the N-th atom in unit cell')")
 
204
      write(6,"('     > SHELL: Integer1+Letter+Integer2')")
 
205
      write(6,"('               > Integer1 refers to the n quantum number')")
 
206
      write(6,"('               > Letter   refers to the l quantum number (s,p,d,f,g,h)')")
 
207
      write(6,"('               > Integer2 refers to a single AO into the n-l shell')")
 
208
      write(6,"('                   Alternatively alphanimerical strings can be used')")
 
209
      write(6,"('                     p-shells   1  y    d-shells   1  xy   4  xz')")
 
210
      write(6,"('                                2  z               2  yz   5  x2-y2')")
 
211
      write(6,"('                                3  x               3  z2')")
 
212
      write(6,"('    Particular cases:')")
 
213
      write(6,"('     > Just ATOM is indicated: all the AO of the atom will be included')")
 
214
      write(6,"('     > No value for Integer2:  all the AO of the shell will be included')")
 
215
      write(6,"('    Example: Ca_3p Al 4_4d3 5 O_2py')")
 
216
      stop
 
217
 
 
218
      end subroutine manual
 
219
 
 
220
 
 
221
end module subs
 
222