指定されたアクセスモードで netCDF ファイルを開きます。 同じ名前のファイルが互換性のあるアクセスモードで既にオープンされている場合、 既存のファイル ID を返し、参照カウントを増加させます。
60 use netcdf, only: &
61 & nf90_write, &
62 & nf90_nowrite, &
63 & nf90_noerr, &
64 & nf90_noclobber, &
65 & nf90_clobber, &
66 & nf90_64bit_offset, &
67 & nf90_open, &
68 & nf90_create
73 implicit none
74 integer, intent(out):: fileid
75 character(len = *), intent(in):: filename
76 logical, intent(in), optional:: writable
77 logical, intent(in), optional:: overwrite
78 logical, intent(out), optional:: err
79 integer, intent(out), optional:: stat
80 logical:: writable_required
81 logical:: overwrite_required
82 type(GD_NC_FILE_ID_ENTRY), pointer:: identptr, prev
83 integer:: mystat, mode
84 character(len = 256):: real_filename
85 character(len = STRING):: cause_c
86 character(*), parameter:: subname = "GDNcFileOpen"
87continue
88 fileid = -1
89
90
91
92 writable_required = .false.
93 overwrite_required = .false.
94 if (present(writable)) writable_required = writable
95 if (present(overwrite)) overwrite_required = overwrite
96 call beginsub(subname,
'writable=%y overwrite=%y file=%c', &
97 & l=(/writable_required, overwrite_required/), c1=trim(filename))
98
99
100
103 nullify(prev)
104 do
105 if ((identptr % filename == filename) &
106 & .and. (identptr % writable .or. .not. writable_required)) then
107 fileid = identptr % id
108 identptr % count = identptr % count + 1
109 if (present(err)) err = .false.
110 if (present(stat)) stat = nf90_noerr
111 mystat = nf90_noerr
112 goto 999
113 endif
114 prev => identptr
115 identptr => identptr % next
116 if (.not. associated(identptr)) exit
117 enddo
118 allocate(identptr)
119 prev%next => identptr
120 else
121 nullify(prev)
125 endif
126 nullify(identptr % next)
127 identptr % filename = filename
128 identptr % writable = writable_required
129 identptr % count = 1
130
131
132
133 real_filename = filename
134 if (real_filename(1:8) == 'file:///') then
135 real_filename = real_filename(8: )
136 else if (real_filename(1:5) == 'file:' .AND. real_filename(6:6) /= '/') then
137 real_filename = real_filename(6: )
138 endif
139
140
141
142 mode = nf90_nowrite
143 if (writable_required) mode = ior(mode, nf90_write)
144
145 mystat = nf90_open(real_filename, mode, identptr % id)
146
147
148
149 if (mystat == nf90_noerr) then
150
151 if (writable_required) then
152 if (overwrite_required) then
153
154 mode = nf90_clobber
156 & '"%c" is overwritten.', c1=trim(filename), rank_mpi = -1)
157 else
158
159 mode = nf90_noclobber
161 & '"%c" is opened in write-protect mode.', c1=trim(filename), rank_mpi = -1)
162 end if
163 mode = ior(mode,nf90_64bit_offset)
164 mystat = nf90_create(real_filename, mode, identptr % id)
165 if (mystat /= nf90_noerr) then
166 cause_c=filename
167 if (present(stat)) stat = mystat
168 goto 999
169 end if
170 endif
171
172 else
173
174
175
176 if (.not. writable_required) then
177
178
179
180 if (mystat /= nf90_noerr) then
181 cause_c=filename
182 if (present(stat)) stat = mystat
183 goto 999
184 end if
185 else
186
187 mode = nf90_clobber
188
189 mode = ior(mode,nf90_64bit_offset)
190 mystat = nf90_create(real_filename, mode, identptr % id)
191 if (mystat /= nf90_noerr) then
192 cause_c=filename
193 if (present(stat)) stat = mystat
194 goto 999
195 end if
196 endif
197 endif
198
199 fileid = identptr % id
200
201
202 if (mystat /= nf90_noerr) then
203 if (associated(prev)) then
204 prev%next => identptr % next
205 else
208 endif
209 deallocate(identptr)
210 fileid = -1
211 endif
212
213 if (present(stat)) then
214 stat = mystat
215 if (present(err)) err = (stat /= nf90_noerr)
216 else
217 cause_c=filename
218 goto 999
219 endif
220999 continue
221 call storeerror(mystat, subname, err, cause_c)
222 call endsub(subname,
'id=%d stat=%d', i=(/fileid, mystat/))
subroutine, public storeerror(number, where, err, cause_c, cause_i)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
logical, save id_used
id_head が初期化済みかを示すフラグ
type(gd_nc_file_id_entry), pointer, save id_head