3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
26
28
29
30
31 character (len=*) :: task
32
33
34
35 integer :: Iunder, ifile, lstr, ng
36 integer :: Nfiles
37
38 character (len=*), parameter :: MyFile = &
39 & __FILE__
40
42
43
44
45
46
47
48
49
50
51
52
54
55 SELECT CASE (trim(adjustl(task)))
56
57
58
59
60 CASE ('HIS2FWD')
61 fwd(ng)%IOtype=
his(ng)%IOtype
67 DO ifile=1,nfiles
68 fwd(ng)%files(ifile)=trim(
his(ng)%files(ifile))
69 END DO
70 fwd(ng)%name=trim(
fwd(ng)%files(1))
71 ELSE
74#if defined PIO_LIB && defined DISTRIBUTE
76 fwd(ng)%pioFile=
his(ng)%pioFile
77#endif
78 END IF
79 fwd(ng)%name=trim(
his(ng)%name)
80 fwd(ng)%files(1)=trim(
his(ng)%name)
81 END IF
82
83
84
85
86
87 CASE ('HIS2BLK')
88 blk(ng)%IOtype=
his(ng)%IOtype
94 DO ifile=1,nfiles
95 blk(ng)%files(ifile)=trim(
his(ng)%files(ifile))
96 END DO
97 blk(ng)%name=trim(
blk(ng)%files(1))
98 ELSE
101#if defined PIO_LIB && defined DISTRIBUTE
103 blk(ng)%pioFile%fh=-1
104#endif
105 END IF
106 blk(ng)%name=trim(
his(ng)%name)
107 blk(ng)%files(1)=trim(
his(ng)%name)
108 END IF
109
110
111
112
113
114 CASE ('QCK2BLK')
115 blk(ng)%IOtype=
qck(ng)%IOtype
121 DO ifile=1,nfiles
122 blk(ng)%files(ifile)=trim(
qck(ng)%files(ifile))
123 END DO
124 blk(ng)%name=trim(
blk(ng)%files(1))
125 ELSE
128#if defined PIO_LIB && defined DISTRIBUTE
130 blk(ng)%pioFile%fh=-1
131#endif
132 END IF
133 blk(ng)%name=trim(
qck(ng)%name)
134 blk(ng)%files(1)=trim(
qck(ng)%name)
135 END IF
136
137
138
139
140
141 CASE ('FWD2BLK')
142 blk(ng)%IOtype=
fwd(ng)%IOtype
143 nfiles=
fwd(ng)%Nfiles
144 IF (nfiles.gt.1) THEN
147 DO ifile=1,nfiles
148 blk(ng)%files(ifile)=trim(
fwd(ng)%files(ifile))
149 END DO
150 blk(ng)%name=trim(
blk(ng)%files(1))
151 ELSE
154#if defined PIO_LIB && defined DISTRIBUTE
156 blk(ng)%pioFile%fh=-1
157#endif
158 END IF
159 blk(ng)%name=trim(
fwd(ng)%name)
160 blk(ng)%files(1)=trim(
fwd(ng)%name)
161 END IF
162
163#ifdef RBL4DVAR_FCT_SENSITIVITY
164
165
166
167
168
169
170
171 CASE ('FWD2HIS')
172 his(ng)%IOtype=
fwd(ng)%IOtype
173 nfiles=
fwd(ng)%Nfiles
174 IF (nfiles.gt.1) THEN
177 DO ifile=1,nfiles
178 his(ng)%files(ifile)=trim(
fwd(ng)%files(ifile))
179 END DO
180 his(ng)%name=trim(
his(ng)%files(1))
181 istring=index(
his(ng)%name,
'_outer',back=.false.)
182 IF (istring.gt.0) THEN
183 lstr=istring-1
184 his(ng)%head=trim(adjustl(
his(ng)%name(1:lstr)))
185 fwd(ng)%head=trim(adjustl(
his(ng)%name(1:lstr)))
186 END IF
187 istring=index(
his(ng)%name,char(95),back=.true.)
188 IF (istring.gt.0) THEN
189 lstr=istring-1
190 his(ng)%base=trim(adjustl(
his(ng)%name(1:lstr)))
191 fwd(ng)%base=trim(adjustl(
his(ng)%name(1:lstr)))
192 END IF
193 ELSE
196#if defined PIO_LIB && defined DISTRIBUTE
198 his(ng)%pioFile=
fwd(ng)%pioFile
199#endif
200 END IF
201 his(ng)%files(1)=trim(
fwd(ng)%files(1))
202 his(ng)%name=trim(
his(ng)%files(1))
203 istring=index(
his(ng)%name,
'_outer',back=.false.)
204 IF (istring.gt.0) THEN
205 lstr=istring-1
206 his(ng)%head=trim(adjustl(
his(ng)%name(1:lstr)))
207 his(ng)%base=trim(adjustl(
his(ng)%name(1:lstr)))
208 END IF
209 END IF
210
211
212
213
214 CASE ('FCTA2FWD')
216 nfiles=
fcta(ng)%Nfiles
217 IF (nfiles.gt.1) THEN
220 DO ifile=1,nfiles
221 fwd(ng)%files(ifile)=trim(
fcta(ng)%files(ifile))
222 END DO
223 fwd(ng)%name=trim(
fwd(ng)%files(1))
224 ELSE
227#if defined PIO_LIB && defined DISTRIBUTE
229 fwd(ng)%pioFile=
fcta(ng)%pioFile
230#endif
231 END IF
232 fwd(ng)%name=trim(
fcta(ng)%name)
233 fwd(ng)%files(1)=trim(
fcta(ng)%name)
234 END IF
235
236
237
238
239
240 CASE ('FCTA2BLK')
242 nfiles=
fcta(ng)%Nfiles
243 IF (nfiles.gt.1) THEN
246 DO ifile=1,nfiles
247 blk(ng)%files(ifile)=trim(
fcta(ng)%files(ifile))
248 END DO
249 blk(ng)%name=trim(
blk(ng)%files(1))
250 ELSE
253#if defined PIO_LIB && defined DISTRIBUTE
255 blk(ng)%pioFile%fh=-1
256#endif
257 END IF
258 blk(ng)%name=trim(
fcta(ng)%name)
259 blk(ng)%files(1)=trim(
fcta(ng)%name)
260 END IF
261
262
263
264
265 CASE ('FCTB2FWD')
267 nfiles=
fctb(ng)%Nfiles
268 IF (nfiles.gt.1) THEN
271 DO ifile=1,nfiles
272 fwd(ng)%files(ifile)=trim(
fctb(ng)%files(ifile))
273 END DO
274 fwd(ng)%name=trim(
fwd(ng)%files(1))
275 ELSE
278#if defined PIO_LIB && defined DISTRIBUTE
280 fwd(ng)%pioFile=
fctb(ng)%pioFile
281#endif
282 END IF
283 fwd(ng)%name=trim(
fctb(ng)%name)
284 fwd(ng)%files(1)=trim(
fctb(ng)%name)
285 END IF
286
287
288
289
290
291 CASE ('FCTB2BLK')
293 nfiles=
fctb(ng)%Nfiles
294 IF (nfiles.gt.1) THEN
297 DO ifile=1,nfiles
298 blk(ng)%files(ifile)=trim(
fctb(ng)%files(ifile))
299 END DO
300 blk(ng)%name=trim(
blk(ng)%files(1))
301 ELSE
304#if defined PIO_LIB && defined DISTRIBUTE
306 blk(ng)%pioFile%fh=-1
307#endif
308 END IF
309 blk(ng)%name=trim(
fctb(ng)%name)
310 blk(ng)%files(1)=trim(
fctb(ng)%name)
311 END IF
312#endif
313
314
315
316
317
318 CASE ('TLM2FWD')
319 fwd(ng)%IOtype=
tlm(ng)%IOtype
325 DO ifile=1,nfiles
326 fwd(ng)%files(ifile)=trim(
tlm(ng)%files(ifile))
327 END DO
328 fwd(ng)%name=trim(
fwd(ng)%files(1))
329 ELSE
332#if defined PIO_LIB && defined DISTRIBUTE
334 fwd(ng)%pioFile=
tlm(ng)%pioFile
335#endif
336 END IF
337 fwd(ng)%name=trim(
tlm(ng)%name)
338 fwd(ng)%files(1)=trim(
tlm(ng)%name)
339 END IF
340
341 END SELECT
342 END DO
343
344 RETURN
subroutine edit_file_struct(ng, nfiles, s)
subroutine, public close_file(ng, model, s, ncname, lupdate)
type(t_io), dimension(:), allocatable his
type(t_io), dimension(:), allocatable fcta
type(t_io), dimension(:), allocatable fctb
type(t_io), dimension(:), allocatable tlm
type(t_io), dimension(:), allocatable blk
type(t_io), dimension(:), allocatable qck
type(t_io), dimension(:), allocatable fwd
character(len=256) sourcefile
integer, parameter io_nf90
integer, parameter io_pio
integer, dimension(:), allocatable ntimes
integer, dimension(:), allocatable ndefhis
integer, dimension(:), allocatable ntlm
integer, dimension(:), allocatable nqck
integer, dimension(:), allocatable ndeftlm
integer, dimension(:), allocatable ndefqck
integer, dimension(:), allocatable nhis