118
119
121
122
123
124 integer, intent(in) :: ng, tile, kout, nout
125# ifdef ADJUST_BOUNDARY
126 integer, intent(in) :: LBij, UBij
127# endif
128 integer, intent(in) :: LBi, UBi, LBj, UBj
129
130
131
132 integer :: Fcount, i, j, gfactor, gtype, status
133# ifdef SOLVE3D
134 integer :: itrc, k
135# endif
136
137 real(dp) :: scale
138
139 character (len=*), parameter :: MyFile = &
140 & __FILE__//", wrt_evolved_nf90"
141
142 sourcefile=myfile
143
144
145
146
147
148 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
149
150
151
152
153# if defined WRITE_WATER && defined MASKING
154 gfactor=-1
155# else
156 gfactor=1
157# endif
158
159
160
161 lze(ng)%Rindex=lze(ng)%Rindex+1
162 fcount=lze(ng)%Fcount
163 lze(ng)%Nrec(fcount)=lze(ng)%Nrec(fcount)+1
164
165
166
167# ifdef SOLVE3D
168# ifdef NESTING
169 IF (master) WRITE (stdout,10) kout, nout, lze(ng)%Rindex, ng
170# else
171 IF (master) WRITE (stdout,10) kout, nout, lze(ng)%Rindex
172# endif
173# else
174# ifdef NESTING
175 IF (master) WRITE (stdout,10) kout, lze(ng)%Rindex, ng
176# else
177 IF (master) WRITE (stdout,10) kout, lze(ng)%Rindex
178# endif
179# endif
180
181
182
184 & trim(vname(1,idtime)), time(ng:), &
185 & (/lze(ng)%Rindex/), (/1/), &
186 & ncid = lze(ng)%ncid, &
187 & varid = lze(ng)%Vid(idtime))
188 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
189
190
191
192 scale=1.0_dp
193 gtype=gfactor*r2dvar
194 status=nf_fwrite2d(ng, iadm, lze(ng)%ncid, idfsur, &
195 & lze(ng)%Vid(idfsur), &
196 & lze(ng)%Rindex, gtype, &
197 & lbi, ubi, lbj, ubj, scale, &
198# ifdef MASKING
199 & grid(ng) % rmask, &
200# endif
201 & ocean(ng)% tl_zeta(:,:,kout))
202 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
203 IF (master) THEN
204 WRITE (stdout,20) trim(vname(1,idfsur)), lze(ng)%Rindex
205 END IF
206 exit_flag=3
207 ioerror=status
208 RETURN
209 END IF
210
211# ifdef ADJUST_BOUNDARY
212
213
214
215 IF (any(lobc(:,isfsur,ng))) THEN
216 scale=1.0_dp
217 status=nf_fwrite2d_bry(ng, iadm, lze(ng)%name, lze(ng)%ncid, &
218 & vname(1,idsbry(isfsur)), &
219 & lze(ng)%Vid(idsbry(isfsur)), &
220 & lze(ng)%Rindex, r2dvar, &
221 & lbij, ubij, nbrec(ng), scale, &
222 & boundary(ng) % tl_zeta_obc(lbij:,:,:, &
223 & kout))
224 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
225 IF (master) THEN
226 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), &
227 & lze(ng)%Rindex
228 END IF
229 exit_flag=3
230 ioerror=status
231 RETURN
232 END IF
233 END IF
234# endif
235
236
237
238 scale=1.0_dp
239 gtype=gfactor*u2dvar
240 status=nf_fwrite2d(ng, iadm, lze(ng)%ncid, idubar, &
241 & lze(ng)%Vid(idubar), &
242 & lze(ng)%Rindex, gtype, &
243 & lbi, ubi, lbj, ubj, scale, &
244# ifdef MASKING
245 & grid(ng) % umask_full, &
246# endif
247 & ocean(ng) % tl_ubar(:,:,kout))
248 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
249 IF (master) THEN
250 WRITE (stdout,20) trim(vname(1,idubar)), lze(ng)%Rindex
251 END IF
252 exit_flag=3
253 ioerror=status
254 RETURN
255 END IF
256
257# ifdef ADJUST_BOUNDARY
258
259
260
261 IF (any(lobc(:,isubar,ng))) THEN
262 scale=1.0_dp
263 status=nf_fwrite2d_bry(ng, iadm, lze(ng)%name, lze(ng)%ncid, &
264 & vname(1,idsbry(isubar)), &
265 & lze(ng)%Vid(idsbry(isubar)), &
266 & lze(ng)%Rindex, u2dvar, &
267 & lbij, ubij, nbrec(ng), scale, &
268 & boundary(ng) % tl_ubar_obc(lbij:,:,:, &
269 & kout))
270 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
271 IF (master) THEN
272 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), &
273 & lze(ng)%Rindex
274 END IF
275 exit_flag=3
276 ioerror=status
277 RETURN
278 END IF
279 END IF
280# endif
281
282
283
284 scale=1.0_dp
285 gtype=gfactor*v2dvar
286 status=nf_fwrite2d(ng, iadm, lze(ng)%ncid, idvbar, &
287 & lze(ng)%Vid(idvbar), &
288 & lze(ng)%Rindex, gtype, &
289 & lbi, ubi, lbj, ubj, scale, &
290# ifdef MASKING
291 & grid(ng) % vmask_full, &
292# endif
293 & ocean(ng) % tl_vbar(:,:,kout))
294 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
295 IF (master) THEN
296 WRITE (stdout,20) trim(vname(1,idvbar)), lze(ng)%Rindex
297 END IF
298 exit_flag=3
299 ioerror=status
300 RETURN
301 END IF
302
303# ifdef ADJUST_BOUNDARY
304
305
306
307 IF (any(lobc(:,isvbar,ng))) THEN
308 scale=1.0_dp
309 status=nf_fwrite2d_bry(ng, iadm, lze(ng)%name, lze(ng)%ncid, &
310 & vname(1,idsbry(isvbar)), &
311 & lze(ng)%Vid(idsbry(isvbar)), &
312 & lze(ng)%Rindex, v2dvar, &
313 & lbij, ubij, nbrec(ng), scale, &
314 & boundary(ng) % tl_vbar_obc(lbij:,:,:, &
315 & kout))
316 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
317 IF (master) THEN
318 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), &
319 & lze(ng)%Rindex
320 END IF
321 exit_flag=3
322 ioerror=status
323 RETURN
324 END IF
325 END IF
326# endif
327
328# ifdef SOLVE3D
329
330
331
332 scale=1.0_dp
333 gtype=gfactor*u3dvar
334 status=nf_fwrite3d(ng, iadm, lze(ng)%ncid, iduvel, &
335 & lze(ng)%Vid(iduvel), &
336 & lze(ng)%Rindex, gtype, &
337 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
338# ifdef MASKING
339 & grid(ng) % umask_full, &
340# endif
341 & ocean(ng) % tl_u(:,:,:,nout))
342 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
343 IF (master) THEN
344 WRITE (stdout,20) trim(vname(1,iduvel)), lze(ng)%Rindex
345 END IF
346 exit_flag=3
347 ioerror=status
348 RETURN
349 END IF
350
351# ifdef ADJUST_BOUNDARY
352
353
354
355 IF (any(lobc(:,isuvel,ng))) THEN
356 scale=1.0_dp
357 status=nf_fwrite3d_bry(ng, iadm, lze(ng)%name, lze(ng)%ncid, &
358 & vname(1,idsbry(isuvel)), &
359 & lze(ng)%Vid(idsbry(isuvel)), &
360 & lze(ng)%Rindex, u3dvar, &
361 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
362 & boundary(ng) % tl_u_obc(lbij:,:,:,:, &
363 & nout))
364 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
365 IF (master) THEN
366 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), &
367 & lze(ng)%Rindex
368 END IF
369 exit_flag=3
370 ioerror=status
371 RETURN
372 END IF
373 END IF
374# endif
375
376
377
378 scale=1.0_dp
379 gtype=gfactor*v3dvar
380 status=nf_fwrite3d(ng, iadm, lze(ng)%ncid, idvvel, &
381 & lze(ng)%Vid(idvvel), &
382 & lze(ng)%Rindex, gtype, &
383 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
384# ifdef MASKING
385 & grid(ng) % vmask_full, &
386# endif
387 & ocean(ng) % tl_v(:,:,:,nout))
388 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
389 IF (master) THEN
390 WRITE (stdout,20) trim(vname(1,idvvel)), lze(ng)%Rindex
391 END IF
392 exit_flag=3
393 ioerror=status
394 RETURN
395 END IF
396
397# ifdef ADJUST_BOUNDARY
398
399
400
401 IF (any(lobc(:,isvvel,ng))) THEN
402 scale=1.0_dp
403 status=nf_fwrite3d_bry(ng, iadm, lze(ng)%name, lze(ng)%ncid, &
404 & vname(1,idsbry(isvvel)), &
405 & lze(ng)%Vid(idsbry(isvvel)), &
406 & lze(ng)%Rindex, v3dvar, &
407 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
408 & boundary(ng) % tl_v_obc(lbij:,:,:,:, &
409 & nout))
410 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
411 IF (master) THEN
412 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), &
413 & lze(ng)%Rindex
414 END IF
415 exit_flag=3
416 ioerror=status
417 RETURN
418 END IF
419 END IF
420# endif
421
422
423
424 DO itrc=1,nt(ng)
425 scale=1.0_dp
426 gtype=gfactor*r3dvar
427 status=nf_fwrite3d(ng, iadm, lze(ng)%ncid, idtvar(itrc), &
428 & lze(ng)%Tid(itrc), &
429 & lze(ng)%Rindex, gtype, &
430 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
431# ifdef MASKING
432 & grid(ng) % rmask, &
433# endif
434 & ocean(ng) % tl_t(:,:,:,nout,itrc))
435 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
436 IF (master) THEN
437 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), &
438 & lze(ng)%Rindex
439 END IF
440 exit_flag=3
441 ioerror=status
442 RETURN
443 END IF
444 END DO
445
446# ifdef ADJUST_BOUNDARY
447
448
449
450 DO itrc=1,nt(ng)
451 IF (any(lobc(:,istvar(itrc),ng))) THEN
452 scale=1.0_dp
453 status=nf_fwrite3d_bry(ng, iadm, lze(ng)%name, lze(ng)%ncid, &
454 & vname(1,idsbry(istvar(itrc))), &
455 & lze(ng)%Vid(idsbry(istvar(itrc))), &
456 & lze(ng)%Rindex, r3dvar, &
457 & lbij, ubij, 1, n(ng), nbrec(ng), &
458 & scale, &
459 & boundary(ng) % tl_t_obc(lbij:,:,:,:, &
460 & nout,itrc))
461 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
462 IF (master) THEN
463 WRITE (stdout,20) trim(vname(1,idsbry(istvar(itrc)))), &
464 & lze(ng)%Rindex
465 END IF
466 exit_flag=3
467 ioerror=status
468 RETURN
469 END IF
470 END IF
471 END DO
472# endif
473
474# ifdef ADJUST_STFLUX
475
476
477
478
479
480 DO itrc=1,nt(ng)
481 IF (lstflux(itrc,ng)) THEN
482 scale=1.0_dp
483 gtype=gfactor*r3dvar
484 status=nf_fwrite3d(ng, iadm, lze(ng)%ncid, idtsur(itrc), &
485 & lze(ng)%Vid(idtsur(itrc)), &
486 & lze(ng)%Rindex, gtype, &
487 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
488# ifdef MASKING
489 & grid(ng) % rmask, &
490# endif
491 & forces(ng) % tl_tflux(:,:,:,kout,itrc))
492 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
493 IF (master) THEN
494 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
495 & lze(ng)%Rindex
496 END IF
497 exit_flag=3
498 ioerror=status
499 RETURN
500 END IF
501 END IF
502 END DO
503# endif
504# endif
505# ifdef ADJUST_WSTRESS
506
507
508
509
510
511 scale=1.0_dp
512 gtype=gfactor*u3dvar
513 status=nf_fwrite3d(ng, iadm, lze(ng)%ncid, idusms, &
514 & lze(ng)%Vid(idusms), &
515 & lze(ng)%Rindex, gtype, &
516 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
517# ifdef MASKING
518 & grid(ng) % umask_full, &
519# endif
520 & forces(ng) % tl_ustr(:,:,:,kout))
521 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
522 IF (master) THEN
523 WRITE (stdout,20) trim(vname(1,idusms)), lze(ng)%Rindex
524 END IF
525 exit_flag=3
526 ioerror=status
527 RETURN
528 END IF
529
530
531
532 scale=1.0_dp
533 gtype=gfactor*v3dvar
534 status=nf_fwrite3d(ng, iadm, lze(ng)%ncid, idvsms, &
535 & lze(ng)%Vid(idvsms), &
536 & lze(ng)%Rindex, gtype, &
537 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
538# ifdef MASKING
539 & grid(ng) % vmask_full, &
540# endif
541 & forces(ng) % tl_vstr(:,:,:,kout))
542 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
543 IF (master) THEN
544 WRITE (stdout,20) trim(vname(1,idvsms)), lze(ng)%Rindex
545 END IF
546 exit_flag=3
547 ioerror=status
548 RETURN
549 END IF
550# endif
551
552
553
554
555
556
557 CALL netcdf_sync (ng, iadm, lze(ng)%name, lze(ng)%ncid)
558 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
559
560 10 FORMAT (2x,'WRT_EVOLVED_NF90 - writing evolved LCZ',t42, &
561# ifdef SOLVE3D
562# ifdef NESTING
563 & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2)
564# else
565 & 'fields (Index=',i1,',',i1,') in record = ',i0)
566# endif
567# else
568# ifdef NESTING
569 & 'fields (Index=',i1,') in record = ',i0,t92,i2.2)
570# else
571 & 'fields (Index=',i1,') in record = ',i0)
572# endif
573# endif
574 20 FORMAT (/,' WRT_EVOLVED_NF90 - error while writing variable: ',a, &
575 & /,20x,'into evolved LCZ NetCDF file for time record: ',i0)
576
577 RETURN
subroutine, public netcdf_sync(ng, model, ncname, ncid)