← Back to branch summary

~albertog/siesta/efield-2.5-jjunquera

« back to all changes in this revision

Viewing changes to Util/COOP/io.f

  • 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:
Util/COOP/io.f
 
1
! 
 
2
! This file is part of the SIESTA package.
 
3
!
 
4
! Copyright (c) Fundacion General Universidad Autonoma de Madrid:
 
5
! E.Artacho, J.Gale, A.Garcia, J.Junquera, P.Ordejon, D.Sanchez-Portal
 
6
! and J.M.Soler, 1996-2006.
 
7
! 
 
8
! Use of this software constitutes agreement with the full conditions
 
9
! given in the SIESTA license, as signed by all legitimate users.
 
10
!
 
11
c
 
12
c Copyright Alberto Garcia, 1996, 1997, 1998
 
13
c
 
14
c This module implements an interface to the FORTRAN logical unit
 
15
c system. Based on code by Richard Maine.
 
16
c
 
17
c
 
18
c Alberto Garcia, December 30, 1996
 
19
c Rewritten as a single subroutine 
 
20
c with multiple entry points, March 7, 1998
 
21
c Now hybrid to comply with Siesta "die" interface.
 
22
c---------------------------------------------------------------
 
23
c
 
24
      subroutine io
 
25
      use sys, only: die
 
26
c
 
27
c     Logical unit management. Units 0 to min_lun-1 are "reserved",
 
28
c     since most of the "typical" files (output, etc) use them.
 
29
c
 
30
c     Logical units min_lun to min_max are managed by this module.
 
31
      
 
32
      implicit none
 
33
c
 
34
c----------------------------------------------------------------
 
35
c     Module variables
 
36
c
 
37
      integer stdout, stderr
 
38
      integer min_lun, max_lun, nunits
 
39
      parameter (min_lun=10, max_lun=99, nunits=max_lun-min_lun+1)
 
40
      logical lun_is_free(min_lun:max_lun)
 
41
 
 
42
      save stdout, stderr, lun_is_free
 
43
c-----------------------------------------------------------------
 
44
c
 
45
c     Internal and dummy variables
 
46
c
 
47
      integer i, unit, lun, iostat
 
48
      logical used, named, opened
 
49
      character filename*50, form*11
 
50
c
 
51
c-----------------------------------------------------------------
 
52
c     Initialization section
 
53
c
 
54
      data lun_is_free /nunits*.true./
 
55
      data stdout, stderr /6,0/
 
56
c-----------------------------------------------------------------
 
57
c
 
58
c     Executable routines
 
59
c
 
60
c     Simple interfaces to modify standard units
 
61
c
 
62
      entry io_seterr(unit)
 
63
      stderr = unit
 
64
      return
 
65
      entry io_setout(unit)
 
66
      stdout = unit
 
67
      return
 
68
 
 
69
      entry io_geterr(unit)
 
70
      unit = stderr
 
71
      return
 
72
      entry io_getout(unit)
 
73
      unit = stdout
 
74
      return
 
75
c
 
76
c------------------------------------------------------------------     
 
77
c
 
78
c     Logical unit management
 
79
c
 
80
      entry io_assign(lun)
 
81
c
 
82
c     Looks for a free unit and assigns it to lun
 
83
c
 
84
      do lun= min_lun, max_lun
 
85
         if (lun_is_free(lun)) then
 
86
            inquire(unit=lun, opened=used, iostat=iostat)
 
87
            if (iostat .ne. 0) used = .true.
 
88
            lun_is_free(lun) = .false.
 
89
            if (.not. used) return
 
90
         endif
 
91
      enddo
 
92
      call die('No luns available in io_assign')
 
93
c
 
94
c===
 
95
c
 
96
      entry io_reserve(lun)
 
97
c
 
98
c     Useful to specify that one needs to use a particular unit number
 
99
c
 
100
c     For example, assume some legacy code expects to work with unit 15:
 
101
c
 
102
c     call io_reserve(15)   ! this call at the beginning of the program
 
103
c     ...
 
104
c     open(15,....)
 
105
c
 
106
      inquire(unit=lun, opened=used, iostat=iostat)
 
107
      if (iostat .ne. 0) used = .true.
 
108
      if (used) call die('Cannot reserve unit. Already connected')
 
109
      if (lun .ge. min_lun .and. lun .le. max_lun)
 
110
     $                      lun_is_free(lun) = .false.
 
111
 
 
112
      return
 
113
c
 
114
c===
 
115
c
 
116
      entry io_close(lun)
 
117
c
 
118
c     Use this routine instead of a simple close!!
 
119
c
 
120
      close(lun)
 
121
      if (lun .ge. min_lun .and. lun .le. max_lun)
 
122
     $                     lun_is_free(lun) = .true.
 
123
      return
 
124
c
 
125
c===
 
126
c
 
127
      entry io_status
 
128
c
 
129
c     Prints a list of the connected logical units and the names of
 
130
c     the associated files
 
131
c
 
132
 
 
133
      write(stdout,'(a)') '******** io_status ********'
 
134
      do i = 0, max_lun
 
135
         inquire(i,opened=opened,named=named,name=filename,
 
136
     $           form=form,iostat=iostat)
 
137
         if (iostat .eq. 0) then
 
138
            if (opened) then
 
139
               if (named) then
 
140
                  write(stdout,9000) i, form, filename
 
141
               else
 
142
                  write(stdout,9000) i, form, 'No name available'
 
143
               endif
 
144
            endif
 
145
         else
 
146
            write(stdout,9000) i, 'Iostat error'
 
147
         endif
 
148
      enddo
 
149
      write(stdout,'(a)') '********           ********'
 
150
 
 
151
 9000 format(i4,5x,a,5x,a)
 
152
      return
 
153
 
 
154
      end
 
155
 
 
156
 
 
157
 
 
158
 
 
159
 
 
160