1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
C Last change: BCM 23 Sep 1998 2:53 pm
**==fopen.f processed by SPAG 4.03F at 09:48 on 1 Mar 1994
SUBROUTINE fopen(Fil,Fildes,Flstat,Handle,Locok)
IMPLICIT NONE
c-----------------------------------------------------------------------
c Opens a file with the given options and assigns a file handle
c Parameters and include files
c-----------------------------------------------------------------------
INCLUDE 'stdio.i'
INCLUDE 'units.cmn'
c-----------------------------------------------------------------------
c PFILE i Maximum number of files that can be opened at a time
c-----------------------------------------------------------------------
LOGICAL F,T
PARAMETER(T=.true.,F=.FALSE.)
C-----------------------------------------------------------------------
c Namelist Input Arguments
c Name Type Description
c-----------------------------------------------------------------------
c fil c Filename
c handle i Unit number of the next available file
c Flstat c Status of the file, either new, old, unknown, or scratch
c-----------------------------------------------------------------------
CHARACTER Fildes*(*),Fil*(*),Flstat*(*)
INTEGER Handle
c-----------------------------------------------------------------------
c Local Arguments
c Name Type Description
c-----------------------------------------------------------------------
c ifile i Index for the current file
c intfil l Switch to set up the file list first time through
c flpext c Constructed file name plus the extension if there is one
c nextcr i Number of characters in the extension
c-----------------------------------------------------------------------
INTEGER nblank
EXTERNAL nblank
c-----------------------------------------------------------------------
LOGICAL Locok,intfil
INTEGER ifile,nchr
SAVE intfil
DATA intfil/.true./
c-----------------------------------------------------------------------
c If this is the first call to the routine then initialize the list
c of files.
c-----------------------------------------------------------------------
Locok=T
IF(intfil)THEN
DO ifile=1,PFILE
Fillst(ifile)=ifile+9
END DO
c-----------------------------------------------------------------------
c Changed because of log file (BCM Dec 1994)
c-----------------------------------------------------------------------
Nfile=1
c-----------------------------------------------------------------------
intfil=F
Opnsin=F
Opnsot=F
END IF
c-----------------------------------------------------------------------
c Length of the file name
c-----------------------------------------------------------------------
nchr=nblank(Fil)
c-----------------------------------------------------------------------
c Open standard in. Note that a FORTRAN file cannot be opened with
c read only status. This may cause a file without write permissions to
c fail.
c-----------------------------------------------------------------------
IF(Handle.eq.STDIN)THEN
IF(Infile.ne.'STDIN')THEN
OPEN(UNIT=Handle,FILE=Fil(1:nchr),STATUS='OLD',ERR=10)
Opnsin=T
END IF
c ------------------------------------------------------------------
c Open Standard out
c-----------------------------------------------------------------------
ELSE IF(Handle.eq.STDOUT)THEN
IF(Infile.ne.'STDOUT')OPEN(UNIT=Handle,FILE=Fil(1:nchr),STATUS=
& 'UNKNOWN',ERR=10)
Opnsot=T
c ------------------------------------------------------------------
ELSE IF(Nfile.ge.PFILE)THEN
WRITE(STDERR,1010)Nfile,PFILE
IF(Mt2.gt.0)THEN
CALL errhdr
WRITE(Mt2,1010)Nfile,PFILE
END IF
1010 FORMAT(/,' ERROR: Too many open files',i3,'>',i3,'.')
GO TO 20
c ------------------------------------------------------------------
ELSE
Nfile=Nfile+1
Handle=Fillst(Nfile)
OPEN(UNIT=Handle,FILE=Fil(1:nchr),STATUS=Flstat,ERR=10)
END IF
c-----------------------------------------------------------------------
c Write out the the file and description
c-----------------------------------------------------------------------
IF(Flstat(1:3).eq.'OLD'.or.Flstat(1:3).eq.'old')THEN
IF(Mt1.gt.0)THEN
WRITE(Mt1,*)' Reading ',Fildes,' from ',Fil(1:nchr)
ELSE
WRITE(STDOUT,*)' Reading ',Fildes,' from ',Fil(1:nchr)
END IF
END IF
c ------------------------------------------------------------------
RETURN
c-----------------------------------------------------------------------
c Error return
c-----------------------------------------------------------------------
10 IF(Flstat.eq.'NEW'.or.Flstat.eq.'new')THEN
WRITE(STDERR,1020)Fildes,Fil(1:nchr)
IF(Mt2.gt.0)THEN
CALL errhdr
WRITE(Mt2,1020)Fildes,Fil(1:nchr)
END IF
1020 FORMAT(/,' ERROR: ',a,' ',a,' already exists.',/)
c ------------------------------------------------------------------
ELSE
WRITE(STDERR,1030)Fildes,Fil(1:nchr)
IF(Mt2.gt.0.and.Mt2.ne.Handle)THEN
CALL errhdr
WRITE(Mt2,1030)Fildes,Fil(1:nchr)
END IF
1030 FORMAT(/,' ERROR: Unable to open ',a,', ',a,'.',/)
END IF
c ------------------------------------------------------------------
20 Locok=F
RETURN
END
|
