4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
21# ifdef FOUR_DVAR
23# endif
27
29# ifdef TL_AVERAGES
31# endif
32# ifdef DISTRIBUTE
34# endif
35# ifdef OBSERVATIONS
38# endif
42# ifdef TL_AVERAGES
44# endif
45
46 implicit none
47
48
49
50 integer, intent(in) :: ng
51
52
53
54 logical :: Ldefine, Lupdate, NewFile
55
56 integer :: Fcount, ifile, status, tile
57
58 character (len=*), parameter :: MyFile = &
59 & __FILE__
60
62
63# ifdef PROFILE
64
65
66
67
68
70# endif
71
72
73
74
75
76
77
80 END IF
81
82
83
84
85#ifdef BIOLOGY
86 lupdate=.true.
87#else
88 lupdate=.false.
89#endif
90
91
92
93
94
101 END IF
102 END IF
106 ldefine=.false.
107 ELSE
108 ldefine=.true.
109 newfile=.false.
110 END IF
116 END IF
117 ldefine=.true.
118 newfile=.true.
119 ELSE
120 ldefine=.false.
121 END IF
122 IF (ldefine) THEN
125 END IF
127 tlm(ng)%load=
tlm(ng)%load+1
128 IF (
tlm(ng)%load.gt.
tlm(ng)%Nfiles)
THEN
130 WRITE (
stdout,10)
'TLM(ng)%load = ',
tlm(ng)%load, &
131 &
tlm(ng)%Nfiles, trim(
tlm(ng)%base), &
132 & ifile
133 END IF
136 & __line__, myfile)) RETURN
137 END IF
139 tlm(ng)%Nrec(fcount)=0
141 WRITE (
tlm(ng)%name,20) trim(
tlm(ng)%base), ifile
142 END IF
143# ifdef DISTRIBUTE
145# endif
146 tlm(ng)%files(fcount)=trim(
tlm(ng)%name)
150 END IF
153 ELSE
155 END IF
156 ELSE
162 END IF
163 END IF
164 END IF
165
166
167
168
170# if defined STOCHASTIC_OPT || defined FORCING_SV || \
171 defined hessian_so || defined hessian_fsv
172
173
174
175 IF (
iic(ng).eq.1)
THEN
176# ifdef DISTRIBUTE
178# else
180# endif
182 END IF
183# else
186 & (mod(
iic(ng)-1,
ntlm(ng)).eq.0))
THEN
187# ifdef DISTRIBUTE
189# else
191# endif
193 END IF
194 ELSE
195 IF ((mod(
iic(ng)-1,
ntlm(ng)).eq.0).and. &
197# ifdef DISTRIBUTE
199# else
201# endif
203 END IF
204 END IF
205# endif
206 END IF
207
208# ifdef TL_AVERAGES
209
210
211
212
213
214
215
216
217
226 END IF
227 END IF
231 ldefine=.false.
232 ELSE
233 newfile=.false.
234 ldefine=.true.
235 END IF
241 END IF
242 ldefine=.true.
243 newfile=.true.
244 ELSE
245 ldefine=.false.
246 END IF
247 IF (ldefine) THEN
250 END IF
251 avg(ng)%load=
avg(ng)%load+1
254 ELSE
256 END IF
257 IF (
avg(ng)%load.gt.
avg(ng)%Nfiles)
THEN
259 WRITE (
stdout,10)
'AVG(ng)%load = ',
avg(ng)%load, &
260 &
avg(ng)%Nfiles, trim(
avg(ng)%base), &
261 & ifile
262 END IF
265 & __line__, myfile)) RETURN
266 END IF
268 avg(ng)%Nrec(fcount)=0
270 WRITE (
avg(ng)%name,20) trim(
avg(ng)%base), ifile
271 END IF
272# ifdef DISTRIBUTE
274# endif
275 avg(ng)%files(fcount)=trim(
avg(ng)%name)
280 END IF
281 ELSE
287 END IF
288 END IF
289 END IF
290
291
292
295 & (mod(
iic(ng)-1,
navg(ng)).eq.0))
THEN
296# ifdef DISTRIBUTE
298# else
300# endif
302 END IF
303 END IF
304# endif
305
306# if defined FOUR_DVAR
307# ifdef OBSERVATIONS
308
309
310
311
312
313
317# ifdef DISTRIBUTE
319# else
320 tile=-1
321# endif
323# ifdef SP4DVAR
324
325
326
329 END IF
330# else
332# endif
333# ifndef WEAK_CONSTRAINT
335# endif
336 ELSE
338 END IF
339# endif
340# endif
341# ifdef PROFILE
342
343
344
345
346
348# endif
349
350 10 FORMAT (/,' TL_OUTPUT - multi-file counter ',a,i0, &
351 & ', is greater than Nfiles = ',i0,1x,'dimension', &
352 & /,13x,'in structure when creating next file: ', &
353 & a,'_',i4.4,'.nc', &
354 & /,13x,'Incorrect OutFiles logic in ''read_phypar''.')
355 20 FORMAT (a,'_',i4.4,'.nc')
356
357 RETURN
subroutine, public close_file(ng, model, s, ncname, lupdate)
subroutine, public def_avg(ng, ldef)
logical, dimension(:), allocatable lsadd
logical, dimension(:), allocatable processobs
type(t_io), dimension(:), allocatable tlm
type(t_io), dimension(:), allocatable avg
character(len=256) sourcefile
integer, dimension(:), allocatable idefavg
integer, dimension(:), allocatable ideftlm
integer, dimension(:), allocatable nrrec
real(dp), dimension(:), allocatable obstime
integer, dimension(:), allocatable iic
integer, dimension(:), allocatable ntlm
real(dp), dimension(:), allocatable dt
integer, dimension(:), allocatable ndeftlm
logical, dimension(:), allocatable ldefavg
integer, dimension(:), allocatable navg
logical, dimension(:), allocatable lwrtavg
integer, dimension(:), allocatable ntend
integer, dimension(:), allocatable ndefavg
logical, dimension(:), allocatable lwrtper
logical, dimension(:), allocatable lwrttlm
logical, dimension(:), allocatable ldefout
real(dp), dimension(:), allocatable time
logical, dimension(:), allocatable ldeftlm
integer, dimension(:), allocatable ntstart
subroutine, public obs_read(ng, model, backward)
subroutine, public obs_write(ng, tile, model)
logical function, public founderror(flag, noerr, line, routine)
subroutine, public tl_def_his(ng, ldef)
subroutine, public tl_wrt_his(ng, tile)
subroutine, public wrt_avg(ng, tile)
subroutine obs_cost(ng, model)
recursive subroutine wclock_off(ng, model, region, line, routine)
recursive subroutine wclock_on(ng, model, region, line, routine)