98
99
101
102
103
104 integer, intent(in) :: ng, tile
105 integer, intent(in) :: LBi, UBi, LBj, UBj
106
107
108
109 integer :: Fcount, gfactor, gtype, ifield, itrc, ivar, status
110
111 real(dp) :: scale
112# ifdef BIOLOGY
113 real(r8) :: dtBIO
114# endif
115
116 character (len=*), parameter :: MyFile = &
117 & __FILE__//", wrt_diags_nf90"
118
119 sourcefile=myfile
120
121
122
123
124
125 if (founderror(exit_flag, noerror, __line__, myfile)) RETURN
126
127
128
129
130# if defined WRITE_WATER && defined MASKING
131 gfactor=-1
132# else
133 gfactor=1
134# endif
135
136
137
138 dia(ng)%Rindex=dia(ng)%Rindex+1
139 fcount=dia(ng)%load
140 dia(ng)%Nrec(fcount)=dia(ng)%Nrec(fcount)+1
141
142
143
144# ifdef NESTING
145 IF (master) WRITE (stdout,10) dia(ng)%Rindex, ng
146# else
147 IF (master) WRITE (stdout,10) dia(ng)%Rindex
148# endif
149
150
151
153 & trim(vname(1,idtime)), diatime(ng:), &
154 & (/dia(ng)%Rindex/), (/1/), &
155 & ncid = dia(ng)%ncid, &
156 & varid = dia(ng)%Vid(idtime))
157 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
158
159
160
161 scale=1.0_dp
162 gtype=gfactor*r2dvar
163 status=nf_fwrite2d(ng, inlm, dia(ng)%ncid, idfsur, &
164 & dia(ng)%Vid(idfsur), &
165 & dia(ng)%Rindex, gtype, &
166 & lbi, ubi, lbj, ubj, scale, &
167# ifdef MASKING
168 & grid(ng) % rmask, &
169# endif
170 & diags(ng) % avgzeta)
171 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
172 IF (master) THEN
173 WRITE (stdout,20) trim(vname(1,idfsur)), dia(ng)%Rindex
174 END IF
175 exit_flag=3
176 ioerror=status
177 RETURN
178 END IF
179
180# ifdef DIAGNOSTICS_UV
181
182
183
184 DO ivar=1,ndm2d
185 ifield=iddu2d(ivar)
186 IF (dout(ifield,ng)) THEN
187 scale=1.0_dp/dt(ng)
188 gtype=gfactor*u2dvar
189 status=nf_fwrite2d(ng, inlm, dia(ng)%ncid, ifield, &
190 & dia(ng)%Vid(ifield), &
191 & dia(ng)%Rindex, gtype, &
192 & lbi, ubi, lbj, ubj, scale, &
193# ifdef MASKING
194 & grid(ng) % umask, &
195# endif
196 & diags(ng) % DiaU2d(:,:,ivar), &
197 & setfillval = .false.)
198 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
199 IF (master) THEN
200 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
201 END IF
202 exit_flag=3
203 ioerror=status
204 RETURN
205 END IF
206 END IF
207
208 ifield=iddv2d(ivar)
209 IF (dout(ifield,ng)) THEN
210 scale=1.0_dp/dt(ng)
211 gtype=gfactor*v2dvar
212 status=nf_fwrite2d(ng, inlm, dia(ng)%ncid, ifield, &
213 & dia(ng)%Vid(ifield), &
214 & dia(ng)%Rindex, gtype, &
215 & lbi, ubi, lbj, ubj, scale, &
216# ifdef MASKING
217 & grid(ng) % vmask, &
218# endif
219 & diags(ng) % DiaV2d(:,:,ivar), &
220 & setfillval = .false.)
221 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
222 IF (master) THEN
223 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
224 END IF
225 exit_flag=3
226 ioerror=status
227 RETURN
228 END IF
229 END IF
230 END DO
231
232# ifdef SOLVE3D
233
234
235
236 DO ivar=1,ndm3d
237 ifield=iddu3d(ivar)
238 IF (dout(ifield,ng)) THEN
239 scale=1.0_dp/dt(ng)
240 gtype=gfactor*u3dvar
241 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
242 & dia(ng)%Vid(ifield), &
243 & dia(ng)%Rindex, gtype, &
244 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
245# ifdef MASKING
246 & grid(ng) % umask_dia, &
247# endif
248 & diags(ng) % DiaU3d(:,:,:,ivar), &
249 & setfillval = .false.)
250 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
251 IF (master) THEN
252 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
253 END IF
254 exit_flag=3
255 ioerror=status
256 RETURN
257 END IF
258 END IF
259
260 ifield=iddv3d(ivar)
261 IF (dout(ifield,ng)) THEN
262 scale=1.0_dp/dt(ng)
263 gtype=gfactor*v3dvar
264 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
265 & dia(ng)%Vid(ifield), &
266 & dia(ng)%Rindex, gtype, &
267 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
268# ifdef MASKING
269 & grid(ng) % vmask_dia, &
270# endif
271 & diags(ng) % DiaV3d(:,:,:,ivar), &
272 & setfillval = .false.)
273 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
274 IF (master) THEN
275 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
276 END IF
277 exit_flag=3
278 ioerror=status
279 RETURN
280 END IF
281 END IF
282 END DO
283# endif
284# endif
285# ifdef DIAGNOSTICS_TS
286
287
288
289 DO itrc=1,nt(ng)
290 DO ivar=1,ndt
291 ifield=iddtrc(itrc,ivar)
292 IF (dout(ifield,ng)) THEN
293 scale=1.0_dp/dt(ng)
294 gtype=gfactor*r3dvar
295 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
296 & dia(ng)%Vid(ifield), &
297 & dia(ng)%Rindex, gtype, &
298 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
299# ifdef MASKING
300 & grid(ng) % rmask, &
301# endif
302 & diags(ng) % DiaTrc(:,:,:,itrc,ivar), &
303 & setfillval = .false.)
304 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
305 IF (master) THEN
306 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
307 END IF
308 exit_flag=3
309 ioerror=status
310 RETURN
311 END IF
312 END IF
313 END DO
314 END DO
315# endif
316# ifdef DIAGNOSTICS_BIO
317# if defined BIO_FENNEL || defined HYPOXIA_SRM
318
319
320
321 dtbio=dt(ng)*sec2day/real(bioiter(ng),r8)
322
323 DO ivar=1,ndbio2d
324 ifield=idbio2(ivar)
325 IF (dout(ifield,ng)) THEN
326 IF (ivar.eq.ipco2) THEN
327 scale=1.0_dp
328 ELSE
329 scale=1.0_dp/dtbio
330 END IF
331 gtype=gfactor*r2dvar
332 status=nf_fwrite2d(ng, inlm, dia(ng)%ncid, ifield, &
333 & dia(ng)%Vid(ifield), &
334 & dia(ng)%Rindex, gtype, &
335 & lbi, ubi, lbj, ubj, scale, &
336# ifdef MASKING
337 & grid(ng) % rmask, &
338# endif
339 & diags(ng) % DiaBio2d(:,:,ivar), &
340 & setfillval = .false.)
341 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
342 IF (master) THEN
343 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
344 END IF
345 exit_flag=3
346 ioerror=status
347 RETURN
348 END IF
349 END IF
350 END DO
351# endif
352# if defined BIO_FENNEL
353
354
355
356 DO ivar=1,ndbio3d
357 ifield=idbio3(ivar)
358 IF (dout(ifield,ng)) THEN
359 scale=1.0_dp/dtbio
360 gtype=gfactor*r3dvar
361 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
362 & dia(ng)%Vid(ifield), &
363 & dia(ng)%Rindex, gtype, &
364 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
365# ifdef MASKING
366 & grid(ng) % rmask, &
367# endif
368 & diags(ng) % DiaBio3d(:,:,:,ivar), &
369 & setfillval = .false.)
370 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
371 IF (master) THEN
372 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
373 END IF
374 exit_flag=3
375 ioerror=status
376 RETURN
377 END IF
378 END IF
379 END DO
380
381# elif defined ECOSIM
382
383
384
385 dtbio=dt(ng)*sec2day/real(bioiter(ng),r8)
386 DO ivar=1,ndbio3d
387 ifield=idbio3(ivar)
388 IF (dout(ifield,ng)) THEN
389 scale=1.0_dp
390 gtype=gfactor*l3dvar
391 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
392 & dia(ng)%Vid(ifield), &
393 & dia(ng)%Rindex, gtype, &
394 & lbi, ubi, lbj, ubj, 1, ndbands, scale, &
395# ifdef MASKING
396 & grid(ng) % rmask, &
397# endif
398 & diags(ng) % DiaBio3d(:,:,:,ivar), &
399 & setfillval = .false.)
400 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
401 IF (master) THEN
402 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
403 END IF
404 exit_flag=3
405 ioerror=status
406 RETURN
407 END IF
408 END IF
409 END DO
410
411
412
413 dtbio=dt(ng)*sec2day/real(bioiter(ng),r8)
414 DO ivar=1,ndbio4d
415 ifield=idbio4(ivar)
416 IF (dout(ifield,ng)) THEN
417 scale=1.0_dp
418 gtype=gfactor*l4dvar
419 status=nf_fwrite4d(ng, inlm, dia(ng)%ncid, ifield, &
420 & dia(ng)%Vid(ifield), &
421 & dia(ng)%Rindex, gtype, &
422 & lbi, ubi, lbj, ubj, 1, n(ng), 1, ndbands, &
423 & scale, &
424# ifdef MASKING
425 & grid(ng) % rmask, &
426# endif
427 & diags(ng) % DiaBio4d(:,:,:,:,ivar), &
428 & setfillval = .false.)
429 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
430 IF (master) THEN
431 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
432 END IF
433 exit_flag=3
434 ioerror=status
435 RETURN
436 END IF
437 END IF
438 END DO
439# endif
440# endif
441
442
443
444
445 CALL netcdf_sync (ng, inlm, dia(ng)%name, dia(ng)%ncid)
446 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
447
448 10 FORMAT (2x,'WRT_DIAGS_NF90 - writing diagnostics fields',t61, &
449# ifdef NESTING
450 & 'in record = ',i0,t92,i2.2)
451# else
452 & 'in record = ',i0)
453# endif
454 20 FORMAT (/,' WRT_DIAGS_NF90 - error while writing variable: ',a, &
455 & /,18x,'into diagnostics NetCDF file for time record: ',i0)
456
457 RETURN
subroutine, public netcdf_sync(ng, model, ncname, ncid)