1c
2c $Id$
3c
4
5!*******************************************************
6!
7!   Name    :
8!
9!   Purpose :
10!
11!   Created :
12!*******************************************************
13      subroutine get_io_unit(fp)
14      implicit none
15      integer  fp
16
17      !*** local variables ***
18      integer  min_io_unit,max_io_unit
19      parameter(min_io_unit = 20,max_io_unit = 100)
20
21      logical open_status,exist_status
22      integer i,ierr
23
24      DO i=min_io_unit,max_io_unit
25
26        inquire(UNIT=i,
27     >        OPENED = open_status,
28     >        EXIST = exist_status,
29     >        IOSTAT= ierr)
30        if(.not. open_status .and.
31     >    exist_status .and. ierr.eq.0) then
32          fp = i
33          return
34        end if
35
36      end do
37
38      call errquit("cannot get free file unit",0,0)
39
40      return
41      end
42!*******************************************************
43!
44!   Name    :
45!
46!   Purpose :
47!
48!   Created :
49!*******************************************************
50      function assert_file(filename)
51      implicit none
52      character*(*) filename
53
54      logical assert_file !result
55
56      !*** local variables ***
57      logical  file_exist
58
59      inquire(FILE=filename, EXIST=file_exist)
60      assert_file = file_exist
61      return
62      end
63
64!*******************************************************
65!
66!   Name    :
67!
68!   Purpose :
69!
70!   Created :
71!*******************************************************
72      subroutine open_file(FileName,mode,fp)
73      implicit none
74      character*(*) FileName
75      character*(*) mode
76      integer      fp
77
78*     !**** local variables ****
79      integer  l,ierr
80      character*20 action, status,position
81      character*255 junk
82
83      l = index(mode,' ') -1
84      if (l.lt.1) l = 1
85      if (mode(1:l).eq.'r') then
86          action   = 'READ'
87          status   = 'OLD'
88          position = 'REWIND'
89      else if (mode(1:l).eq.'w') then
90          action = 'WRITE'
91          status = 'REPLACE'
92          position = "REWIND"
93      else if (mode(1:l).eq.'w+') then
94          action   = 'WRITE'
95          status   = 'OLD'
96          position = "APPEND"
97      else
98          junk = "unknown parameter in open_file, "//mode(1:l)
99          call errquit(junk,0,0)
100      end if
101
102      call get_io_unit(fp)
103
104      l = index(FileName,' ') -1
105      open(UNIT=fp,FILE=FileName(1:l),
106     >    STATUS=status,
107     >    FORM='formatted',
108     >    IOSTAT=ierr)
109
110      if (ierr.ne.0)  then
111          junk = " opening "//FileName
112          call errquit(junk,0,0)
113      end if
114
115      return
116      end !SUBROUTINE open_file
117
118