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