ROMS
Loading...
Searching...
No Matches
Data Types | Functions/Subroutines
wrt_info_mod Module Reference

Data Types

interface  wrt_info
 

Functions/Subroutines

subroutine wrt_info_nf90 (ng, model, ncid, ncname)
 
subroutine wrt_info_pio (ng, model, piofile, ncname)
 

Function/Subroutine Documentation

◆ wrt_info_nf90()

subroutine wrt_info_mod::wrt_info_nf90 ( integer, intent(in) ng,
integer, intent(in) model,
integer, intent(in) ncid,
character (len=*), intent(in) ncname )

Definition at line 64 of file wrt_info.F.

65!***********************************************************************
66! !
67! This routine writes out information variables into requested !
68! NetCDF file using the standard NetCDF-3 or NetCDF-4 library. !
69! !
70! On Input: !
71! !
72! ng Nested grid number (integer) !
73! model Calling model identifier (integer) !
74! ncid NetCDF file ID (integer) !
75! ncname NetCDF filename (string) !
76! !
77! On Output: !
78! !
79! exit_flag Error flag (integer) stored in MOD_SCALARS !
80! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
81! !
82!***********************************************************************
83!
84#if !defined PARALLEL_IO && defined DISTRIBUTE
85 USE distribute_mod, ONLY : mp_bcasti
86#endif
87!
88! Imported variable declarations.
89!
90 integer, intent(in) :: ng, model, ncid
91!
92 character (len=*), intent(in) :: ncname
93!
94! Local variable declarations.
95!
96 logical :: Cgrid = .true.
97!
98 integer :: LBi, UBi, LBj, UBj
99 integer :: i, j, k, ibry, ilev, itrc, status, varid
100
101#ifdef DISTRIBUTE
102 integer, dimension(2) :: ibuffer
103#endif
104 integer :: ifield = 0
105!
106 real(dp) :: scale
107#ifdef SOLVE3D
108# ifdef TS_DIF4
109 real(r8), dimension(NT(ng)) :: diff
110# endif
111 real(r8), dimension(NT(ng)) :: nudg
112 real(r8), dimension(NT(ng),4) :: Tobc
113#endif
114#ifdef STATIONS
115 real(r8), dimension(Nstation(ng)) :: Zpos, wrk
116#endif
117!
118 character (len=*), parameter :: MyFile = &
119 & __FILE__//", wrt_info_nf90"
120!
121 sourcefile=myfile
122!
123 IF (ncid.ne.xtr(ng)%ncid) THEN
124 lbi=lbound(grid(ng)%h,dim=1)
125 ubi=ubound(grid(ng)%h,dim=1)
126 lbj=lbound(grid(ng)%h,dim=2)
127 ubj=ubound(grid(ng)%h,dim=2)
128#ifdef GRID_EXTRACT
129 ELSE
130 lbi=lbound(extract(ng)%h,dim=1)
131 ubi=ubound(extract(ng)%h,dim=1)
132 lbj=lbound(extract(ng)%h,dim=2)
133 ubj=ubound(extract(ng)%h,dim=2)
134#endif
135 END IF
136!
137!-----------------------------------------------------------------------
138! Write out running parameters.
139!-----------------------------------------------------------------------
140!
141! Inquire about the variables.
142!
143 CALL netcdf_inq_var (ng, model, ncname, ncid)
144 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
145!
146! Time stepping parameters.
147!
148 CALL netcdf_put_ivar (ng, model, ncname, 'ntimes', &
149 & ntimes(ng), (/0/), (/0/), &
150 & ncid = ncid)
151 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
152
153 CALL netcdf_put_ivar (ng, model, ncname, 'ndtfast', &
154 & ndtfast(ng), (/0/), (/0/), &
155 & ncid = ncid)
156 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
157
158 CALL netcdf_put_fvar (ng, model, ncname, 'dt', &
159 & dt(ng), (/0/), (/0/), &
160 & ncid = ncid)
161 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
162
163 CALL netcdf_put_fvar (ng, model, ncname, 'dtfast', &
164 & dtfast(ng), (/0/), (/0/), &
165 & ncid = ncid)
166 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
167
168 CALL netcdf_put_fvar (ng, model, ncname, 'dstart', &
169 & dstart, (/0/), (/0/), &
170 & ncid = ncid)
171 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
172
173#ifdef RBL4DVAR_FCT_SENSITIVITY
174 CALL netcdf_put_ivar (ng, model, ncname, 'ntimes_ana', &
175 & ntimes_ana(ng), (/0/), (/0/), &
176 & ncid = ncid)
177 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
178
179 CALL netcdf_put_ivar (ng, model, ncname, 'ntimes_fct', &
180 & ntimes_fct(ng), (/0/), (/0/), &
181 & ncid = ncid)
182 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
183#endif
184
185#if defined HDF5 && defined DEFLATE
186 CALL netcdf_put_ivar (ng, model, ncname, 'shuffle', &
187 & shuffle, (/0/), (/0/), &
188 & ncid = ncid)
189 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
190
191 CALL netcdf_put_ivar (ng, model, ncname, 'deflate', &
192 & deflate, (/0/), (/0/), &
193 & ncid = ncid)
194 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
195
196 CALL netcdf_put_ivar (ng, model, ncname, 'deflate_level', &
197 & deflate_level, (/0/), (/0/), &
198 & ncid = ncid)
199 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
200#endif
201
202 CALL netcdf_put_ivar (ng, model, ncname, 'nHIS', &
203 & nhis(ng), (/0/), (/0/), &
204 & ncid = ncid)
205 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
206
207 CALL netcdf_put_ivar (ng, model, ncname, 'ndefHIS', &
208 & ndefhis(ng), (/0/), (/0/), &
209 & ncid = ncid)
210 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
211
212#ifdef GRID_EXTRACT
213 CALL netcdf_put_ivar (ng, model, ncname, 'nXTR', &
214 & nxtr(ng), (/0/), (/0/), &
215 & ncid = ncid)
216 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
217
218 CALL netcdf_put_ivar (ng, model, ncname, 'ndefXTR', &
219 & ndefxtr(ng), (/0/), (/0/), &
220 & ncid = ncid)
221 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
222
223 CALL netcdf_put_ivar (ng, model, ncname, 'ExtractFlag', &
224 & extractflag(ng), (/0/), (/0/), &
225 & ncid = ncid)
226 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
227#endif
228
229 CALL netcdf_put_ivar (ng, model, ncname, 'nRST', &
230 & nrst(ng), (/0/), (/0/), &
231 & ncid = ncid)
232 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
233
234#if defined AVERAGES || \
235 (defined ad_averages && defined adjoint) || \
236 (defined rp_averages && defined tl_ioms) || \
237 (defined tl_averages && defined tangent)
238 CALL netcdf_put_ivar (ng, model, ncname, 'ntsAVG', &
239 & ntsavg(ng), (/0/), (/0/), &
240 & ncid = ncid)
241 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
242
243 CALL netcdf_put_ivar (ng, model, ncname, 'nAVG', &
244 & navg(ng), (/0/), (/0/), &
245 & ncid = ncid)
246 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
247
248 CALL netcdf_put_ivar (ng, model, ncname, 'ndefAVG', &
249 & ndefavg(ng), (/0/), (/0/), &
250 & ncid = ncid)
251 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
252#endif
253
254#ifdef ADJOINT
255 CALL netcdf_put_ivar (ng, model, ncname, 'nADJ', &
256 & nadj(ng), (/0/), (/0/), &
257 & ncid = ncid)
258 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
259
260 CALL netcdf_put_ivar (ng, model, ncname, 'ndefADJ', &
261 & ndefadj(ng), (/0/), (/0/), &
262 & ncid = ncid)
263 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
264#endif
265
266#ifdef TANGENT
267 CALL netcdf_put_ivar (ng, model, ncname, 'nTLM', &
268 & ntlm(ng), (/0/), (/0/), &
269 & ncid = ncid)
270 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
271
272 CALL netcdf_put_ivar (ng, model, ncname, 'ndefTLM', &
273 & ndeftlm(ng), (/0/), (/0/), &
274 & ncid = ncid)
275 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
276#endif
277
278#ifdef ADJUST_BOUNDARY
279 CALL netcdf_put_ivar (ng, model, ncname, 'nOBC', &
280 & nobc(ng), (/0/), (/0/), &
281 & ncid = ncid)
282 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
283#endif
284
285#if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
286 CALL netcdf_put_ivar (ng, model, ncname, 'nSFF', &
287 & nsff(ng), (/0/), (/0/), &
288 & ncid = ncid)
289 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
290#endif
291
292#ifdef PROPAGATOR
293 CALL netcdf_put_lvar (ng, model, ncname, 'LmultiGST', &
294 & lmultigst, (/0/), (/0/), &
295 & ncid = ncid)
296 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
297
298 CALL netcdf_put_lvar (ng, model, ncname, 'LrstGST', &
299 & lrstgst, (/0/), (/0/), &
300 & ncid = ncid)
301 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
302
303 CALL netcdf_put_ivar (ng, model, ncname, 'MaxIterGST', &
304 & maxitergst, (/0/), (/0/), &
305 & ncid = ncid)
306 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
307
308 CALL netcdf_put_ivar (ng, model, ncname, 'nGST', &
309 & ngst, (/0/), (/0/), &
310 & ncid = ncid)
311 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
312
313 CALL netcdf_put_ivar (ng, model, ncname, 'NEV', &
314 & nev, (/0/), (/0/), &
315 & ncid = ncid)
316 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
317
318 CALL netcdf_put_ivar (ng, model, ncname, 'NCV', &
319 & ncv, (/0/), (/0/), &
320 & ncid = ncid)
321 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
322
323 CALL netcdf_put_fvar (ng, model, ncname, 'Ritz_tol', &
324 & ritz_tol, (/0/), (/0/), &
325 & ncid = ncid)
326 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
327#endif
328
329#ifdef DIAGNOSTICS
330 CALL netcdf_put_ivar (ng, model, ncname, 'ntsDIA', &
331 & ntsdia(ng), (/0/), (/0/), &
332 & ncid = ncid)
333 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
334
335 CALL netcdf_put_ivar (ng, model, ncname, 'nDIA', &
336 & ndia(ng), (/0/), (/0/), &
337 & ncid = ncid)
338 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
339
340 CALL netcdf_put_ivar (ng, model, ncname, 'ndefDIA', &
341 & ndefdia(ng), (/0/), (/0/), &
342 & ncid = ncid)
343 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
344#endif
345
346#ifdef STATIONS
347 CALL netcdf_put_ivar (ng, model, ncname, 'nSTA', &
348 & nsta(ng), (/0/), (/0/), &
349 & ncid = ncid)
350 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
351#endif
352
353#ifdef FOUR_DVAR
354 CALL netcdf_put_ivar (ng, model, ncname, 'Nouter', &
355 & nouter, (/0/), (/0/), &
356 & ncid = ncid)
357 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
358
359 CALL netcdf_put_ivar (ng, model, ncname, 'Ninner', &
360 & ninner, (/0/), (/0/), &
361 & ncid = ncid)
362 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
363#endif
364
365#if defined POWER_LAW && defined SOLVE3D
366!
367! Power-law shape filter parameters for time-averaging of barotropic
368! fields.
369!
370 CALL netcdf_put_fvar (ng, model, ncname, 'Falpha', &
371 & falpha, (/0/), (/0/), &
372 & ncid = ncid)
373 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
374
375 CALL netcdf_put_fvar (ng, model, ncname, 'Fbeta', &
376 & fbeta, (/0/), (/0/), &
377 & ncid = ncid)
378 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
379
380 CALL netcdf_put_fvar (ng, model, ncname, 'Fgamma', &
381 & fgamma, (/0/), (/0/), &
382 & ncid = ncid)
383 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
384#endif
385!
386! Horizontal mixing coefficients.
387!
388#if defined SOLVE3D && defined TS_DIF2
389 CALL netcdf_put_fvar (ng, model, ncname, 'nl_tnu2', &
390 & nl_tnu2(:,ng), (/1/), (/nt(ng)/), &
391 & ncid = ncid)
392 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
393
394# ifdef ADJOINT
395 CALL netcdf_put_fvar (ng, model, ncname, 'ad_tnu2', &
396 & ad_tnu2(:,ng), (/1/), (/nt(ng)/), &
397 & ncid = ncid)
398 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
399# endif
400
401# if defined TANGENT || defined TL_IOMS
402 CALL netcdf_put_fvar (ng, model, ncname, 'tl_tnu2', &
403 & tl_tnu2(:,ng), (/1/), (/nt(ng)/), &
404 & ncid = ncid)
405 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
406# endif
407
408#endif
409
410#if defined SOLVE3D && defined TS_DIF4
411 DO itrc=1,nt(ng)
412 diff(itrc)=nl_tnu4(itrc,ng)*nl_tnu4(itrc,ng)
413 END DO
414 CALL netcdf_put_fvar (ng, model, ncname, 'nl_tnu4', &
415 & diff, (/1/), (/nt(ng)/), &
416 & ncid = ncid)
417 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
418
419# ifdef ADJOINT
420 DO itrc=1,nt(ng)
421 diff(itrc)=ad_tnu4(itrc,ng)*ad_tnu4(itrc,ng)
422 END DO
423 CALL netcdf_put_fvar (ng, model, ncname, 'ad_tnu4', &
424 & diff, (/1/), (/nt(ng)/), &
425 & ncid = ncid)
426 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
427# endif
428
429# if defined TANGENT || defined TL_IOMS
430 DO itrc=1,nt(ng)
431 diff(itrc)=tl_tnu4(itrc,ng)*tl_tnu4(itrc,ng)
432 END DO
433 CALL netcdf_put_fvar (ng, model, ncname, 'tl_tnu4', &
434 & diff, (/1/), (/nt(ng)/), &
435 & ncid = ncid)
436 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
437# endif
438#endif
439
440#ifdef UV_VIS2
441 CALL netcdf_put_fvar (ng, model, ncname, 'nl_visc2', &
442 & nl_visc2(ng), (/0/), (/0/), &
443 & ncid = ncid)
444 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
445
446# ifdef ADJOINT
447 CALL netcdf_put_fvar (ng, model, ncname, 'ad_visc2', &
448 & ad_visc2(ng), (/0/), (/0/), &
449 & ncid = ncid)
450 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
451# endif
452
453# if defined TANGENT || defined TL_IOMS
454 CALL netcdf_put_fvar (ng, model, ncname, 'tl_visc2', &
455 & tl_visc2(ng), (/0/), (/0/), &
456 & ncid = ncid)
457 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
458# endif
459#endif
460
461#ifdef UV_VIS4
462 CALL netcdf_put_fvar (ng, model, ncname, 'nl_visc4', &
463 & nl_visc4(ng)**2, (/0/), (/0/), &
464 & ncid = ncid)
465 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
466
467# ifdef ADJOINT
468 CALL netcdf_put_fvar (ng, model, ncname, 'ad_visc4', &
469 & ad_visc4(ng)**2, (/0/), (/0/), &
470 & ncid = ncid)
471 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
472# endif
473
474# if defined TANGENT || defined TL_IOMS
475 CALL netcdf_put_fvar (ng, model, ncname, 'tl_visc4', &
476 & tl_visc4(ng)**2, (/0/), (/0/), &
477 & ncid = ncid)
478 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
479# endif
480#endif
481
482#if defined SOLVE3D && (defined MY25_MIXING || defined GLS_MIXING)
483# ifdef TKE_DIF2
484 CALL netcdf_put_fvar (ng, model, ncname, 'tkenu2', &
485 & tkenu2(ng), (/0/), (/0/), &
486 & ncid = ncid)
487 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
488# endif
489
490# ifdef TKE_DIF4
491 CALL netcdf_put_fvar (ng, model, ncname, 'tkenu4', &
492 & tkenu4(ng)**2, (/0/), (/0/), &
493 & ncid = ncid)
494 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
495# endif
496#endif
497
498#if defined UV_VIS2 || defined UV_VIS4
499 CALL netcdf_put_lvar (ng, model, ncname, 'LuvSponge', &
500 & luvsponge(ng), (/0/), (/0/), &
501 & ncid = ncid)
502 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
503#endif
504
505#if (defined TS_DIF2 || defined TS_DIF4) && defined SOLVE3D
506 CALL netcdf_put_lvar (ng, model, ncname, 'LtracerSponge', &
507 & ltracersponge(:,ng), (/1/), (/nt(ng)/), &
508 & ncid = ncid)
509 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
510#endif
511
512#ifdef SOLVE3D
513!
514! Background vertical mixing coefficients.
515!
516 CALL netcdf_put_fvar (ng, model, ncname, 'Akt_bak', &
517 & akt_bak(:,ng), (/1/), (/nt(ng)/), &
518 & ncid = ncid)
519 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
520
521 CALL netcdf_put_fvar (ng, model, ncname, 'Akv_bak', &
522 & akv_bak(ng), (/0/), (/0/), &
523 & ncid = ncid)
524 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
525
526# if defined MY25_MIXING || defined GLS_MIXING
527 CALL netcdf_put_fvar (ng, model, ncname, 'Akk_bak', &
528 & akk_bak(ng), (/0/), (/0/), &
529 & ncid = ncid)
530 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
531
532 CALL netcdf_put_fvar (ng, model, ncname, 'Akp_bak', &
533 & akp_bak(ng), (/0/), (/0/), &
534 & ncid = ncid)
535 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
536# endif
537
538# ifdef FORWARD_MIXING
539!
540! Basic state vertical mixing scale used in adjoint-based applications.
541!
542# ifdef ADJOINT
543 CALL netcdf_put_fvar (ng, model, ncname, 'ad_Akt_fac', &
544 & ad_akt_fac(:,ng), (/1/), (/nt(ng)/), &
545 & ncid = ncid)
546 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
547# endif
548
549# if defined TANGENT || defined TL_IOMS
550 CALL netcdf_put_fvar (ng, model, ncname, 'tl_Akt_fac', &
551 & tl_akt_fac(:,ng), (/1/), (/nt(ng)/), &
552 & ncid = ncid)
553 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
554# endif
555
556# ifdef ADJOINT
557 CALL netcdf_put_fvar (ng, model, ncname, 'ad_Akv_fac', &
558 & ad_akv_fac(ng), (/0/), (/0/), &
559 & ncid = ncid)
560 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
561# endif
562
563# if defined TANGENT || defined TL_IOMS
564 CALL netcdf_put_fvar (ng, model, ncname, 'tl_Akv_fac', &
565 & tl_akv_fac(ng), (/0/), (/0/), &
566 & ncid = ncid)
567 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
568# endif
569# endif
570#endif
571!
572! Drag coefficients.
573!
574 CALL netcdf_put_fvar (ng, model, ncname, 'rdrg', &
575 & rdrg(ng), (/0/), (/0/), &
576 & ncid = ncid)
577 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
578
579 CALL netcdf_put_fvar (ng, model, ncname, 'rdrg2', &
580 & rdrg2(ng), (/0/), (/0/), &
581 & ncid = ncid)
582 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
583
584#ifdef SOLVE3D
585 CALL netcdf_put_fvar (ng, model, ncname, 'Zob', &
586 & zob(ng), (/0/), (/0/), &
587 & ncid = ncid)
588 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
589
590 CALL netcdf_put_fvar (ng, model, ncname, 'Zos', &
591 & zos(ng), (/0/), (/0/), &
592 & ncid = ncid)
593 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
594#endif
595
596#if defined SOLVE3D && defined GLS_MIXING
597!
598! Generic length-scale parameters.
599!
600 CALL netcdf_put_fvar (ng, model, ncname, 'gls_p', &
601 & gls_p(ng), (/0/), (/0/), &
602 & ncid = ncid)
603 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
604
605 CALL netcdf_put_fvar (ng, model, ncname, 'gls_m', &
606 & gls_m(ng), (/0/), (/0/), &
607 & ncid = ncid)
608 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
609
610 CALL netcdf_put_fvar (ng, model, ncname, 'gls_n', &
611 & gls_n(ng), (/0/), (/0/), &
612 & ncid = ncid)
613 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
614
615 CALL netcdf_put_fvar (ng, model, ncname, 'gls_cmu0', &
616 & gls_cmu0(ng), (/0/), (/0/), &
617 & ncid = ncid)
618 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
619
620 CALL netcdf_put_fvar (ng, model, ncname, 'gls_c1', &
621 & gls_c1(ng), (/0/), (/0/), &
622 & ncid = ncid)
623 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
624
625 CALL netcdf_put_fvar (ng, model, ncname, 'gls_c2', &
626 & gls_c2(ng), (/0/), (/0/), &
627 & ncid = ncid)
628 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
629
630 CALL netcdf_put_fvar (ng, model, ncname, 'gls_c3m', &
631 & gls_c3m(ng), (/0/), (/0/), &
632 & ncid = ncid)
633 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
634
635 CALL netcdf_put_fvar (ng, model, ncname, 'gls_c3p', &
636 & gls_c3p(ng), (/0/), (/0/), &
637 & ncid = ncid)
638 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
639
640 CALL netcdf_put_fvar (ng, model, ncname, 'gls_sigk', &
641 & gls_sigk(ng), (/0/), (/0/), &
642 & ncid = ncid)
643 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
644
645 CALL netcdf_put_fvar (ng, model, ncname, 'gls_sigp', &
646 & gls_sigp(ng), (/0/), (/0/), &
647 & ncid = ncid)
648 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
649
650 CALL netcdf_put_fvar (ng, model, ncname, 'gls_Kmin', &
651 & gls_kmin(ng), (/0/), (/0/), &
652 & ncid = ncid)
653 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
654
655 CALL netcdf_put_fvar (ng, model, ncname, 'gls_Pmin', &
656 & gls_pmin(ng), (/0/), (/0/), &
657 & ncid = ncid)
658 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
659
660 CALL netcdf_put_fvar (ng, model, ncname, 'Charnok_alpha', &
661 & charnok_alpha(ng), (/0/), (/0/), &
662 & ncid = ncid)
663 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
664
665 CALL netcdf_put_fvar (ng, model, ncname, 'Zos_hsig_alpha', &
666 & zos_hsig_alpha(ng), (/0/), (/0/), &
667 & ncid = ncid)
668 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
669
670 CALL netcdf_put_fvar (ng, model, ncname, 'sz_alpha', &
671 & sz_alpha(ng), (/0/), (/0/), &
672 & ncid = ncid)
673 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
674
675 CALL netcdf_put_fvar (ng, model, ncname, 'CrgBan_cw', &
676 & crgban_cw(ng), (/0/), (/0/), &
677 & ncid = ncid)
678 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
679#endif
680#ifdef WEC
681 CALL netcdf_put_fvar (ng, model, ncname, 'wec_alpha', &
682 & wec_alpha(ng), (/0/), (/0/), &
683 & ncid = ncid)
684 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
685#endif
686!
687! Nudging inverse time scales used in various tasks.
688!
689 CALL netcdf_put_fvar (ng, model, ncname, 'Znudg', &
690 & znudg(ng)/sec2day, (/0/), (/0/), &
691 & ncid = ncid)
692 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
693
694 CALL netcdf_put_fvar (ng, model, ncname, 'M2nudg', &
695 & m2nudg(ng)/sec2day, (/0/), (/0/), &
696 & ncid = ncid)
697 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
698
699#ifdef SOLVE3D
700 CALL netcdf_put_fvar (ng, model, ncname, 'M3nudg', &
701 & m3nudg(ng)/sec2day, (/0/), (/0/), &
702 & ncid = ncid)
703 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
704
705 DO itrc=1,nt(ng)
706 nudg(itrc)=tnudg(itrc,ng)/sec2day
707 END DO
708 CALL netcdf_put_fvar (ng, model, ncname, 'Tnudg', &
709 & nudg, (/1/), (/nt(ng)/), &
710 & ncid = ncid)
711 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
712#endif
713
714#ifndef DEBUGGING
715!
716! Open boundary nudging, inverse time scales.
717!
718 IF (nudgingcoeff(ng)) THEN
719 CALL netcdf_put_fvar (ng, model, ncname, 'FSobc_in', &
720 & fsobc_in(ng,:), (/1/), (/4/), &
721 & ncid = ncid)
722 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
723
724 CALL netcdf_put_fvar (ng, model, ncname, 'FSobc_out', &
725 & fsobc_out(ng,:), (/1/), (/4/), &
726 & ncid = ncid)
727 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
728
729 CALL netcdf_put_fvar (ng, model, ncname, 'M2obc_in', &
730 & m2obc_in(ng,:), (/1/), (/4/), &
731 & ncid = ncid)
732 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
733
734 CALL netcdf_put_fvar (ng, model, ncname, 'M2obc_out', &
735 & m2obc_out(ng,:), (/1/), (/4/), &
736 & ncid = ncid)
737 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
738
739# ifdef SOLVE3D
740 DO ibry=1,4
741 DO itrc=1,nt(ng)
742 tobc(itrc,ibry)=tobc_in(itrc,ng,ibry)
743 END DO
744 END DO
745 CALL netcdf_put_fvar (ng, model, ncname, 'Tobc_in', &
746 & tobc, (/1,1/), (/nt(ng),4/), &
747 & ncid = ncid)
748 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
749
750 DO ibry=1,4
751 DO itrc=1,nt(ng)
752 tobc(itrc,ibry)=tobc_out(itrc,ng,ibry)
753 END DO
754 END DO
755 CALL netcdf_put_fvar (ng, model, ncname, 'Tobc_out', &
756 & tobc, (/1,1/), (/nt(ng),4/), &
757 & ncid = ncid)
758 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
759
760 CALL netcdf_put_fvar (ng, model, ncname, 'M3obc_in', &
761 & m3obc_in(ng,:), (/1/), (/4/), &
762 & ncid = ncid)
763 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
764
765 CALL netcdf_put_fvar (ng, model, ncname, 'M3obc_out', &
766 & m3obc_out(ng,:), (/1/), (/4/), &
767 & ncid = ncid)
768 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
769# endif
770 END IF
771#endif
772!
773! Equation of State parameters.
774!
775 CALL netcdf_put_fvar (ng, model, ncname, 'rho0', &
776 & rho0, (/0/), (/0/), &
777 & ncid = ncid)
778 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
779
780#if defined SOLVE3D && defined PROPAGATOR
781 CALL netcdf_put_fvar (ng, model, ncname, 'bvf_bak', &
782 & bvf_bak, (/0/), (/0/), &
783 & ncid = ncid)
784 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
785#endif
786
787#if defined SOLVE3D && \
788 (!defined NONLIN_EOS || defined FOUR_DVAR || defined PROPAGATOR)
789 CALL netcdf_put_fvar (ng, model, ncname, 'R0', &
790 & r0(ng), (/0/), (/0/), &
791 & ncid = ncid)
792 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
793
794 CALL netcdf_put_fvar (ng, model, ncname, 'Tcoef', &
795 & tcoef(ng), (/0/), (/0/), &
796 & ncid = ncid)
797 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
798
799 CALL netcdf_put_fvar (ng, model, ncname, 'Scoef', &
800 & scoef(ng), (/0/), (/0/), &
801 & ncid = ncid)
802 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
803#endif
804#ifdef SOLVE3D
805# ifdef BODYFORCE
806!
807! Body force parameters.
808!
809 CALL netcdf_put_ivar (ng, model, ncname, 'levsfrc', &
810 & levsfrc(ng), (/0/), (/0/), &
811 & ncid = ncid)
812 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
813
814 CALL netcdf_put_ivar (ng, model, ncname, 'levbfrc', &
815 & levbfrc(ng), (/0/), (/0/), &
816 & ncid = ncid)
817 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
818# endif
819#endif
820!
821! Slipperiness parameters.
822!
823 CALL netcdf_put_fvar (ng, model, ncname, 'gamma2', &
824 & gamma2(ng), (/0/), (/0/), &
825 & ncid = ncid)
826 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
827!
828! Logical switches to activate horizontal momentum transport
829! point Sources/Sinks (like river runoff transport) and mass point
830! Sources/Sinks (like volume vertical influx).
831!
832 CALL netcdf_put_lvar (ng, model, ncname, 'LuvSrc', &
833 & luvsrc(ng), (/0/), (/0/), &
834 & ncid = ncid)
835 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
836
837 CALL netcdf_put_lvar (ng, model, ncname, 'LwSrc', &
838 & lwsrc(ng), (/0/), (/0/), &
839 & ncid = ncid)
840 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
841
842#ifdef SOLVE3D
843!
844! Logical switches to activate tracer point Sources/Sinks.
845!
846 CALL netcdf_put_lvar (ng, model, ncname, 'LtracerSrc', &
847 & ltracersrc(:,ng), (/1/), (/nt(ng)/), &
848 & ncid = ncid)
849 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
850#endif
851!
852! Logical switches to process climatology fields.
853!
854 CALL netcdf_put_lvar (ng, model, ncname, 'LsshCLM', &
855 & lsshclm(ng), (/0/), (/0/), &
856 & ncid = ncid)
857 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
858
859 CALL netcdf_put_lvar (ng, model, ncname, 'Lm2CLM', &
860 & lm2clm(ng), (/0/), (/0/), &
861 & ncid = ncid)
862 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
863
864#ifdef SOLVE3D
865 CALL netcdf_put_lvar (ng, model, ncname, 'Lm3CLM', &
866 & lm3clm(ng), (/0/), (/0/), &
867 & ncid = ncid)
868 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
869
870 CALL netcdf_put_lvar (ng, model, ncname, 'LtracerCLM', &
871 & ltracerclm(:,ng), (/1/), (/nt(ng)/), &
872 & ncid = ncid)
873 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
874#endif
875!
876! Logical switches for nudging climatology fields.
877!
878 CALL netcdf_put_lvar (ng, model, ncname, 'LnudgeM2CLM', &
879 & lnudgem2clm(ng), (/0/), (/0/), &
880 & ncid = ncid)
881 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
882
883#ifdef SOLVE3D
884 CALL netcdf_put_lvar (ng, model, ncname, 'LnudgeM3CLM', &
885 & lnudgem3clm(ng), (/0/), (/0/), &
886 & ncid = ncid)
887 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
888
889 CALL netcdf_put_lvar (ng, model, ncname, 'LnudgeTCLM', &
890 & lnudgetclm(:,ng), (/1/), (/nt(ng)/), &
891 & ncid = ncid)
892 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
893#endif
894
895#ifdef FOUR_DVAR
896!
897! 4DVAR assimilation parameters.
898!
899# ifdef ADJUST_STFLUX
900 CALL netcdf_put_lvar (ng, model, ncname, 'Lstflux', &
901 & lstflux(:,ng), (/1/), (/nt(ng)/), &
902 & ncid = ncid)
903 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
904# endif
905# ifdef ADJUST_BOUNDARY
906 CALL netcdf_put_lvar (ng, model, ncname, 'Lobc', &
907 & lobc(:,:,ng), (/1,1/), (/4,nstatevar(ng)/), &
908 & ncid = ncid)
909 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
910# endif
911# ifndef I4DVAR_ANA_SENSITIVITY
912 CALL netcdf_put_lvar (ng, model, ncname, 'LhessianEV', &
913 & lhessianev, (/0/), (/0/), &
914 & ncid = ncid)
915 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
916
917# ifdef WEAK_CONSTRAINT
918 CALL netcdf_put_lvar (ng, model, ncname, 'LhotStart', &
919 & lhotstart, (/0/), (/0/), &
920 & ncid = ncid)
921 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
922# endif
923
924 CALL netcdf_put_lvar (ng, model, ncname, 'Lprecond', &
925 & lprecond, (/0/), (/0/), &
926 & ncid = ncid)
927 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
928
929 CALL netcdf_put_lvar (ng, model, ncname, 'Lritz', &
930 & lritz, (/0/), (/0/), &
931 & ncid = ncid)
932 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
933
934# ifdef WEAK_CONSTRAINT
935 IF (lprecond.and.(nritzev.gt.0)) THEN
936 CALL netcdf_put_ivar (ng, model, ncname, 'NritzEV', &
937 & nritzev, (/0/), (/0/), &
938 & ncid = ncid)
939 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
940 END IF
941# endif
942# endif
943# if defined POSTERIOR_EOFS && defined WEAK_CONSTRAINT
944 CALL netcdf_put_ivar (ng, model, ncname, 'NpostI', &
945 & nposti, (/0/), (/0/), &
946 & ncid = ncid)
947# endif
948# if defined ARRAY_MODES || \
949 defined i4dvar_ana_sensitivity || \
950 defined rbl4dvar_ana_sensitivity || \
951 defined rbl4dvar_fct_sensitivity || \
952 defined r4dvar_ana_sensitivity
953 CALL netcdf_put_ivar (ng, model, ncname, 'Nimpact', &
954 & nimpact, (/0/), (/0/), &
955 & ncid = ncid)
956# endif
957# ifndef I4DVAR_ANA_SENSITIVITY
958 CALL netcdf_put_fvar (ng, model, ncname, 'GradErr', &
959 & graderr, (/0/), (/0/), &
960 & ncid = ncid)
961 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
962
963 CALL netcdf_put_fvar (ng, model, ncname, 'HevecErr', &
964 & hevecerr, (/0/), (/0/), &
965 & ncid = ncid)
966 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
967# endif
968
969 CALL netcdf_put_ivar (ng, model, ncname, 'Nmethod', &
970 & nmethod(ng), (/0/), (/0/), &
971 & ncid = ncid)
972 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
973
974 CALL netcdf_put_ivar (ng, model, ncname, 'Rscheme', &
975 & rscheme(ng), (/0/), (/0/), &
976 & ncid = ncid)
977 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
978
979 CALL netcdf_put_ivar (ng, model, ncname, 'Nrandom', &
980 & nrandom, (/0/), (/0/), &
981 & ncid = ncid)
982 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
983
984 CALL netcdf_put_fvar (ng, model, ncname, 'Hgamma', &
985 & hgamma(1), (/0/), (/0/), &
986 & ncid = ncid)
987 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
988
989# ifdef WEAK_CONSTRAINT
990 CALL netcdf_put_fvar (ng, model, ncname, 'HgammaM', &
991 & hgamma(2), (/0/), (/0/), &
992 & ncid = ncid)
993 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
994# endif
995
996# ifdef ADJUST_BOUNDARY
997 CALL netcdf_put_fvar (ng, model, ncname, 'HgammaB', &
998 & hgamma(3), (/0/), (/0/), &
999 & ncid = ncid)
1000 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1001# endif
1002
1003# ifdef ADJUST_STFLUX
1004 CALL netcdf_put_fvar (ng, model, ncname, 'HgammaF', &
1005 & hgamma(4), (/0/), (/0/), &
1006 & ncid = ncid)
1007 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1008# endif
1009
1010# ifdef SOLVE3D
1011 CALL netcdf_put_fvar (ng, model, ncname, 'Vgamma', &
1012 & vgamma(1), (/0/), (/0/), &
1013 & ncid = ncid)
1014 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1015
1016# ifdef WEAK_CONSTRAINT
1017 CALL netcdf_put_fvar (ng, model, ncname, 'VgammaM', &
1018 & vgamma(2), (/0/), (/0/), &
1019 & ncid = ncid)
1020 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1021# endif
1022
1023# ifdef ADJUST_BOUNDARY
1024 CALL netcdf_put_fvar (ng, model, ncname, 'VgammaB', &
1025 & vgamma(3), (/0/), (/0/), &
1026 & ncid = ncid)
1027 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1028# endif
1029# endif
1030
1031 CALL netcdf_put_fvar (ng, model, ncname, 'Hdecay', &
1032 & hdecay(1,:,ng), (/1/), (/nstatevar(ng)/), &
1033 & ncid = ncid)
1034 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1035
1036# ifdef SOLVE3D
1037 CALL netcdf_put_fvar (ng, model, ncname, 'Vdecay', &
1038 & vdecay(1,:,ng), (/1/), (/nstatevar(ng)/), &
1039 & ncid = ncid)
1040 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1041# endif
1042
1043 IF (nsa.eq.2) THEN
1044 CALL netcdf_put_fvar (ng, model, ncname, 'HdecayM', &
1045 & hdecay(2,:,ng), (/1/), (/nstatevar(ng)/), &
1046 & ncid = ncid)
1047 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1048
1049# ifdef SOLVE3D
1050 CALL netcdf_put_fvar (ng, model, ncname, 'VdecayM', &
1051 & vdecay(2,:,ng), (/1/), (/nstatevar(ng)/), &
1052 & ncid = ncid)
1053 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1054# endif
1055 END IF
1056
1057# ifdef ADJUST_BOUNDARY
1058 CALL netcdf_put_fvar (ng, model, ncname, 'HdecayB', &
1059 & hdecayb(:,:,ng), &
1060 & (/1,1/), (/nstatevar(ng),4/), &
1061 & ncid = ncid)
1062 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1063
1064# ifdef SOLVE3D
1065 CALL netcdf_put_fvar (ng, model, ncname, 'VdecayB', &
1066 & vdecayb(:,:,ng), &
1067 & (/1,1/), (/nstatevar(ng),4/), &
1068 & ncid = ncid)
1069 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1070# endif
1071# endif
1072
1073# ifdef RPM_RELAXATION
1074 CALL netcdf_put_fvar (ng, model, ncname, 'tl_M2diff', &
1075 & tl_m2diff(ng), (/0/), (/0/), &
1076 & ncid = ncid)
1077 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1078
1079# ifdef SOLVE3D
1080 CALL netcdf_put_fvar (ng, model, ncname, 'tl_M3diff', &
1081 & tl_m3diff(ng), (/0/), (/0/), &
1082 & ncid = ncid)
1083 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1084
1085 CALL netcdf_put_fvar (ng, model, ncname, 'tl_Tdiff', &
1086 & tl_tdiff(:,ng), (/1/), (/nt(ng)/), &
1087 & ncid = ncid)
1088 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1089# endif
1090# endif
1091
1092# ifdef BALANCE_OPERATOR
1093# ifdef ZETA_ELLIPTIC
1094 CALL netcdf_put_ivar (ng, model, ncname, 'Nbico', &
1095 & nbico(ng), (/0/), (/0/), &
1096 & ncid = ncid)
1097# endif
1098
1099 CALL netcdf_put_lvar (ng, model, ncname, 'Lbalance', &
1100 & balance, (/1/), (/nstatevar(ng)/), &
1101 & ncid = ncid)
1102 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1103
1104 CALL netcdf_put_ivar (ng, model, ncname, 'LNM_flag', &
1105 & lnm_flag, (/0/), (/0/), &
1106 & ncid = ncid)
1107 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1108
1109 CALL netcdf_put_fvar (ng, model, ncname, 'LNM_depth', &
1110 & lnm_depth(ng), (/0/), (/0/), &
1111 & ncid = ncid)
1112 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1113
1114 CALL netcdf_put_fvar (ng, model, ncname, 'dTdz_min', &
1115 & dtdz_min(ng), (/0/), (/0/), &
1116 & ncid = ncid)
1117 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1118
1119 CALL netcdf_put_fvar (ng, model, ncname, 'ml_depth', &
1120 & ml_depth(ng), (/0/), (/0/), &
1121 & ncid = ncid)
1122 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1123# endif
1124
1125# ifdef STD_MODEL
1126!
1127! Background error covariance standard deviation modeling parameters.
1128!
1129 CALL netcdf_put_fvar (ng, model, ncname, 'Sigma_max', &
1130 & sigma_max(:,ng), (/1/), (/nstatevar(ng)/), &
1131 & ncid = ncid)
1132 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1133
1134 CALL netcdf_put_fvar (ng, model, ncname, 'Sigma_ml', &
1135 & sigma_ml(:,ng), (/1/), (/nstatevar(ng)/), &
1136 & ncid = ncid)
1137 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1138
1139 CALL netcdf_put_fvar (ng, model, ncname, 'Sigma_do', &
1140 & sigma_do(:,ng), (/1/), (/nstatevar(ng)/), &
1141 & ncid = ncid)
1142 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1143
1144 CALL netcdf_put_fvar (ng, model, ncname, 'Sigma_dz', &
1145 & sigma_dz(:,ng), (/1/), (/nstatevar(ng)/), &
1146 & ncid = ncid)
1147 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1148
1149# ifndef COMPUTE_MLD
1150 CALL netcdf_put_fvar (ng, model, ncname, 'mld_uniform', &
1151 & mld_uniform(ng), (/0/), (/0/), &
1152 & ncid = ncid)
1153 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1154# endif
1155# endif
1156#endif
1157
1158#if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
1159 defined opt_observations || defined sensitivity_4dvar || \
1160 defined so_semi
1161!
1162! Adjoint sensitivity parameters.
1163!
1164 CALL netcdf_put_lvar (ng, model, ncname, 'Lzeta', &
1165 & scalars(ng)%Lstate(isfsur), &
1166 & (/0/), (/0/), &
1167 & ncid = ncid)
1168 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1169
1170 CALL netcdf_put_lvar (ng, model, ncname, 'Lubar', &
1171 & scalars(ng)%Lstate(isubar), &
1172 & (/0/), (/0/), &
1173 & ncid = ncid)
1174 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1175
1176 CALL netcdf_put_lvar (ng, model, ncname, 'Lvbar', &
1177 & scalars(ng)%Lstate(isvbar), &
1178 & (/0/), (/0/), &
1179 & ncid = ncid)
1180 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1181
1182# ifdef SOLVE3D
1183 CALL netcdf_put_lvar (ng, model, ncname, 'Luvel', &
1184 & scalars(ng)%Lstate(isuvel), &
1185 & (/0/), (/0/), &
1186 & ncid = ncid)
1187 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1188
1189 CALL netcdf_put_lvar (ng, model, ncname, 'Lvvel', &
1190 & scalars(ng)%Lstate(isvvel), &
1191 & (/0/), (/0/), &
1192 & ncid = ncid)
1193 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1194
1195 CALL netcdf_put_lvar (ng, model, ncname, 'Ltracer', &
1196 & scalars(ng)%Lstate(istvar(:)), &
1197 & (/1/), (/nt(ng)/), &
1198 & ncid = ncid)
1199 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1200
1201 CALL netcdf_put_ivar (ng, model, ncname, 'KstrS', &
1202 & kstrs(ng), (/0/), (/0/), &
1203 & ncid = ncid)
1204 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1205
1206 CALL netcdf_put_ivar (ng, model, ncname, 'KendS', &
1207 & kends(ng), (/0/), (/0/), &
1208 & ncid = ncid)
1209 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1210# endif
1211#endif
1212
1213#if defined FORCING_SV || defined SO_SEMI || defined STOCHASTIC_OPT
1214!
1215! Singular Forcing Vectors or Stochastic Optimals state switches.
1216!
1217 CALL netcdf_put_lvar (ng, model, ncname, 'Fzeta', &
1218 & scalars(ng)%Fstate(isfsur), &
1219 & (/0/), (/0/), &
1220 & ncid = ncid)
1221 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1222
1223# ifndef SOLVE3D
1224 CALL netcdf_put_lvar (ng, model, ncname, 'Fubar', &
1225 & scalars(ng)%Fstate(isubar), &
1226 & (/0/), (/0/), &
1227 & ncid = ncid)
1228 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1229
1230 CALL netcdf_put_lvar (ng, model, ncname, 'Fvbar', &
1231 & scalars(ng)%Fstate(isvbar), &
1232 & (/0/), (/0/), &
1233 & ncid = ncid)
1234 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1235
1236# else
1237
1238 CALL netcdf_put_lvar (ng, model, ncname, 'Fuvel', &
1239 & scalars(ng)%Fstate(isuvel), &
1240 & (/0/), (/0/), &
1241 & ncid = ncid)
1242 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1243
1244 CALL netcdf_put_lvar (ng, model, ncname, 'Fvvel', &
1245 & scalars(ng)%Fstate(isvvel), &
1246 & (/0/), (/0/), &
1247 & ncid = ncid)
1248 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1249
1250 CALL netcdf_put_lvar (ng, model, ncname, 'Ftracer', &
1251 & scalars(ng)%Fstate(istvar(:)), &
1252 & (/1/), (/nt(ng)/), &
1253 & ncid = ncid)
1254 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1255# endif
1256
1257 CALL netcdf_put_lvar (ng, model, ncname, 'Fsustr', &
1258 & scalars(ng)%Fstate(isustr), &
1259 & (/0/), (/0/), &
1260 & ncid = ncid)
1261 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1262
1263 CALL netcdf_put_lvar (ng, model, ncname, 'Fsvstr', &
1264 & scalars(ng)%Fstate(isvstr), &
1265 & (/0/), (/0/), &
1266 & ncid = ncid)
1267 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1268
1269# ifdef SOLVE3D
1270 CALL netcdf_put_lvar (ng, model, ncname, 'Fstflx', &
1271 & scalars(ng)%Fstate(istsur(:)), &
1272 & (/1/), (/nt(ng)/), &
1273 & ncid = ncid)
1274 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1275# endif
1276#endif
1277
1278#ifdef SO_SEMI
1279# ifndef SO_SEMI_WHITE
1280 CALL netcdf_put_fvar (ng, model, ncname, 'SO_decay', &
1281 & so_decay(ng), (/0/), (/0/), &
1282 & ncid = ncid)
1283 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1284# endif
1285
1286 CALL netcdf_put_fvar (ng, model, ncname, 'SO_trace', &
1287 & trnorm(ng), (/0/), (/0/), &
1288 & ncid = ncid)
1289 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1290
1291 CALL netcdf_put_fvar (ng, model, ncname, 'SOsdev_zeta', &
1292 & so_sdev(isfsur,ng), (/0/), (/0/), &
1293 & ncid = ncid)
1294 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1295
1296# ifndef SOLVE3D
1297 CALL netcdf_put_fvar (ng, model, ncname, 'SOsdev_ubar', &
1298 & so_sdev(isubar,ng), (/0/), (/0/), &
1299 & ncid = ncid)
1300 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1301
1302 CALL netcdf_put_fvar (ng, model, ncname, 'SOsdev_vbar', &
1303 & so_sdev(isubar,ng), (/0/), (/0/), &
1304 & ncid = ncid)
1305 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1306
1307# else
1308
1309 CALL netcdf_put_fvar (ng, model, ncname, 'SOsdev_uvel', &
1310 & so_sdev(isuvel,ng), (/0/), (/0/), &
1311 & ncid = ncid)
1312 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1313
1314 CALL netcdf_put_fvar (ng, model, ncname, 'SOsdev_vvel', &
1315 & so_sdev(isvvel,ng), (/0/), (/0/), &
1316 & ncid = ncid)
1317 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1318
1319 DO itrc=1,nt(ng)
1320 nudg(itrc)=so_sdev(istvar(itrc),ng)
1321 END DO
1322 CALL netcdf_put_fvar (ng, model, ncname, 'SOsdev_tracer', &
1323 & nudg, (/1/), (/nt(ng)/), &
1324 & ncid = ncid)
1325 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1326# endif
1327
1328 CALL netcdf_put_fvar (ng, model, ncname, 'SOsdev_sustr', &
1329 & so_sdev(isustr,ng), (/0/), (/0/), &
1330 & ncid = ncid)
1331 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1332
1333
1334 CALL netcdf_put_fvar (ng, model, ncname, 'SOsdev_svstr', &
1335 & so_sdev(isvstr,ng), (/0/), (/0/), &
1336 & ncid = ncid)
1337 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1338
1339# ifdef SOLVE3D
1340 DO itrc=1,nt(ng)
1341 nudg(itrc)=so_sdev(istsur(itrc),ng)
1342 END DO
1343 CALL netcdf_put_fvar (ng, model, ncname, 'SOsdev_stflx', &
1344 & nudg, (/1/), (/nt(ng)/), &
1345 & ncid = ncid)
1346 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1347# endif
1348#endif
1349
1350#if defined BIOLOGY && defined SOLVE3D
1351# if defined BIO_FENNEL
1352# include <fennel_wrt.h>
1353# elif defined ECOSIM
1354# include <ecosim_wrt.h>
1355# elif defined HYPOXIA_SRM
1356# include <hypoxia_srm_wrt.h>
1357# elif defined NEMURO
1358# include <nemuro_wrt.h>
1359# elif defined NPZD_FRANKS
1360# include <npzd_Franks_wrt.h>
1361# elif defined NPZD_IRON
1362# include <npzd_iron_wrt.h>
1363# elif defined NPZD_POWELL
1364# include <npzd_Powell_wrt.h>
1365# elif defined RED_TIDE
1366# include <red_tide_wrt.h>
1367# endif
1368#endif
1369
1370#if defined FLOATS && defined FLOAT_BIOLOGY
1371# if defined FLOAT_OYSTER
1372# include <oyster_floats_wrt.h>
1373# endif
1374#endif
1375
1376#ifdef SEDIMENT
1377# include <sediment_wrt.h>
1378#endif
1379!
1380!-----------------------------------------------------------------------
1381! Write out grid variables.
1382!-----------------------------------------------------------------------
1383!
1384! Grid type switch. Writing characters in parallel I/O is extremely
1385! inefficient. It is better to write this as an integer switch:
1386! 0=Cartesian, 1=spherical.
1387!
1388 CALL netcdf_put_lvar (ng, model, ncname, 'spherical', &
1389 & spherical, (/0/), (/0/), &
1390 & ncid = ncid)
1391 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1392!
1393! Domain Length.
1394!
1395 CALL netcdf_put_fvar (ng, model, ncname, 'xl', &
1396 & xl(ng), (/0/), (/0/), &
1397 & ncid = ncid)
1398 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1399
1400 CALL netcdf_put_fvar (ng, model, ncname, 'el', &
1401 & el(ng), (/0/), (/0/), &
1402 & ncid = ncid)
1403 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1404
1405#ifdef SOLVE3D
1406!
1407! S-coordinate parameters.
1408!
1409 CALL netcdf_put_ivar (ng, model, ncname, 'Vtransform', &
1410 & vtransform(ng), (/0/), (/0/), &
1411 & ncid = ncid)
1412 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1413
1414 CALL netcdf_put_ivar (ng, model, ncname, 'Vstretching', &
1415 & vstretching(ng), (/0/), (/0/), &
1416 & ncid = ncid)
1417 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1418
1419 CALL netcdf_put_fvar (ng, model, ncname, 'theta_s', &
1420 & theta_s(ng), (/0/), (/0/), &
1421 & ncid = ncid)
1422 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1423
1424 CALL netcdf_put_fvar (ng, model, ncname, 'theta_b', &
1425 & theta_b(ng), (/0/), (/0/), &
1426 & ncid = ncid)
1427 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1428
1429 CALL netcdf_put_fvar (ng, model, ncname, 'Tcline', &
1430 & tcline(ng), (/0/), (/0/), &
1431 & ncid = ncid)
1432 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1433
1434 CALL netcdf_put_fvar (ng, model, ncname, 'hc', &
1435 & hc(ng), (/0/), (/0/), &
1436 & ncid = ncid)
1437 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1438!
1439! SGRID conventions for staggered data on structured grids. The value
1440! is arbitrary but is set to unity so it can be used as logical during
1441! post-processing.
1442!
1443 CALL netcdf_put_ivar (ng, model, ncname, 'grid', &
1444 & (/1/), (/0/), (/0/), &
1445 & ncid = ncid)
1446 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1447!
1448! S-coordinate non-dimensional independent variables.
1449!
1450 CALL netcdf_put_fvar (ng, model, ncname, 's_rho', &
1451 & scalars(ng)%sc_r(:), (/1/), (/n(ng)/), &
1452 & ncid = ncid)
1453 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1454
1455 CALL netcdf_put_fvar (ng, model, ncname, 's_w', &
1456 & scalars(ng)%sc_w(0:), (/1/), (/n(ng)+1/), &
1457 & ncid = ncid)
1458 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1459!
1460! S-coordinate non-dimensional stretching curves.
1461!
1462 CALL netcdf_put_fvar (ng, model, ncname, 'Cs_r', &
1463 & scalars(ng)%Cs_r(:), (/1/), (/n(ng)/), &
1464 & ncid = ncid)
1465 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1466
1467 CALL netcdf_put_fvar (ng, model, ncname, 'Cs_w', &
1468 & scalars(ng)%Cs_w(0:), (/1/), (/n(ng)+1/), &
1469 & ncid = ncid)
1470 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1471#endif
1472!
1473! User generic parameters.
1474!
1475 IF (nuser.gt.0) THEN
1476 CALL netcdf_put_fvar (ng, model, ncname, 'user', &
1477 & user, (/1/), (/nuser/), &
1478 & ncid = ncid)
1479 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1480 END IF
1481
1482#ifdef STATIONS
1483!
1484! Stations positions.
1485!
1486 IF (ncid.eq.sta(ng)%ncid) THEN
1487 CALL netcdf_put_fvar (ng, model, ncname, 'Ipos', &
1488 & scalars(ng)%SposX(:), (/1/), &
1489 & (/nstation(ng)/), ncid = ncid)
1490 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1491
1492 CALL netcdf_put_fvar (ng, model, ncname, 'Jpos', &
1493 & scalars(ng)%SposY(:), (/1/), &
1494 & (/nstation(ng)/), ncid = ncid)
1495 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1496 END IF
1497#endif
1498!
1499!-----------------------------------------------------------------------
1500! Write out grid tiled variables.
1501!-----------------------------------------------------------------------
1502!
1503#ifdef NO_WRITE_GRID
1504 grid_vars : IF (ncid.eq.sta(ng)%ncid) THEN
1505#else
1506 grid_vars : IF (ncid.ne.flt(ng)%ncid) THEN
1507#endif
1508#if !(defined SED_MORPH && defined SEDIMENT)
1509!
1510! Bathymetry.
1511!
1512 IF (exit_flag.eq.noerror) THEN
1513 scale=1.0_dp
1514 IF ((ncid.ne.sta(ng)%ncid).and. &
1515 & (ncid.ne.xtr(ng)%ncid)) THEN
1516 IF (find_string(var_name, n_var, trim(vname(1,idtopo)), &
1517 & varid)) THEN
1518 status=nf_fwrite2d(ng, model, ncid, idtopo, &
1519 & varid, 0, r2dvar, &
1520 & lbi, ubi, lbj, ubj, scale, &
1521# ifdef MASKING
1522 & grid(ng) % rmask, &
1523# endif
1524 & grid(ng) % h, &
1525 & setfillval = .false.)
1526 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1527 IF (master) WRITE (stdout,10) trim(vname(1,idtopo)), &
1528 & trim(ncname)
1529 exit_flag=3
1530 ioerror=status
1531 END IF
1532 ELSE
1533 IF (master) WRITE (stdout,20) trim(vname(1,idtopo)), &
1534 & trim(ncname)
1535 exit_flag=3
1536 ioerror=nf90_enotvar
1537 END IF
1538# ifdef GRID_EXTRACT
1539 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
1540 IF (find_string(var_name, n_var, trim(vname(1,idtopo)), &
1541 & varid)) THEN
1542 status=nf_fwrite2d(ng, model, ncid, idtopo, &
1543 & varid, 0, r2dvar, &
1544 & lbi, ubi, lbj, ubj, scale, &
1545# ifdef MASKING
1546 & extract(ng) % rmask, &
1547# endif
1548 & extract(ng) % h, &
1549 & setfillval = .false., &
1550 & extractfield = -1)
1551 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1552 IF (master) WRITE (stdout,10) trim(vname(1,idtopo)), &
1553 & trim(ncname)
1554 exit_flag=3
1555 ioerror=status
1556 END IF
1557 ELSE
1558 IF (master) WRITE (stdout,20) trim(vname(1,idtopo)), &
1559 & trim(ncname)
1560 exit_flag=3
1561 ioerror=nf90_enotvar
1562 END IF
1563# endif
1564# ifdef STATIONS
1565 ELSE IF (ncid.eq.sta(ng)%ncid) THEN
1566 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
1567 & lbi, ubi, lbj, ubj, &
1568 & scale, grid(ng)%h, &
1569 & nstation(ng), scalars(ng)%SposX, &
1570 & scalars(ng)%SposY, wrk)
1571 CALL netcdf_put_fvar (ng, model, ncname, vname(1,idtopo), &
1572 & wrk, (/1/), (/nstation(ng)/), &
1573 & ncid = ncid)
1574 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1575# endif
1576 END IF
1577 END IF
1578#endif
1579!
1580! Coriolis parameter.
1581!
1582 IF (exit_flag.eq.noerror) THEN
1583 IF ((ncid.ne.sta(ng)%ncid).and. &
1584 & (ncid.ne.xtr(ng)%ncid)) THEN
1585 scale=1.0_dp
1586 IF (find_string(var_name, n_var, trim(vname(1,idfcor)), &
1587 & varid)) THEN
1588 status=nf_fwrite2d(ng, model, ncid, idfcor, &
1589 & varid, 0, r2dvar, &
1590 & lbi, ubi, lbj, ubj, scale, &
1591#ifdef MASKING
1592 & grid(ng) % rmask, &
1593#endif
1594 & grid(ng) % f, &
1595 & setfillval = .false.)
1596 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1597 IF (master) WRITE (stdout,10) trim(vname(1,idfcor)), &
1598 & trim(ncname)
1599 exit_flag=3
1600 ioerror=status
1601 END IF
1602 ELSE
1603 IF (master) WRITE (stdout,20) trim(vname(1,idfcor)), &
1604 & trim(ncname)
1605 exit_flag=3
1606 ioerror=nf90_enotvar
1607 END IF
1608#ifdef GRID_EXTRACT
1609 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
1610 scale=1.0_dp
1611 IF (find_string(var_name, n_var, trim(vname(1,idfcor)), &
1612 & varid)) THEN
1613 status=nf_fwrite2d(ng, model, ncid, idfcor, &
1614 & varid, 0, r2dvar, &
1615 & lbi, ubi, lbj, ubj, scale, &
1616# ifdef MASKING
1617 & extract(ng) % rmask, &
1618# endif
1619 & extract(ng) % f, &
1620 & setfillval = .false., &
1621 & extractfield = -1)
1622 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1623 IF (master) WRITE (stdout,10) trim(vname(1,idfcor)), &
1624 & trim(ncname)
1625 exit_flag=3
1626 ioerror=status
1627 END IF
1628 ELSE
1629 IF (master) WRITE (stdout,20) trim(vname(1,idfcor)), &
1630 & trim(ncname)
1631 exit_flag=3
1632 ioerror=nf90_enotvar
1633 END IF
1634#endif
1635 END IF
1636 END IF
1637!
1638! Curvilinear transformation metrics.
1639!
1640 IF (exit_flag.eq.noerror) THEN
1641 IF ((ncid.ne.sta(ng)%ncid).and. &
1642 & (ncid.ne.xtr(ng)%ncid)) THEN
1643 scale=1.0_dp
1644 IF (find_string(var_name, n_var, trim(vname(1,idpmdx)), &
1645 & varid)) THEN
1646 status=nf_fwrite2d(ng, model, ncid, idpmdx, &
1647 & varid, 0, r2dvar, &
1648 & lbi, ubi, lbj, ubj, scale, &
1649#ifdef MASKING
1650 & grid(ng) % rmask, &
1651#endif
1652 & grid(ng) % pm, &
1653 & setfillval = .false.)
1654 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1655 IF (master) WRITE (stdout,10) trim(vname(1,idpmdx)), &
1656 & trim(ncname)
1657 exit_flag=3
1658 ioerror=status
1659 END IF
1660 ELSE
1661 IF (master) WRITE (stdout,20) trim(vname(1,idpmdx)), &
1662 & trim(ncname)
1663 exit_flag=3
1664 ioerror=nf90_enotvar
1665 END IF
1666#ifdef GRID_EXTRACT
1667 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
1668 scale=1.0_dp
1669 IF (find_string(var_name, n_var, trim(vname(1,idpmdx)), &
1670 & varid)) THEN
1671 status=nf_fwrite2d(ng, model, ncid, idpmdx, &
1672 & varid, 0, r2dvar, &
1673 & lbi, ubi, lbj, ubj, scale, &
1674# ifdef MASKING
1675 & extract(ng) % rmask, &
1676# endif
1677 & extract(ng) % pm, &
1678 & setfillval = .false., &
1679 & extractfield = -1)
1680 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1681 IF (master) WRITE (stdout,10) trim(vname(1,idpmdx)), &
1682 & trim(ncname)
1683 exit_flag=3
1684 ioerror=status
1685 END IF
1686 ELSE
1687 IF (master) WRITE (stdout,20) trim(vname(1,idpmdx)), &
1688 & trim(ncname)
1689 exit_flag=3
1690 ioerror=nf90_enotvar
1691 END IF
1692#endif
1693 END IF
1694 END IF
1695!
1696 IF (exit_flag.eq.noerror) THEN
1697 IF ((ncid.ne.sta(ng)%ncid).and. &
1698 & (ncid.ne.xtr(ng)%ncid)) THEN
1699 scale=1.0_dp
1700 IF (find_string(var_name, n_var, trim(vname(1,idpndy)), &
1701 & varid)) THEN
1702 status=nf_fwrite2d(ng, model, ncid, idpndy, &
1703 & varid, 0, r2dvar, &
1704 & lbi, ubi, lbj, ubj, scale, &
1705#ifdef MASKING
1706 & grid(ng) % rmask, &
1707#endif
1708 & grid(ng) % pn, &
1709 & setfillval = .false.)
1710 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1711 IF (master) WRITE (stdout,10) trim(vname(1,idpndy)), &
1712 & trim(ncname)
1713 exit_flag=3
1714 ioerror=status
1715 END IF
1716 ELSE
1717 IF (master) WRITE (stdout,20) trim(vname(1,idpndy)), &
1718 & trim(ncname)
1719 exit_flag=3
1720 ioerror=nf90_enotvar
1721 END IF
1722#ifdef GRID_EXTRACT
1723 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
1724 scale=1.0_dp
1725 IF (find_string(var_name, n_var, trim(vname(1,idpndy)), &
1726 & varid)) THEN
1727 status=nf_fwrite2d(ng, model, ncid, idpndy, &
1728 & varid, 0, r2dvar, &
1729 & lbi, ubi, lbj, ubj, scale, &
1730# ifdef MASKING
1731 & extract(ng) % rmask, &
1732# endif
1733 & extract(ng) % pn, &
1734 & setfillval = .false., &
1735 & extractfield = -1)
1736 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1737 IF (master) WRITE (stdout,10) trim(vname(1,idpndy)), &
1738 & trim(ncname)
1739 exit_flag=3
1740 ioerror=status
1741 END IF
1742 ELSE
1743 IF (master) WRITE (stdout,20) trim(vname(1,idpndy)), &
1744 & trim(ncname)
1745 exit_flag=3
1746 ioerror=nf90_enotvar
1747 END IF
1748#endif
1749 END IF
1750 END IF
1751!
1752! Grid coordinates of RHO-points.
1753!
1754 IF (spherical) THEN
1755 IF (exit_flag.eq.noerror) THEN
1756 scale=1.0_dp
1757 IF ((ncid.ne.sta(ng)%ncid).and. &
1758 & (ncid.ne.xtr(ng)%ncid)) THEN
1759 IF (find_string(var_name, n_var, trim(vname(1,idlonr)), &
1760 & varid)) THEN
1761 status=nf_fwrite2d(ng, model, ncid, idlonr, &
1762 & varid, 0, r2dvar, &
1763 & lbi, ubi, lbj, ubj, scale, &
1764#ifdef MASKING
1765 & grid(ng) % rmask, &
1766#endif
1767 & grid(ng) % lonr, &
1768 & setfillval = .false.)
1769 IF (founderror(status, nf90_noerr, &
1770 & __line__, myfile)) THEN
1771 IF (master) WRITE (stdout,10) trim(vname(1,idlonr)), &
1772 & trim(ncname)
1773 exit_flag=3
1774 ioerror=status
1775 END IF
1776 ELSE
1777 IF (master) WRITE (stdout,20) trim(vname(1,idlonr)), &
1778 & trim(ncname)
1779 exit_flag=3
1780 ioerror=nf90_enotvar
1781 END IF
1782#ifdef GRID_EXTRACT
1783 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
1784 IF (find_string(var_name, n_var, trim(vname(1,idlonr)), &
1785 & varid)) THEN
1786 status=nf_fwrite2d(ng, model, ncid, idlonr, &
1787 & varid, 0, r2dvar, &
1788 & lbi, ubi, lbj, ubj, scale, &
1789# ifdef MASKING
1790 & extract(ng) % rmask, &
1791# endif
1792 & extract(ng) % lonr, &
1793 & setfillval = .false., &
1794 & extractfield = -1)
1795 IF (founderror(status, nf90_noerr, &
1796 & __line__, myfile)) THEN
1797 IF (master) WRITE (stdout,10) trim(vname(1,idlonr)), &
1798 & trim(ncname)
1799 exit_flag=3
1800 ioerror=status
1801 END IF
1802 ELSE
1803 IF (master) WRITE (stdout,20) trim(vname(1,idlonr)), &
1804 & trim(ncname)
1805 exit_flag=3
1806 ioerror=nf90_enotvar
1807 END IF
1808#endif
1809#ifdef STATIONS
1810 ELSE IF (ncid.eq.sta(ng)%ncid) THEN
1811 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
1812 & lbi, ubi, lbj, ubj, &
1813 & scale, grid(ng)%lonr, &
1814 & nstation(ng), scalars(ng)%SposX, &
1815 & scalars(ng)%SposY, wrk)
1816 CALL netcdf_put_fvar (ng, model, ncname, vname(1,idlonr), &
1817 & wrk, (/1/), (/nstation(ng)/), &
1818 & ncid = ncid)
1819 IF (founderror(exit_flag, noerror, &
1820 & __line__, myfile)) RETURN
1821#endif
1822 END IF
1823 END IF
1824!
1825 IF (exit_flag.eq.noerror) THEN
1826 scale=1.0_dp
1827 IF ((ncid.ne.sta(ng)%ncid).and. &
1828 & (ncid.ne.xtr(ng)%ncid)) THEN
1829 IF (find_string(var_name, n_var, trim(vname(1,idlatr)), &
1830 & varid)) THEN
1831 status=nf_fwrite2d(ng, model, ncid, idlatr, &
1832 & varid, 0, r2dvar, &
1833 & lbi, ubi, lbj, ubj, scale, &
1834#ifdef MASKING
1835 & grid(ng) % rmask, &
1836#endif
1837 & grid(ng) % latr, &
1838 & setfillval = .false.)
1839 IF (founderror(status, nf90_noerr, &
1840 & __line__, myfile)) THEN
1841 IF (master) WRITE (stdout,10) trim(vname(1,idlatr)), &
1842 & trim(ncname)
1843 exit_flag=3
1844 ioerror=status
1845 END IF
1846 ELSE
1847 IF (master) WRITE (stdout,20) trim(vname(1,idlatr)), &
1848 & trim(ncname)
1849 exit_flag=3
1850 ioerror=nf90_enotvar
1851 END IF
1852#ifdef GRID_EXTRACT
1853 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
1854 IF (find_string(var_name, n_var, trim(vname(1,idlatr)), &
1855 & varid)) THEN
1856 status=nf_fwrite2d(ng, model, ncid, idlatr, &
1857 & varid, 0, r2dvar, &
1858 & lbi, ubi, lbj, ubj, scale, &
1859# ifdef MASKING
1860 & extract(ng) % rmask, &
1861# endif
1862 & extract(ng) % latr, &
1863 & setfillval = .false., &
1864 & extractfield = -1)
1865 IF (founderror(status, nf90_noerr, &
1866 & __line__, myfile)) THEN
1867 IF (master) WRITE (stdout,10) trim(vname(1,idlatr)), &
1868 & trim(ncname)
1869 exit_flag=3
1870 ioerror=status
1871 END IF
1872 ELSE
1873 IF (master) WRITE (stdout,20) trim(vname(1,idlatr)), &
1874 & trim(ncname)
1875 exit_flag=3
1876 ioerror=nf90_enotvar
1877 END IF
1878#endif
1879#ifdef STATIONS
1880 ELSE IF (ncid.eq.sta(ng)%ncid) THEN
1881 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
1882 & lbi, ubi, lbj, ubj, &
1883 & scale, grid(ng)%latr, &
1884 & nstation(ng), scalars(ng)%SposX, &
1885 & scalars(ng)%SposY, wrk)
1886 CALL netcdf_put_fvar (ng, model, ncname, vname(1,idlatr), &
1887 & wrk, (/1/), (/nstation(ng)/), &
1888 & ncid = ncid)
1889 IF (founderror(exit_flag, noerror, &
1890 & __line__, myfile)) RETURN
1891#endif
1892 END IF
1893 END IF
1894 END IF
1895!
1896 IF (.not.spherical) THEN
1897 IF (exit_flag.eq.noerror) THEN
1898 scale=1.0_dp
1899 IF ((ncid.ne.sta(ng)%ncid).and. &
1900 & (ncid.ne.xtr(ng)%ncid)) THEN
1901 IF (find_string(var_name, n_var, trim(vname(1,idxgrr)), &
1902 & varid)) THEN
1903 status=nf_fwrite2d(ng, model, ncid, idxgrr, &
1904 & varid, 0, r2dvar, &
1905 & lbi, ubi, lbj, ubj, scale, &
1906#ifdef MASKING
1907 & grid(ng) % rmask, &
1908#endif
1909 & grid(ng) % xr, &
1910 & setfillval = .false.)
1911 IF (founderror(status, nf90_noerr, &
1912 & __line__, myfile)) THEN
1913 IF (master) WRITE (stdout,10) trim(vname(1,idxgrr)), &
1914 & trim(ncname)
1915 exit_flag=3
1916 ioerror=status
1917 END IF
1918 ELSE
1919 IF (master) WRITE (stdout,20) trim(vname(1,idxgrr)), &
1920 & trim(ncname)
1921 exit_flag=3
1922 ioerror=nf90_enotvar
1923 END IF
1924#ifdef GRID_EXTRACT
1925 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
1926 IF (find_string(var_name, n_var, trim(vname(1,idxgrr)), &
1927 & varid)) THEN
1928 status=nf_fwrite2d(ng, model, ncid, idxgrr, &
1929 & varid, 0, r2dvar, &
1930 & lbi, ubi, lbj, ubj, scale, &
1931# ifdef MASKING
1932 & extract(ng) % rmask, &
1933# endif
1934 & extract(ng) % xr, &
1935 & setfillval = .false., &
1936 & extractfield = -1)
1937 IF (founderror(status, nf90_noerr, &
1938 & __line__, myfile)) THEN
1939 IF (master) WRITE (stdout,10) trim(vname(1,idxgrr)), &
1940 & trim(ncname)
1941 exit_flag=3
1942 ioerror=status
1943 END IF
1944 ELSE
1945 IF (master) WRITE (stdout,20) trim(vname(1,idxgrr)), &
1946 & trim(ncname)
1947 exit_flag=3
1948 ioerror=nf90_enotvar
1949 END IF
1950#endif
1951#ifdef STATIONS
1952 ELSE IF (ncid.eq.sta(ng)%ncid) THEN
1953 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
1954 & lbi, ubi, lbj, ubj, &
1955 & scale, grid(ng)%xr, &
1956 & nstation(ng), scalars(ng)%SposX, &
1957 & scalars(ng)%SposY, wrk)
1958 CALL netcdf_put_fvar (ng, model, ncname, vname(1,idxgrr), &
1959 & wrk, (/1/), (/nstation(ng)/), &
1960 & ncid = ncid)
1961 IF (founderror(exit_flag, noerror, &
1962 & __line__, myfile)) RETURN
1963#endif
1964 END IF
1965 END IF
1966!
1967 IF (exit_flag.eq.noerror) THEN
1968 scale=1.0_dp
1969 IF ((ncid.ne.sta(ng)%ncid).and. &
1970 & (ncid.ne.xtr(ng)%ncid)) THEN
1971 IF (find_string(var_name, n_var, trim(vname(1,idygrr)), &
1972 & varid)) THEN
1973 status=nf_fwrite2d(ng, model, ncid, idygrr, &
1974 & varid, 0, r2dvar, &
1975 & lbi, ubi, lbj, ubj, scale, &
1976#ifdef MASKING
1977 & grid(ng) % rmask, &
1978#endif
1979 & grid(ng) % yr, &
1980 & setfillval = .false.)
1981 IF (founderror(status, nf90_noerr, &
1982 & __line__, myfile)) THEN
1983 IF (master) WRITE (stdout,10) trim(vname(1,idygrr)), &
1984 & trim(ncname)
1985 exit_flag=3
1986 ioerror=status
1987 END IF
1988 ELSE
1989 IF (master) WRITE (stdout,20) trim(vname(1,idygrr)), &
1990 & trim(ncname)
1991 exit_flag=3
1992 ioerror=nf90_enotvar
1993 END IF
1994#ifdef GRID_EXTRACT
1995 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
1996 IF (find_string(var_name, n_var, trim(vname(1,idygrr)), &
1997 & varid)) THEN
1998 status=nf_fwrite2d(ng, model, ncid, idygrr, &
1999 & varid, 0, r2dvar, &
2000 & lbi, ubi, lbj, ubj, scale, &
2001# ifdef MASKING
2002 & extract(ng) % rmask, &
2003# endif
2004 & extract(ng) % yr, &
2005 & setfillval = .false., &
2006 & extractfield = -1)
2007 IF (founderror(status, nf90_noerr, &
2008 & __line__, myfile)) THEN
2009 IF (master) WRITE (stdout,10) trim(vname(1,idygrr)), &
2010 & trim(ncname)
2011 exit_flag=3
2012 ioerror=status
2013 END IF
2014 ELSE
2015 IF (master) WRITE (stdout,20) trim(vname(1,idygrr)), &
2016 & trim(ncname)
2017 exit_flag=3
2018 ioerror=nf90_enotvar
2019 END IF
2020#endif
2021#ifdef STATIONS
2022 ELSE IF (ncid.eq.sta(ng)%ncid) THEN
2023 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
2024 & lbi, ubi, lbj, ubj, &
2025 & scale, grid(ng)%yr, &
2026 & nstation(ng), scalars(ng)%SposX, &
2027 & scalars(ng)%SposY, wrk)
2028 CALL netcdf_put_fvar (ng, model, ncname, vname(1,idygrr), &
2029 & wrk, (/1/), (/nstation(ng)/), &
2030 & ncid = ncid)
2031 IF (founderror(exit_flag, noerror, &
2032 & __line__, myfile)) RETURN
2033# endif
2034 END IF
2035 END IF
2036 END IF
2037!
2038! Grid coordinates of U-points.
2039!
2040 IF (spherical) THEN
2041 IF (exit_flag.eq.noerror) THEN
2042 IF ((ncid.ne.sta(ng)%ncid).and. &
2043 & (ncid.ne.xtr(ng)%ncid)) THEN
2044 scale=1.0_dp
2045 IF (find_string(var_name, n_var, trim(vname(1,idlonu)), &
2046 & varid)) THEN
2047 status=nf_fwrite2d(ng, model, ncid, idlonu, &
2048 & varid, 0, u2dvar, &
2049 & lbi, ubi, lbj, ubj, scale, &
2050#ifdef MASKING
2051 & grid(ng) % umask, &
2052#endif
2053 & grid(ng) % lonu, &
2054 & setfillval = .false.)
2055 IF (founderror(status, nf90_noerr, &
2056 & __line__, myfile)) THEN
2057 IF (master) WRITE (stdout,10) trim(vname(1,idlonu)), &
2058 & trim(ncname)
2059 exit_flag=3
2060 ioerror=status
2061 END IF
2062 ELSE
2063 IF (master) WRITE (stdout,20) trim(vname(1,idlonu)), &
2064 & trim(ncname)
2065 exit_flag=3
2066 ioerror=nf90_enotvar
2067 END IF
2068#ifdef GRID_EXTRACT
2069 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2070 scale=1.0_dp
2071 IF (find_string(var_name, n_var, trim(vname(1,idlonu)), &
2072 & varid)) THEN
2073 status=nf_fwrite2d(ng, model, ncid, idlonu, &
2074 & varid, 0, u2dvar, &
2075 & lbi, ubi, lbj, ubj, scale, &
2076# ifdef MASKING
2077 & extract(ng) % umask, &
2078# endif
2079 & extract(ng) % lonu, &
2080 & setfillval = .false., &
2081 & extractfield = -1)
2082 IF (founderror(status, nf90_noerr, &
2083 & __line__, myfile)) THEN
2084 IF (master) WRITE (stdout,10) trim(vname(1,idlonu)), &
2085 & trim(ncname)
2086 exit_flag=3
2087 ioerror=status
2088 END IF
2089 ELSE
2090 IF (master) WRITE (stdout,20) trim(vname(1,idlonu)), &
2091 & trim(ncname)
2092 exit_flag=3
2093 ioerror=nf90_enotvar
2094 END IF
2095#endif
2096 END IF
2097 END IF
2098!
2099 IF (exit_flag.eq.noerror) THEN
2100 IF ((ncid.ne.sta(ng)%ncid).and. &
2101 & (ncid.ne.xtr(ng)%ncid)) THEN
2102 scale=1.0_dp
2103 IF (find_string(var_name, n_var, trim(vname(1,idlatu)), &
2104 & varid)) THEN
2105 status=nf_fwrite2d(ng, model, ncid, idlatu, &
2106 & varid, 0, u2dvar, &
2107 & lbi, ubi, lbj, ubj, scale, &
2108#ifdef MASKING
2109 & grid(ng) % umask, &
2110#endif
2111 & grid(ng) % latu, &
2112 & setfillval = .false.)
2113 IF (founderror(status, nf90_noerr, &
2114 & __line__, myfile)) THEN
2115 IF (master) WRITE (stdout,10) trim(vname(1,idlatu)), &
2116 & trim(ncname)
2117 exit_flag=3
2118 ioerror=status
2119 END IF
2120 ELSE
2121 IF (master) WRITE (stdout,20) trim(vname(1,idlatu)), &
2122 & trim(ncname)
2123 exit_flag=3
2124 ioerror=nf90_enotvar
2125 END IF
2126#ifdef GRID_EXTRACT
2127 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2128 scale=1.0_dp
2129 IF (find_string(var_name, n_var, trim(vname(1,idlatu)), &
2130 & varid)) THEN
2131 status=nf_fwrite2d(ng, model, ncid, idlatu, &
2132 & varid, 0, u2dvar, &
2133 & lbi, ubi, lbj, ubj, scale, &
2134# ifdef MASKING
2135 & extract(ng) % umask, &
2136# endif
2137 & extract(ng) % latu, &
2138 & setfillval = .false., &
2139 & extractfield = -1)
2140 IF (founderror(status, nf90_noerr, &
2141 & __line__, myfile)) THEN
2142 IF (master) WRITE (stdout,10) trim(vname(1,idlatu)), &
2143 & trim(ncname)
2144 exit_flag=3
2145 ioerror=status
2146 END IF
2147 ELSE
2148 IF (master) WRITE (stdout,20) trim(vname(1,idlatu)), &
2149 & trim(ncname)
2150 exit_flag=3
2151 ioerror=nf90_enotvar
2152 END IF
2153#endif
2154 END IF
2155 END IF
2156 END IF
2157!
2158 IF (.not.spherical) THEN
2159 IF (exit_flag.eq.noerror) THEN
2160 IF ((ncid.ne.sta(ng)%ncid).and. &
2161 & (ncid.ne.xtr(ng)%ncid)) THEN
2162 scale=1.0_dp
2163 IF (find_string(var_name, n_var, trim(vname(1,idxgru)), &
2164 & varid)) THEN
2165 status=nf_fwrite2d(ng, model, ncid, idxgru, &
2166 & varid, 0, u2dvar, &
2167 & lbi, ubi, lbj, ubj, scale, &
2168#ifdef MASKING
2169 & grid(ng) % umask, &
2170#endif
2171 & grid(ng) % xu, &
2172 & setfillval = .false.)
2173 IF (founderror(status, nf90_noerr, &
2174 & __line__, myfile)) THEN
2175 IF (master) WRITE (stdout,10) trim(vname(1,idxgru)), &
2176 & trim(ncname)
2177 exit_flag=3
2178 ioerror=status
2179 END IF
2180 ELSE
2181 IF (master) WRITE (stdout,20) trim(vname(1,idxgru)), &
2182 & trim(ncname)
2183 exit_flag=3
2184 ioerror=nf90_enotvar
2185 END IF
2186#ifdef GRID_EXTRACT
2187 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2188 scale=1.0_dp
2189 IF (find_string(var_name, n_var, trim(vname(1,idxgru)), &
2190 & varid)) THEN
2191 status=nf_fwrite2d(ng, model, ncid, idxgru, &
2192 & varid, 0, u2dvar, &
2193 & lbi, ubi, lbj, ubj, scale, &
2194# ifdef MASKING
2195 & extract(ng) % umask, &
2196# endif
2197 & extract(ng) % xu, &
2198 & setfillval = .false., &
2199 & extractfield = -1)
2200 IF (founderror(status, nf90_noerr, &
2201 & __line__, myfile)) THEN
2202 IF (master) WRITE (stdout,10) trim(vname(1,idxgru)), &
2203 & trim(ncname)
2204 exit_flag=3
2205 ioerror=status
2206 END IF
2207 ELSE
2208 IF (master) WRITE (stdout,20) trim(vname(1,idxgru)), &
2209 & trim(ncname)
2210 exit_flag=3
2211 ioerror=nf90_enotvar
2212 END IF
2213#endif
2214 END IF
2215 END IF
2216!
2217 IF (exit_flag.eq.noerror) THEN
2218 IF ((ncid.ne.sta(ng)%ncid).and. &
2219 & (ncid.ne.xtr(ng)%ncid)) THEN
2220 scale=1.0_dp
2221 IF (find_string(var_name, n_var, trim(vname(1,idygru)), &
2222 & varid)) THEN
2223 status=nf_fwrite2d(ng, model, ncid, idygru, &
2224 & varid, 0, u2dvar, &
2225 & lbi, ubi, lbj, ubj, scale, &
2226#ifdef MASKING
2227 & grid(ng) % umask, &
2228#endif
2229 & grid(ng) % yu, &
2230 & setfillval = .false.)
2231 IF (founderror(status, nf90_noerr, &
2232 & __line__, myfile)) THEN
2233 IF (master) WRITE (stdout,10) trim(vname(1,idygru)), &
2234 & trim(ncname)
2235 exit_flag=3
2236 ioerror=status
2237 END IF
2238 ELSE
2239 IF (master) WRITE (stdout,20) trim(vname(1,idygru)), &
2240 & trim(ncname)
2241 exit_flag=3
2242 ioerror=nf90_enotvar
2243 END IF
2244#ifdef GRID_EXTRACT
2245 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2246 scale=1.0_dp
2247 IF (find_string(var_name, n_var, trim(vname(1,idygru)), &
2248 & varid)) THEN
2249 status=nf_fwrite2d(ng, model, ncid, idygru, &
2250 & varid, 0, u2dvar, &
2251 & lbi, ubi, lbj, ubj, scale, &
2252# ifdef MASKING
2253 & extract(ng) % umask, &
2254# endif
2255 & extract(ng) % yu, &
2256 & setfillval = .false., &
2257 & extractfield = -1)
2258 IF (founderror(status, nf90_noerr, &
2259 & __line__, myfile)) THEN
2260 IF (master) WRITE (stdout,10) trim(vname(1,idygru)), &
2261 & trim(ncname)
2262 exit_flag=3
2263 ioerror=status
2264 END IF
2265 ELSE
2266 IF (master) WRITE (stdout,20) trim(vname(1,idygru)), &
2267 & trim(ncname)
2268 exit_flag=3
2269 ioerror=nf90_enotvar
2270 END IF
2271#endif
2272 END IF
2273 END IF
2274 END IF
2275!
2276! Grid coordinates of V-points.
2277!
2278 IF (spherical) THEN
2279 IF (exit_flag.eq.noerror) THEN
2280 IF ((ncid.ne.sta(ng)%ncid).and. &
2281 & (ncid.ne.xtr(ng)%ncid)) THEN
2282 scale=1.0_dp
2283 IF (find_string(var_name, n_var, trim(vname(1,idlonv)), &
2284 & varid)) THEN
2285 status=nf_fwrite2d(ng, model, ncid, idlonv, &
2286 & varid, 0, v2dvar, &
2287 & lbi, ubi, lbj, ubj, scale, &
2288#ifdef MASKING
2289 & grid(ng) % vmask, &
2290#endif
2291 & grid(ng) % lonv, &
2292 & setfillval = .false.)
2293 IF (founderror(status, nf90_noerr, &
2294 & __line__, myfile)) THEN
2295 IF (master) WRITE (stdout,10) trim(vname(1,idlonv)), &
2296 & trim(ncname)
2297 exit_flag=3
2298 ioerror=status
2299 END IF
2300 ELSE
2301 IF (master) WRITE (stdout,10) trim(vname(1,idlonv)), &
2302 & trim(ncname)
2303 exit_flag=3
2304 ioerror=nf90_enotvar
2305 END IF
2306#ifdef GRID_EXTRACT
2307 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2308 scale=1.0_dp
2309 IF (find_string(var_name, n_var, trim(vname(1,idlonv)), &
2310 & varid)) THEN
2311 status=nf_fwrite2d(ng, model, ncid, idlonv, &
2312 & varid, 0, v2dvar, &
2313 & lbi, ubi, lbj, ubj, scale, &
2314# ifdef MASKING
2315 & extract(ng) % vmask, &
2316# endif
2317 & extract(ng) % lonv, &
2318 & setfillval = .false., &
2319 & extractfield = -1)
2320 IF (founderror(status, nf90_noerr, &
2321 & __line__, myfile)) THEN
2322 IF (master) WRITE (stdout,10) trim(vname(1,idlonv)), &
2323 & trim(ncname)
2324 exit_flag=3
2325 ioerror=status
2326 END IF
2327 ELSE
2328 IF (master) WRITE (stdout,10) trim(vname(1,idlonv)), &
2329 & trim(ncname)
2330 exit_flag=3
2331 ioerror=nf90_enotvar
2332 END IF
2333#endif
2334 END IF
2335 END IF
2336!
2337 IF (exit_flag.eq.noerror) THEN
2338 IF ((ncid.ne.sta(ng)%ncid).and. &
2339 & (ncid.ne.xtr(ng)%ncid)) THEN
2340 scale=1.0_dp
2341 IF (find_string(var_name, n_var, trim(vname(1,idlatv)), &
2342 & varid)) THEN
2343 status=nf_fwrite2d(ng, model, ncid, idlatv, &
2344 & varid, 0, v2dvar, &
2345 & lbi, ubi, lbj, ubj, scale, &
2346#ifdef MASKING
2347 & grid(ng) % vmask, &
2348#endif
2349 & grid(ng) % latv, &
2350 & setfillval = .false.)
2351 IF (founderror(status, nf90_noerr, &
2352 & __line__, myfile)) THEN
2353 IF (master) WRITE (stdout,10) trim(vname(1,idlatv)), &
2354 & trim(ncname)
2355 exit_flag=3
2356 ioerror=status
2357 END IF
2358 ELSE
2359 IF (master) WRITE (stdout,20) trim(vname(1,idlatv)), &
2360 & trim(ncname)
2361 exit_flag=3
2362 ioerror=nf90_enotvar
2363 END IF
2364#ifdef GRID_EXTRACT
2365 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2366 scale=1.0_dp
2367 IF (find_string(var_name, n_var, trim(vname(1,idlatv)), &
2368 & varid)) THEN
2369 status=nf_fwrite2d(ng, model, ncid, idlatv, &
2370 & varid, 0, v2dvar, &
2371 & lbi, ubi, lbj, ubj, scale, &
2372# ifdef MASKING
2373 & extract(ng) % vmask, &
2374# endif
2375 & extract(ng) % latv, &
2376 & setfillval = .false., &
2377 & extractfield = -1)
2378 IF (founderror(status, nf90_noerr, &
2379 & __line__, myfile)) THEN
2380 IF (master) WRITE (stdout,10) trim(vname(1,idlatv)), &
2381 & trim(ncname)
2382 exit_flag=3
2383 ioerror=status
2384 END IF
2385 ELSE
2386 IF (master) WRITE (stdout,20) trim(vname(1,idlatv)), &
2387 & trim(ncname)
2388 exit_flag=3
2389 ioerror=nf90_enotvar
2390 END IF
2391#endif
2392 END IF
2393 END IF
2394 END IF
2395!
2396 IF (.not.spherical) THEN
2397 IF (exit_flag.eq.noerror) THEN
2398 IF ((ncid.ne.sta(ng)%ncid).and. &
2399 & (ncid.ne.xtr(ng)%ncid)) THEN
2400 scale=1.0_dp
2401 IF (find_string(var_name, n_var, trim(vname(1,idxgrv)), &
2402 & varid)) THEN
2403 status=nf_fwrite2d(ng, model, ncid, idxgrv, &
2404 & varid, 0, v2dvar, &
2405 & lbi, ubi, lbj, ubj, scale, &
2406#ifdef MASKING
2407 & grid(ng) % vmask, &
2408#endif
2409 & grid(ng) % xv, &
2410 & setfillval = .false.)
2411 IF (founderror(status, nf90_noerr, &
2412 & __line__, myfile)) THEN
2413 IF (master) WRITE (stdout,10) trim(vname(1,idxgrv)), &
2414 & trim(ncname)
2415 exit_flag=3
2416 ioerror=status
2417 END IF
2418 ELSE
2419 IF (master) WRITE (stdout,10) trim(vname(1,idxgrv)), &
2420 & trim(ncname)
2421 exit_flag=3
2422 ioerror=nf90_enotvar
2423 END IF
2424#ifdef GRID_EXTRACT
2425 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2426 scale=1.0_dp
2427 IF (find_string(var_name, n_var, trim(vname(1,idxgrv)), &
2428 & varid)) THEN
2429 status=nf_fwrite2d(ng, model, ncid, idxgrv, &
2430 & varid, 0, v2dvar, &
2431 & lbi, ubi, lbj, ubj, scale, &
2432# ifdef MASKING
2433 & extract(ng) % vmask, &
2434# endif
2435 & extract(ng) % xv, &
2436 & setfillval = .false., &
2437 & extractfield = -1)
2438 IF (founderror(status, nf90_noerr, &
2439 & __line__, myfile)) THEN
2440 IF (master) WRITE (stdout,10) trim(vname(1,idxgrv)), &
2441 & trim(ncname)
2442 exit_flag=3
2443 ioerror=status
2444 END IF
2445 ELSE
2446 IF (master) WRITE (stdout,10) trim(vname(1,idxgrv)), &
2447 & trim(ncname)
2448 exit_flag=3
2449 ioerror=nf90_enotvar
2450 END IF
2451#endif
2452 END IF
2453 END IF
2454!
2455 IF (exit_flag.eq.noerror) THEN
2456 IF ((ncid.ne.sta(ng)%ncid).and. &
2457 & (ncid.ne.xtr(ng)%ncid)) THEN
2458 scale=1.0_dp
2459 IF (find_string(var_name, n_var, trim(vname(1,idygrv)), &
2460 & varid)) THEN
2461 status=nf_fwrite2d(ng, model, ncid, idygrv, &
2462 & varid, 0, v2dvar, &
2463 & lbi, ubi, lbj, ubj, scale, &
2464#ifdef MASKING
2465 & grid(ng) % vmask, &
2466#endif
2467 & grid(ng) % yv, &
2468 & setfillval = .false.)
2469 IF (founderror(status, nf90_noerr, &
2470 & __line__, myfile)) THEN
2471 IF (master) WRITE (stdout,10) trim(vname(1,idygrv)), &
2472 & trim(ncname)
2473 exit_flag=3
2474 ioerror=status
2475 END IF
2476 ELSE
2477 IF (master) WRITE (stdout,20) trim(vname(1,idygrv)), &
2478 & trim(ncname)
2479 exit_flag=3
2480 ioerror=nf90_enotvar
2481 END IF
2482#ifdef GRID_EXTRACT
2483 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2484 scale=1.0_dp
2485 IF (find_string(var_name, n_var, trim(vname(1,idygrv)), &
2486 & varid)) THEN
2487 status=nf_fwrite2d(ng, model, ncid, idygrv, &
2488 & varid, 0, v2dvar, &
2489 & lbi, ubi, lbj, ubj, scale, &
2490# ifdef MASKING
2491 & extract(ng) % vmask, &
2492# endif
2493 & extract(ng) % yv, &
2494 & setfillval = .false., &
2495 & extractfield = -1)
2496 IF (founderror(status, nf90_noerr, &
2497 & __line__, myfile)) THEN
2498 IF (master) WRITE (stdout,10) trim(vname(1,idygrv)), &
2499 & trim(ncname)
2500 exit_flag=3
2501 ioerror=status
2502 END IF
2503 ELSE
2504 IF (master) WRITE (stdout,20) trim(vname(1,idygrv)), &
2505 & trim(ncname)
2506 exit_flag=3
2507 ioerror=nf90_enotvar
2508 END IF
2509#endif
2510 END IF
2511 END IF
2512 END IF
2513!
2514! Grid coordinates of PSI-points.
2515!
2516 IF (spherical) THEN
2517 IF (exit_flag.eq.noerror) THEN
2518 IF ((ncid.ne.sta(ng)%ncid).and. &
2519 & (ncid.ne.xtr(ng)%ncid)) THEN
2520 scale=1.0_dp
2521 IF (find_string(var_name, n_var, trim(vname(1,idlonp)), &
2522 & varid)) THEN
2523 status=nf_fwrite2d(ng, model, ncid, idlonp, &
2524 & varid, 0, p2dvar, &
2525 & lbi, ubi, lbj, ubj, scale, &
2526#ifdef MASKING
2527 & grid(ng) % pmask, &
2528#endif
2529 & grid(ng) % lonp, &
2530 & setfillval = .false.)
2531 IF (founderror(status, nf90_noerr, &
2532 & __line__, myfile)) THEN
2533 IF (master) WRITE (stdout,10) trim(vname(1,idlonp)), &
2534 & trim(ncname)
2535 exit_flag=3
2536 ioerror=status
2537 END IF
2538 ELSE
2539 IF (master) WRITE (stdout,20) trim(vname(1,idlonp)), &
2540 & trim(ncname)
2541 exit_flag=3
2542 ioerror=nf90_enotvar
2543 END IF
2544#ifdef GRID_EXTRACT
2545 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2546 scale=1.0_dp
2547 IF (find_string(var_name, n_var, trim(vname(1,idlonp)), &
2548 & varid)) THEN
2549 status=nf_fwrite2d(ng, model, ncid, idlonp, &
2550 & varid, 0, p2dvar, &
2551 & lbi, ubi, lbj, ubj, scale, &
2552# ifdef MASKING
2553 & extract(ng) % pmask, &
2554# endif
2555 & extract(ng) % lonp, &
2556 & setfillval = .false., &
2557 & extractfield = -1)
2558 IF (founderror(status, nf90_noerr, &
2559 & __line__, myfile)) THEN
2560 IF (master) WRITE (stdout,10) trim(vname(1,idlonp)), &
2561 & trim(ncname)
2562 exit_flag=3
2563 ioerror=status
2564 END IF
2565 ELSE
2566 IF (master) WRITE (stdout,20) trim(vname(1,idlonp)), &
2567 & trim(ncname)
2568 exit_flag=3
2569 ioerror=nf90_enotvar
2570 END IF
2571#endif
2572 END IF
2573 END IF
2574
2575 IF (exit_flag.eq.noerror) THEN
2576 IF ((ncid.ne.sta(ng)%ncid).and. &
2577 & (ncid.ne.xtr(ng)%ncid)) THEN
2578 scale=1.0_dp
2579 IF (find_string(var_name, n_var, trim(vname(1,idlatp)), &
2580 & varid)) THEN
2581 status=nf_fwrite2d(ng, model, ncid, idlatp, &
2582 & varid, 0, p2dvar, &
2583 & lbi, ubi, lbj, ubj, scale, &
2584#ifdef MASKING
2585 & grid(ng) % pmask, &
2586#endif
2587 & grid(ng) % latp, &
2588 & setfillval = .false.)
2589 IF (founderror(status, nf90_noerr, &
2590 & __line__, myfile)) THEN
2591 IF (master) WRITE (stdout,10) trim(vname(1,idlatp)), &
2592 & trim(ncname)
2593 exit_flag=3
2594 ioerror=status
2595 END IF
2596 ELSE
2597 IF (master) WRITE (stdout,20) trim(vname(1,idlatp)), &
2598 & trim(ncname)
2599 exit_flag=3
2600 ioerror=nf90_enotvar
2601 END IF
2602#ifdef GRID_EXTRACT
2603 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2604 scale=1.0_dp
2605 IF (find_string(var_name, n_var, trim(vname(1,idlatp)), &
2606 & varid)) THEN
2607 status=nf_fwrite2d(ng, model, ncid, idlatp, &
2608 & varid, 0, p2dvar, &
2609 & lbi, ubi, lbj, ubj, scale, &
2610# ifdef MASKING
2611 & extract(ng) % pmask, &
2612# endif
2613 & extract(ng) % latp, &
2614 & setfillval = .false., &
2615 & extractfield = -1)
2616 IF (founderror(status, nf90_noerr, &
2617 & __line__, myfile)) THEN
2618 IF (master) WRITE (stdout,10) trim(vname(1,idlatp)), &
2619 & trim(ncname)
2620 exit_flag=3
2621 ioerror=status
2622 END IF
2623 ELSE
2624 IF (master) WRITE (stdout,20) trim(vname(1,idlatp)), &
2625 & trim(ncname)
2626 exit_flag=3
2627 ioerror=nf90_enotvar
2628 END IF
2629#endif
2630 END IF
2631 END IF
2632 END IF
2633!
2634 IF (.not.spherical) THEN
2635 IF (exit_flag.eq.noerror) THEN
2636 IF ((ncid.ne.sta(ng)%ncid).and. &
2637 & (ncid.ne.xtr(ng)%ncid)) THEN
2638 scale=1.0_dp
2639 IF (find_string(var_name, n_var, trim(vname(1,idxgrp)), &
2640 & varid)) THEN
2641 status=nf_fwrite2d(ng, model, ncid, idxgrp, &
2642 & varid, 0, p2dvar, &
2643 & lbi, ubi, lbj, ubj, scale, &
2644#ifdef MASKING
2645 & grid(ng) % pmask, &
2646#endif
2647 & grid(ng) % xp, &
2648 & setfillval = .false.)
2649 IF (founderror(status, nf90_noerr, &
2650 & __line__, myfile)) THEN
2651 IF (master) WRITE (stdout,10) trim(vname(1,idxgrp)), &
2652 & trim(ncname)
2653 exit_flag=3
2654 ioerror=status
2655 END IF
2656 ELSE
2657 IF (master) WRITE (stdout,20) trim(vname(1,idxgrp)), &
2658 & trim(ncname)
2659 exit_flag=3
2660 ioerror=nf90_enotvar
2661 END IF
2662#ifdef GRID_EXTRACT
2663 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2664 scale=1.0_dp
2665 IF (find_string(var_name, n_var, trim(vname(1,idxgrp)), &
2666 & varid)) THEN
2667 status=nf_fwrite2d(ng, model, ncid, idxgrp, &
2668 & varid, 0, p2dvar, &
2669 & lbi, ubi, lbj, ubj, scale, &
2670# ifdef MASKING
2671 & extract(ng) % pmask, &
2672# endif
2673 & extract(ng) % xp, &
2674 & setfillval = .false., &
2675 & extractfield = -1)
2676 IF (founderror(status, nf90_noerr, &
2677 & __line__, myfile)) THEN
2678 IF (master) WRITE (stdout,10) trim(vname(1,idxgrp)), &
2679 & trim(ncname)
2680 exit_flag=3
2681 ioerror=status
2682 END IF
2683 ELSE
2684 IF (master) WRITE (stdout,20) trim(vname(1,idxgrp)), &
2685 & trim(ncname)
2686 exit_flag=3
2687 ioerror=nf90_enotvar
2688 END IF
2689#endif
2690 END IF
2691 END IF
2692!
2693 IF (exit_flag.eq.noerror) THEN
2694 IF ((ncid.ne.sta(ng)%ncid).and. &
2695 & (ncid.ne.xtr(ng)%ncid)) THEN
2696 scale=1.0_dp
2697 IF (find_string(var_name, n_var, trim(vname(1,idygrp)), &
2698 & varid)) THEN
2699 status=nf_fwrite2d(ng, model, ncid, idygrp, &
2700 & varid, 0, p2dvar, &
2701 & lbi, ubi, lbj, ubj, scale, &
2702#ifdef MASKING
2703 & grid(ng) % pmask, &
2704#endif
2705 & grid(ng) % yp, &
2706 & setfillval = .false.)
2707 IF (founderror(status, nf90_noerr, &
2708 & __line__, myfile)) THEN
2709 IF (master) WRITE (stdout,10) trim(vname(1,idygrp)), &
2710 & trim(ncname)
2711 exit_flag=3
2712 ioerror=status
2713 END IF
2714 ELSE
2715 IF (master) WRITE (stdout,20) trim(vname(1,idygrp)), &
2716 & trim(ncname)
2717 exit_flag=3
2718 ioerror=nf90_enotvar
2719 END IF
2720#ifdef GRID_EXTRACT
2721 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2722 scale=1.0_dp
2723 IF (find_string(var_name, n_var, trim(vname(1,idygrp)), &
2724 & varid)) THEN
2725 status=nf_fwrite2d(ng, model, ncid, idygrp, &
2726 & varid, 0, p2dvar, &
2727 & lbi, ubi, lbj, ubj, scale, &
2728# ifdef MASKING
2729 & extract(ng) % pmask, &
2730# endif
2731 & extract(ng) % yp, &
2732 & setfillval = .false., &
2733 & extractfield = -1)
2734 IF (founderror(status, nf90_noerr, &
2735 & __line__, myfile)) THEN
2736 IF (master) WRITE (stdout,10) trim(vname(1,idygrp)), &
2737 & trim(ncname)
2738 exit_flag=3
2739 ioerror=status
2740 END IF
2741 ELSE
2742 IF (master) WRITE (stdout,20) trim(vname(1,idygrp)), &
2743 & trim(ncname)
2744 exit_flag=3
2745 ioerror=nf90_enotvar
2746 END IF
2747#endif
2748 END IF
2749 END IF
2750 END IF
2751
2752#ifdef CURVGRID
2753!
2754! Angle between XI-axis and EAST at RHO-points.
2755!
2756 IF (exit_flag.eq.noerror) THEN
2757 scale=1.0_dp
2758 IF ((ncid.ne.sta(ng)%ncid).and. &
2759 & (ncid.ne.xtr(ng)%ncid)) THEN
2760 IF (find_string(var_name, n_var, trim(vname(1,idangr)), &
2761 & varid)) THEN
2762 status=nf_fwrite2d(ng, model, ncid, idangr, &
2763 & varid, 0, r2dvar, &
2764 & lbi, ubi, lbj, ubj, scale, &
2765# ifdef MASKING
2766 & grid(ng) % rmask, &
2767# endif
2768 & grid(ng) % angler, &
2769 & setfillval = .false.)
2770 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2771 IF (master) WRITE (stdout,10) trim(vname(1,idangr)), &
2772 & trim(ncname)
2773 exit_flag=3
2774 ioerror=status
2775 END IF
2776 ELSE
2777 IF (master) WRITE (stdout,20) trim(vname(1,idangr)), &
2778 & trim(ncname)
2779 exit_flag=3
2780 ioerror=nf90_enotvar
2781 END IF
2782# ifdef GRID_EXTRACT
2783 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2784 IF (find_string(var_name, n_var, trim(vname(1,idangr)), &
2785 & varid)) THEN
2786 status=nf_fwrite2d(ng, model, ncid, idangr, &
2787 & varid, 0, r2dvar, &
2788 & lbi, ubi, lbj, ubj, scale, &
2789# ifdef MASKING
2790 & extract(ng) % rmask, &
2791# endif
2792 & extract(ng) % angler, &
2793 & setfillval = .false., &
2794 & extractfield = -1)
2795 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2796 IF (master) WRITE (stdout,10) trim(vname(1,idangr)), &
2797 & trim(ncname)
2798 exit_flag=3
2799 ioerror=status
2800 END IF
2801 ELSE
2802 IF (master) WRITE (stdout,20) trim(vname(1,idangr)), &
2803 & trim(ncname)
2804 exit_flag=3
2805 ioerror=nf90_enotvar
2806 END IF
2807# endif
2808# ifdef STATIONS
2809 ELSE IF (ncid.eq.sta(ng)%ncid) THEN
2810 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
2811 & lbi, ubi, lbj, ubj, &
2812 & scale, grid(ng)%angler, &
2813 & nstation(ng), scalars(ng)%SposX, &
2814 & scalars(ng)%SposY, wrk)
2815 CALL netcdf_put_fvar (ng, model, ncname, vname(1,idangr), &
2816 & wrk, (/1/), (/nstation(ng)/), &
2817 & ncid = ncid)
2818 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2819# endif
2820 END IF
2821 END IF
2822#endif
2823
2824#ifdef MASKING
2825!
2826! Masking fields at RHO-, U-, V-points, and PSI-points.
2827!
2828 IF (exit_flag.eq.noerror) THEN
2829 IF ((ncid.ne.sta(ng)%ncid).and. &
2830 & (ncid.ne.xtr(ng)%ncid)) THEN
2831 scale=1.0_dp
2832 IF (find_string(var_name, n_var, trim(vname(1,idmskr)), &
2833 & varid)) THEN
2834 status=nf_fwrite2d(ng, model, ncid, idmskr, &
2835 & varid, 0, r2dvar, &
2836 & lbi, ubi, lbj, ubj, scale, &
2837 & grid(ng) % rmask, &
2838 & grid(ng) % rmask, &
2839 & setfillval = .false.)
2840 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2841 IF (master) WRITE (stdout,10) trim(vname(1,idmskr)), &
2842 & trim(ncname)
2843 exit_flag=3
2844 ioerror=status
2845 END IF
2846 ELSE
2847 IF (master) WRITE (stdout,20) trim(vname(1,idmskr)), &
2848 & trim(ncname)
2849 exit_flag=3
2850 ioerror=nf90_enotvar
2851 END IF
2852# ifdef GRID_EXTRACT
2853 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2854 scale=1.0_dp
2855 IF (find_string(var_name, n_var, trim(vname(1,idmskr)), &
2856 & varid)) THEN
2857 status=nf_fwrite2d(ng, model, ncid, idmskr, &
2858 & varid, 0, r2dvar, &
2859 & lbi, ubi, lbj, ubj, scale, &
2860 & extract(ng) % rmask, &
2861 & extract(ng) % rmask, &
2862 & setfillval = .false., &
2863 & extractfield = -1)
2864 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2865 IF (master) WRITE (stdout,10) trim(vname(1,idmskr)), &
2866 & trim(ncname)
2867 exit_flag=3
2868 ioerror=status
2869 END IF
2870 ELSE
2871 IF (master) WRITE (stdout,20) trim(vname(1,idmskr)), &
2872 & trim(ncname)
2873 exit_flag=3
2874 ioerror=nf90_enotvar
2875 END IF
2876# endif
2877 END IF
2878 END IF
2879!
2880 IF (exit_flag.eq.noerror) THEN
2881 IF ((ncid.ne.sta(ng)%ncid).and. &
2882 & (ncid.ne.xtr(ng)%ncid)) THEN
2883 scale=1.0_dp
2884 IF (find_string(var_name, n_var, trim(vname(1,idmsku)), &
2885 & varid)) THEN
2886 status=nf_fwrite2d(ng, model, ncid, idmsku, &
2887 & varid, 0, u2dvar, &
2888 & lbi, ubi, lbj, ubj, scale, &
2889 & grid(ng) % umask, &
2890 & grid(ng) % umask, &
2891 & setfillval = .false.)
2892 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2893 IF (master) WRITE (stdout,10) trim(vname(1,idmsku)), &
2894 & trim(ncname)
2895 exit_flag=3
2896 ioerror=status
2897 END IF
2898 ELSE
2899 IF (master) WRITE (stdout,20) trim(vname(1,idmsku)), &
2900 & trim(ncname)
2901 exit_flag=3
2902 ioerror=nf90_enotvar
2903 END IF
2904# ifdef GRID_EXTRACT
2905 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2906 scale=1.0_dp
2907 IF (find_string(var_name, n_var, trim(vname(1,idmsku)), &
2908 & varid)) THEN
2909 status=nf_fwrite2d(ng, model, ncid, idmsku, &
2910 & varid, 0, u2dvar, &
2911 & lbi, ubi, lbj, ubj, scale, &
2912 & extract(ng) % umask, &
2913 & extract(ng) % umask, &
2914 & setfillval = .false., &
2915 & extractfield = -1)
2916 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2917 IF (master) WRITE (stdout,10) trim(vname(1,idmsku)), &
2918 & trim(ncname)
2919 exit_flag=3
2920 ioerror=status
2921 END IF
2922 ELSE
2923 IF (master) WRITE (stdout,20) trim(vname(1,idmsku)), &
2924 & trim(ncname)
2925 exit_flag=3
2926 ioerror=nf90_enotvar
2927 END IF
2928# endif
2929 END IF
2930 END IF
2931!
2932 IF (exit_flag.eq.noerror) THEN
2933 IF ((ncid.ne.sta(ng)%ncid).and. &
2934 & (ncid.ne.xtr(ng)%ncid)) THEN
2935 scale=1.0_dp
2936 IF (find_string(var_name, n_var, trim(vname(1,idmskv)), &
2937 & varid)) THEN
2938 status=nf_fwrite2d(ng, model, ncid, idmskv, &
2939 & varid, 0, v2dvar, &
2940 & lbi, ubi, lbj, ubj, scale, &
2941 & grid(ng) % vmask, &
2942 & grid(ng) % vmask, &
2943 & setfillval = .false.)
2944 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2945 IF (master) WRITE (stdout,10) trim(vname(1,idmskv)), &
2946 & trim(ncname)
2947 exit_flag=3
2948 ioerror=status
2949 END IF
2950 ELSE
2951 IF (master) WRITE (stdout,20) trim(vname(1,idmskv)), &
2952 & trim(ncname)
2953 exit_flag=3
2954 ioerror=nf90_enotvar
2955 END IF
2956# ifdef GRID_EXTRACT
2957 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
2958 scale=1.0_dp
2959 IF (find_string(var_name, n_var, trim(vname(1,idmskv)), &
2960 & varid)) THEN
2961 status=nf_fwrite2d(ng, model, ncid, idmskv, &
2962 & varid, 0, v2dvar, &
2963 & lbi, ubi, lbj, ubj, scale, &
2964 & extract(ng) % vmask, &
2965 & extract(ng) % vmask, &
2966 & setfillval = .false., &
2967 & extractfield = -1)
2968 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2969 IF (master) WRITE (stdout,10) trim(vname(1,idmskv)), &
2970 & trim(ncname)
2971 exit_flag=3
2972 ioerror=status
2973 END IF
2974 ELSE
2975 IF (master) WRITE (stdout,20) trim(vname(1,idmskv)), &
2976 & trim(ncname)
2977 exit_flag=3
2978 ioerror=nf90_enotvar
2979 END IF
2980# endif
2981 END IF
2982 END IF
2983!
2984 IF (exit_flag.eq.noerror) THEN
2985 IF ((ncid.ne.sta(ng)%ncid).and. &
2986 & (ncid.ne.xtr(ng)%ncid)) THEN
2987 scale=1.0_dp
2988 IF (find_string(var_name, n_var, trim(vname(1,idmskp)), &
2989 & varid)) THEN
2990 status=nf_fwrite2d(ng, model, ncid, idmskp, &
2991 & varid, 0, p2dvar, &
2992 & lbi, ubi, lbj, ubj, scale, &
2993 & grid(ng) % pmask, &
2994 & grid(ng) % pmask, &
2995 & setfillval = .false.)
2996 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2997 IF (master) WRITE (stdout,10) trim(vname(1,idmskp)), &
2998 & trim(ncname)
2999 exit_flag=3
3000 ioerror=status
3001 END IF
3002 ELSE
3003 IF (master) WRITE (stdout,20) trim(vname(1,idmskp)), &
3004 & trim(ncname)
3005 exit_flag=3
3006 ioerror=nf90_enotvar
3007 END IF
3008# ifdef GRID_EXTRACT
3009 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
3010 scale=1.0_dp
3011 IF (find_string(var_name, n_var, trim(vname(1,idmskp)), &
3012 & varid)) THEN
3013 status=nf_fwrite2d(ng, model, ncid, idmskp, &
3014 & varid, 0, p2dvar, &
3015 & lbi, ubi, lbj, ubj, scale, &
3016 & extract(ng) % pmask, &
3017 & extract(ng) % pmask, &
3018 & setfillval = .false., &
3019 & extractfield = -1)
3020 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3021 IF (master) WRITE (stdout,10) trim(vname(1,idmskp)), &
3022 & trim(ncname)
3023 exit_flag=3
3024 ioerror=status
3025 END IF
3026 ELSE
3027 IF (master) WRITE (stdout,20) trim(vname(1,idmskp)), &
3028 & trim(ncname)
3029 exit_flag=3
3030 ioerror=nf90_enotvar
3031 END IF
3032# endif
3033 END IF
3034 END IF
3035#endif
3036
3037#if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
3038 defined opt_observations || defined sensitivity_4dvar || \
3039 defined so_semi
3040!
3041! Adjoint sensitivity spatial scope mask at RHO-, U-, and V-points.
3042!
3043 IF (exit_flag.eq.noerror) THEN
3044 IF ((ncid.ne.sta(ng)%ncid).and. &
3045 & (ncid.ne.xtr(ng)%ncid)) THEN
3046 scale=1.0_dp
3047 IF (find_string(var_name, n_var, trim(vname(1,idscor)), &
3048 & varid)) THEN
3049 status=nf_fwrite2d(ng, model, ncid, idscor, &
3050 & varid, 0, r2dvar, &
3051 & lbi, ubi, lbj, ubj, scale, &
3052# ifdef MASKING
3053 & grid(ng) % rmask, &
3054# endif
3055 & grid(ng) % Rscope, &
3056 & setfillval = .false.)
3057 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3058 IF (master) WRITE (stdout,10) trim(vname(1,idscor)), &
3059 & trim(ncname)
3060 exit_flag=3
3061 ioerror=status
3062 END IF
3063 ELSE
3064 IF (master) WRITE (stdout,20) trim(vname(1,idscor)), &
3065 & trim(ncname)
3066 exit_flag=3
3067 ioerror=nf90_enotvar
3068 END IF
3069 END IF
3070# ifdef GRID_EXTRACT
3071 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
3072 scale=1.0_dp
3073 IF (find_string(var_name, n_var, trim(vname(1,idscor)), &
3074 & varid)) THEN
3075 status=nf_fwrite2d(ng, model, ncid, idscor, &
3076 & varid, 0, r2dvar, &
3077 & lbi, ubi, lbj, ubj, scale, &
3078# ifdef MASKING
3079 & extract(ng) % rmask, &
3080# endif
3081 & extract(ng) % Rscope, &
3082 & setfillval = .false., &
3083 & extractfield = -1)
3084 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3085 IF (master) WRITE (stdout,10) trim(vname(1,idscor)), &
3086 & trim(ncname)
3087 exit_flag=3
3088 ioerror=status
3089 END IF
3090 ELSE
3091 IF (master) WRITE (stdout,20) trim(vname(1,idscor)), &
3092 & trim(ncname)
3093 exit_flag=3
3094 ioerror=nf90_enotvar
3095 END IF
3096 END IF
3097# endif
3098 END IF
3099!
3100 IF (exit_flag.eq.noerror) THEN
3101 IF ((ncid.ne.sta(ng)%ncid).and. &
3102 & (ncid.ne.xtr(ng)%ncid)) THEN
3103 scale=1.0_dp
3104 IF (find_string(var_name, n_var, trim(vname(1,idscou)), &
3105 & varid)) THEN
3106 status=nf_fwrite2d(ng, model, ncid, idscou, &
3107 & varid, 0, u2dvar, &
3108 & lbi, ubi, lbj, ubj, scale, &
3109# ifdef MASKING
3110 & grid(ng) % umask, &
3111# endif
3112 & grid(ng) % Uscope, &
3113 & setfillval = .false.)
3114 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3115 IF (master) WRITE (stdout,10) trim(vname(1,idscou)), &
3116 & trim(ncname)
3117 exit_flag=3
3118 ioerror=status
3119 END IF
3120 ELSE
3121 IF (master) WRITE (stdout,20) trim(vname(1,idscou)), &
3122 & trim(ncname)
3123 exit_flag=3
3124 ioerror=nf90_enotvar
3125 END IF
3126 END IF
3127# ifdef GRID_EXTRACT
3128 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
3129 scale=1.0_dp
3130 IF (find_string(var_name, n_var, trim(vname(1,idscou)), &
3131 & varid)) THEN
3132 status=nf_fwrite2d(ng, model, ncid, idscou, &
3133 & varid, 0, u2dvar, &
3134 & lbi, ubi, lbj, ubj, scale, &
3135# ifdef MASKING
3136 & extract(ng) % umask, &
3137# endif
3138 & extract(ng) % Uscope, &
3139 & setfillval = .false., &
3140 & extractfield = -1)
3141 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3142 IF (master) WRITE (stdout,10) trim(vname(1,idscou)), &
3143 & trim(ncname)
3144 exit_flag=3
3145 ioerror=status
3146 END IF
3147 ELSE
3148 IF (master) WRITE (stdout,20) trim(vname(1,idscou)), &
3149 & trim(ncname)
3150 exit_flag=3
3151 ioerror=nf90_enotvar
3152 END IF
3153 END IF
3154# endif
3155 END IF
3156!
3157 IF (exit_flag.eq.noerror) THEN
3158 IF ((ncid.ne.sta(ng)%ncid).and. &
3159 & (ncid.ne.xtr(ng)%ncid)) THEN
3160 scale=1.0_dp
3161 IF (find_string(var_name, n_var, trim(vname(1,idscov)), &
3162 & varid)) THEN
3163 status=nf_fwrite2d(ng, model, ncid, idscov, &
3164 & varid, 0, v2dvar, &
3165 & lbi, ubi, lbj, ubj, scale, &
3166# ifdef MASKING
3167 & grid(ng) % vmask, &
3168# endif
3169 & grid(ng) % Vscope, &
3170 & setfillval = .false.)
3171 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3172 IF (master) WRITE (stdout,10) trim(vname(1,idscov)), &
3173 & trim(ncname)
3174 exit_flag=3
3175 ioerror=status
3176 END IF
3177 ELSE
3178 IF (master) WRITE (stdout,20) trim(vname(1,idscov)), &
3179 & trim(ncname)
3180 exit_flag=3
3181 ioerror=nf90_enotvar
3182 END IF
3183 END IF
3184# ifdef GRID_EXTRACT
3185 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
3186 scale=1.0_dp
3187 IF (find_string(var_name, n_var, trim(vname(1,idscov)), &
3188 & varid)) THEN
3189 status=nf_fwrite2d(ng, model, ncid, idscov, &
3190 & varid, 0, v2dvar, &
3191 & lbi, ubi, lbj, ubj, scale, &
3192# ifdef MASKING
3193 & extract(ng) % vmask, &
3194# endif
3195 & extract(ng) % Vscope, &
3196 & setfillval = .false., &
3197 & extractfield = -1)
3198 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3199 IF (master) WRITE (stdout,10) trim(vname(1,idscov)), &
3200 & trim(ncname)
3201 exit_flag=3
3202 ioerror=status
3203 END IF
3204 ELSE
3205 IF (master) WRITE (stdout,20) trim(vname(1,idscov)), &
3206 & trim(ncname)
3207 exit_flag=3
3208 ioerror=nf90_enotvar
3209 END IF
3210 END IF
3211# endif
3212 END IF
3213#endif
3214#ifdef UV_DRAG_GRID
3215!
3216! Spatially bottom friction parameter.
3217!
3218 IF (exit_flag.eq.noerror) THEN
3219 IF ((ncid.ne.sta(ng)%ncid).and. &
3220 & (ncid.ne.xtr(ng)%ncid)) THEN
3221 scale=1.0_dp
3222# if defined UV_LOGDRAG || defined BBL_MODEL
3223 IF (find_string(var_name, n_var, trim(vname(1,idzobl)), &
3224 & varid)) THEN
3225 status=nf_fwrite2d(ng, model, ncid, idzobl, &
3226 & varid, 0, r2dvar, &
3227 & lbi, ubi, lbj, ubj, scale, &
3228# ifdef MASKING
3229 & grid(ng) % rmask, &
3230# endif
3231 & grid(ng) % ZoBot, &
3232 & setfillval = .false.)
3233 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3234 IF (master) WRITE (stdout,10) trim(vname(1,idzobl)), &
3235 & trim(ncname)
3236 exit_flag=3
3237 ioerror=status
3238 END IF
3239 ELSE
3240 IF (master) WRITE (stdout,20) trim(vname(1,idzobl)), &
3241 & trim(ncname)
3242 exit_flag=3
3243 ioerror=nf90_enotvar
3244 END IF
3245# ifdef GRID_EXTRACT
3246 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
3247 scale=1.0_dp
3248 IF (find_string(var_name, n_var, trim(vname(1,idzobl)), &
3249 & varid)) THEN
3250 status=nf_fwrite2d(ng, model, ncid, idzobl, &
3251 & varid, 0, r2dvar, &
3252 & lbi, ubi, lbj, ubj, scale, &
3253# ifdef MASKING
3254 & extract(ng) % rmask, &
3255# endif
3256 & extract(ng) % ZoBot, &
3257 & setfillval = .false., &
3258 & extractfield = -1)
3259 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3260 IF (master) WRITE (stdout,10) trim(vname(1,idzobl)), &
3261 & trim(ncname)
3262 exit_flag=3
3263 ioerror=status
3264 END IF
3265 ELSE
3266 IF (master) WRITE (stdout,20) trim(vname(1,idzobl)), &
3267 & trim(ncname)
3268 exit_flag=3
3269 ioerror=nf90_enotvar
3270 END IF
3271# endif
3272# endif
3273 END IF
3274# ifdef UV_LDRAG
3275 IF ((ncid.ne.sta(ng)%ncid).and. &
3276 & (ncid.ne.xtr(ng)%ncid)) THEN
3277 IF (find_string(var_name, n_var, trim(vname(1,idragl)), &
3278 & varid)) THEN
3279 status=nf_fwrite2d(ng, model, ncid, idragl, &
3280 & varid, 0, r2dvar, &
3281 & lbi, ubi, lbj, ubj, scale, &
3282# ifdef MASKING
3283 & grid(ng) % rmask, &
3284# endif
3285 & grid(ng) % rdrag, &
3286 & setfillval = .false.)
3287 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3288 IF (master) WRITE (stdout,10) trim(vname(1,idragl)), &
3289 & trim(ncname)
3290 exit_flag=3
3291 ioerror=status
3292 END IF
3293 ELSE
3294 IF (master) WRITE (stdout,20) trim(vname(1,idragl)), &
3295 & trim(ncname)
3296 exit_flag=3
3297 ioerror=nf90_enotvar
3298 END IF
3299# ifdef GRID_EXTRACT
3300 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
3301 IF (find_string(var_name, n_var, trim(vname(1,idragl)), &
3302 & varid)) THEN
3303 status=nf_fwrite2d(ng, model, ncid, idragl, &
3304 & varid, 0, r2dvar, &
3305 & lbi, ubi, lbj, ubj, scale, &
3306# ifdef MASKING
3307 & extract(ng) % rmask, &
3308# endif
3309 & extract(ng) % rdrag, &
3310 & setfillval = .false., &
3311 & extractfield = -1)
3312 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3313 IF (master) WRITE (stdout,10) trim(vname(1,idragl)), &
3314 & trim(ncname)
3315 exit_flag=3
3316 ioerror=status
3317 END IF
3318 ELSE
3319 IF (master) WRITE (stdout,20) trim(vname(1,idragl)), &
3320 & trim(ncname)
3321 exit_flag=3
3322 ioerror=nf90_enotvar
3323 END IF
3324# endif
3325 END IF
3326# endif
3327# ifdef UV_QDRAG
3328 IF ((ncid.ne.sta(ng)%ncid).and. &
3329 & (ncid.ne.xtr(ng)%ncid)) THEN
3330 IF (find_string(var_name, n_var, trim(vname(1,idragq)), &
3331 & varid)) THEN
3332 status=nf_fwrite2d(ng, model, ncid, idragq, &
3333 & varid, 0, r2dvar, &
3334 & lbi, ubi, lbj, ubj, scale, &
3335# ifdef MASKING
3336 & grid(ng) % rmask, &
3337# endif
3338 & grid(ng) % rdrag2, &
3339 & setfillval = .false.)
3340 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3341 IF (master) WRITE (stdout,10) trim(vname(1,idragq)), &
3342 & trim(ncname)
3343 exit_flag=3
3344 ioerror=status
3345 END IF
3346 ELSE
3347 IF (master) WRITE (stdout,20) trim(vname(1,idragq)), &
3348 & trim(ncname)
3349 exit_flag=3
3350 ioerror=nf90_enotvar
3351 END IF
3352# ifdef GRID_EXTRACT
3353 ELSE IF (ncid.eq.xtr(ng)%ncid) THEN
3354 IF (find_string(var_name, n_var, trim(vname(1,idragq)), &
3355 & varid)) THEN
3356 status=nf_fwrite2d(ng, model, ncid, idragq, &
3357 & varid, 0, r2dvar, &
3358 & lbi, ubi, lbj, ubj, scale, &
3359# ifdef MASKING
3360 & extract(ng) % rmask, &
3361# endif
3362 & extract(ng) % rdrag2, &
3363 & setfillval = .false., &
3364 & extractfield = -1)
3365 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3366 IF (master) WRITE (stdout,10) trim(vname(1,idragq)), &
3367 & trim(ncname)
3368 exit_flag=3
3369 ioerror=status
3370 END IF
3371 ELSE
3372 IF (master) WRITE (stdout,20) trim(vname(1,idragq)), &
3373 & trim(ncname)
3374 exit_flag=3
3375 ioerror=nf90_enotvar
3376 END IF
3377# endif
3378 END IF
3379# endif
3380 END IF
3381#endif
3382 END IF grid_vars
3383!
3384!-----------------------------------------------------------------------
3385! Synchronize NetCDF file to disk to allow other processes to access
3386! data immediately after it is written.
3387!-----------------------------------------------------------------------
3388!
3389 CALL netcdf_sync (ng, model, ncname, ncid)
3390 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3391
3392#if !defined PARALLEL_IO && defined DISTRIBUTE
3393!
3394! Broadcast error flags to all processors in the group.
3395!
3396 ibuffer(1)=exit_flag
3397 ibuffer(2)=ioerror
3398 CALL mp_bcasti (ng, model, ibuffer)
3399 exit_flag=ibuffer(1)
3400 ioerror=ibuffer(2)
3401#endif
3402!
3403 10 FORMAT (/,' WRT_INFO_NF90 - error while writing variable: ',a,/, &
3404 & 17x,'into file: ',a)
3405 20 FORMAT (/,' WRT_INFO_NF90 - error while inquiring ID for', &
3406 & ' variable: ',a,/,17x,'in file: ',a)
3407 30 FORMAT (/,' WRT_INFO_NF90 - unable to synchronize to disk file:', &
3408 & /,17x,a)
3409!
3410 RETURN
distribute_mod::mp_bcasti
Definition distribute.F:95
distribute_mod
Definition distribute.F:3

◆ wrt_info_pio()

subroutine wrt_info_mod::wrt_info_pio ( integer, intent(in) ng,
integer, intent(in) model,
type (file_desc_t), intent(inout) piofile,
character (len=*), intent(in) ncname )

Definition at line 3416 of file wrt_info.F.

3417!***********************************************************************
3418! !
3419! This routine writes out information variables into requested !
3420! NetCDF file using the standard NetCDF-3 or NetCDF-4 library. !
3421! !
3422! On Input: !
3423! !
3424! ng Nested grid number (integer) !
3425! model Calling model identifier (integer) !
3426! pioFile PIO file descriptor structure, TYPE(File_desc_t) !
3427! pioFile%fh file handler !
3428! pioFile%iosystem IO system descriptor (struct) !
3429! ncname PIO filename (string) !
3430! !
3431! On Output: !
3432! !
3433! exit_flag Error flag (integer) stored in MOD_SCALARS !
3434! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
3435! !
3436!***********************************************************************
3437!
3438 USE mod_pio_netcdf
3439!
3440! Imported variable declarations.
3441!
3442 integer, intent(in) :: ng, model
3443!
3444 character (len=*), intent(in) :: ncname
3445!
3446 TYPE (File_desc_t), intent(inout) :: pioFile
3447!
3448! Local variable declarations.
3449!
3450 logical :: Cgrid = .true.
3451!
3452 integer :: LBi, UBi, LBj, UBj
3453 integer :: i, j, k, ibry, ilev, itrc, status
3454 integer :: ival
3455 integer :: FileH, MY_FOUT
3456
3457 integer :: ifield = 0
3458!
3459 real(dp) :: scale
3460# ifdef SOLVE3D
3461# ifdef TS_DIF4
3462 real(r8), dimension(NT(ng)) :: diff
3463# endif
3464 real(r8), dimension(NT(ng)) :: nudg
3465 real(r8), dimension(NT(ng),4) :: Tobc
3466# endif
3467# ifdef STATIONS
3468 real(r8), dimension(Nstation(ng)) :: Zpos, wrk
3469# endif
3470!
3471 character (len=*), parameter :: MyFile = &
3472 & __FILE__//", wrt_info_pio"
3473!
3474 TYPE (IO_desc_t), pointer :: ioDesc
3475 TYPE (My_VarDesc) :: pioVar
3476!
3477 sourcefile=myfile
3478!
3479 lbi=lbound(grid(ng)%h,dim=1)
3480 ubi=ubound(grid(ng)%h,dim=1)
3481 lbj=lbound(grid(ng)%h,dim=2)
3482 ubj=ubound(grid(ng)%h,dim=2)
3483!
3484!-----------------------------------------------------------------------
3485! Write out running parameters.
3486!-----------------------------------------------------------------------
3487!
3488! Get NetCDF file handler from descriptor.
3489!
3490 fileh=abs(piofile%fh)
3491!
3492! Time stepping parameters.
3493!
3494 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ntimes', &
3495 & ntimes(ng), (/0/), (/0/), &
3496 & piofile = piofile)
3497 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3498
3499 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ndtfast', &
3500 & ndtfast(ng), (/0/), (/0/), &
3501 & piofile = piofile)
3502 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3503
3504 CALL pio_netcdf_put_fvar (ng, model, ncname, 'dt', &
3505 & dt(ng), (/0/), (/0/), &
3506 & piofile = piofile)
3507 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3508
3509 CALL pio_netcdf_put_fvar (ng, model, ncname, 'dtfast', &
3510 & dtfast(ng), (/0/), (/0/), &
3511 & piofile = piofile)
3512 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3513
3514 CALL pio_netcdf_put_fvar (ng, model, ncname, 'dstart', &
3515 & dstart, (/0/), (/0/), &
3516 & piofile = piofile)
3517 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3518
3519# ifdef RBL4DVAR_FCT_SENSITIVITY
3520 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ntimes_ana', &
3521 & ntimes_ana(ng), (/0/), (/0/), &
3522 & piofile = piofile)
3523 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3524
3525 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ntimes_fct', &
3526 & ntimes_fct(ng), (/0/), (/0/), &
3527 & piofile = piofile)
3528 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3529# endif
3530
3531# if defined HDF5 && defined DEFLATE
3532 CALL pio_netcdf_put_ivar (ng, model, ncname, 'shuffle', &
3533 & shuffle, (/0/), (/0/), &
3534 & piofile = piofile)
3535 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3536
3537 CALL pio_netcdf_put_ivar (ng, model, ncname, 'deflate', &
3538 & deflate, (/0/), (/0/), &
3539 & piofile = piofile)
3540 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3541
3542 CALL pio_netcdf_put_ivar (ng, model, ncname, 'deflate_level', &
3543 & deflate_level, (/0/), (/0/), &
3544 & piofile = piofile)
3545 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3546# endif
3547
3548 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nHIS', &
3549 & nhis(ng), (/0/), (/0/), &
3550 & piofile = piofile)
3551 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3552
3553 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ndefHIS', &
3554 & ndefhis(ng), (/0/), (/0/), &
3555 & piofile = piofile)
3556 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3557
3558 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nRST', &
3559 & nrst(ng), (/0/), (/0/), &
3560 & piofile = piofile)
3561 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3562
3563# if defined AVERAGES || \
3564 (defined ad_averages && defined adjoint) || \
3565 (defined rp_averages && defined tl_ioms) || \
3566 (defined tl_averages && defined tangent)
3567 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ntsAVG', &
3568 & ntsavg(ng), (/0/), (/0/), &
3569 & piofile = piofile)
3570 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3571
3572 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nAVG', &
3573 & navg(ng), (/0/), (/0/), &
3574 & piofile = piofile)
3575 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3576
3577 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ndefAVG', &
3578 & ndefavg(ng), (/0/), (/0/), &
3579 & piofile = piofile)
3580 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3581# endif
3582
3583# ifdef ADJOINT
3584 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nADJ', &
3585 & nadj(ng), (/0/), (/0/), &
3586 & piofile = piofile)
3587 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3588
3589 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ndefADJ', &
3590 & ndefadj(ng), (/0/), (/0/), &
3591 & piofile = piofile)
3592 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3593# endif
3594
3595# ifdef TANGENT
3596 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nTLM', &
3597 & ntlm(ng), (/0/), (/0/), &
3598 & piofile = piofile)
3599 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3600
3601 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ndefTLM', &
3602 & ndeftlm(ng), (/0/), (/0/), &
3603 & piofile = piofile)
3604 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3605# endif
3606
3607# ifdef ADJUST_BOUNDARY
3608 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nOBC', &
3609 & nobc(ng), (/0/), (/0/), &
3610 & piofile = piofile)
3611 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3612# endif
3613
3614# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
3615 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nSFF', &
3616 & nsff(ng), (/0/), (/0/), &
3617 & piofile = piofile)
3618 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3619# endif
3620
3621# ifdef PROPAGATOR
3622 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LmultiGST', &
3623 & lmultigst, (/0/), (/0/), &
3624 & piofile = piofile)
3625 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3626
3627 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LrstGST', &
3628 & lrstgst, (/0/), (/0/), &
3629 & piofile = piofile)
3630 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3631
3632 CALL pio_netcdf_put_ivar (ng, model, ncname, 'MaxIterGST', &
3633 & maxitergst, (/0/), (/0/), &
3634 & piofile = piofile)
3635 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3636
3637 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nGST', &
3638 & ngst, (/0/), (/0/), &
3639 & piofile = piofile)
3640 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3641
3642 CALL pio_netcdf_put_ivar (ng, model, ncname, 'NEV', &
3643 & nev, (/0/), (/0/), &
3644 & piofile = piofile)
3645 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3646
3647 CALL pio_netcdf_put_ivar (ng, model, ncname, 'NCV', &
3648 & ncv, (/0/), (/0/), &
3649 & piofile = piofile)
3650 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3651
3652 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Ritz_tol', &
3653 & ritz_tol, (/0/), (/0/), &
3654 & piofile = piofile)
3655 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3656# endif
3657
3658# ifdef DIAGNOSTICS
3659 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ntsDIA', &
3660 & ntsdia(ng), (/0/), (/0/), &
3661 & piofile = piofile)
3662 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3663
3664 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nDIA', &
3665 & ndia(ng), (/0/), (/0/), &
3666 & piofile = piofile)
3667 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3668
3669 CALL pio_netcdf_put_ivar (ng, model, ncname, 'ndefDIA', &
3670 & ndefdia(ng), (/0/), (/0/), &
3671 & piofile = piofile)
3672 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3673# endif
3674
3675# ifdef STATIONS
3676 CALL pio_netcdf_put_ivar (ng, model, ncname, 'nSTA', &
3677 & nsta(ng), (/0/), (/0/), &
3678 & piofile = piofile)
3679 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3680# endif
3681
3682# ifdef FOUR_DVAR
3683 CALL pio_netcdf_put_ivar (ng, model, ncname, 'Nouter', &
3684 & nouter, (/0/), (/0/), &
3685 & piofile = piofile)
3686 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3687
3688 CALL pio_netcdf_put_ivar (ng, model, ncname, 'Ninner', &
3689 & ninner, (/0/), (/0/), &
3690 & piofile = piofile)
3691 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3692# endif
3693
3694# if defined POWER_LAW && defined SOLVE3D
3695!
3696! Power-law shape filter parameters for time-averaging of barotropic
3697! fields.
3698!
3699 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Falpha', &
3700 & falpha, (/0/), (/0/), &
3701 & piofile = piofile)
3702 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3703
3704 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Fbeta', &
3705 & fbeta, (/0/), (/0/), &
3706 & piofile = piofile)
3707 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3708
3709 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Fgamma', &
3710 & fgamma, (/0/), (/0/), &
3711 & piofile = piofile)
3712 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3713# endif
3714!
3715! Horizontal mixing coefficients.
3716!
3717# if defined SOLVE3D && defined TS_DIF2
3718 CALL pio_netcdf_put_fvar (ng, model, ncname, 'nl_tnu2', &
3719 & nl_tnu2(:,ng), (/1/), (/nt(ng)/), &
3720 & piofile = piofile)
3721 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3722
3723# ifdef ADJOINT
3724 CALL pio_netcdf_put_fvar (ng, model, ncname, 'ad_tnu2', &
3725 & ad_tnu2(:,ng), (/1/), (/nt(ng)/), &
3726 & piofile = piofile)
3727 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3728# endif
3729
3730# if defined TANGENT || defined TL_IOMS
3731 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tl_tnu2', &
3732 & tl_tnu2(:,ng), (/1/), (/nt(ng)/), &
3733 & piofile = piofile)
3734 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3735# endif
3736
3737# endif
3738
3739# if defined SOLVE3D && defined TS_DIF4
3740 DO itrc=1,nt(ng)
3741 diff(itrc)=nl_tnu4(itrc,ng)*nl_tnu4(itrc,ng)
3742 END DO
3743 CALL pio_netcdf_put_fvar (ng, model, ncname, 'nl_tnu4', &
3744 & diff, (/1/), (/nt(ng)/), &
3745 & piofile = piofile)
3746 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3747
3748# ifdef ADJOINT
3749 DO itrc=1,nt(ng)
3750 diff(itrc)=ad_tnu4(itrc,ng)*ad_tnu4(itrc,ng)
3751 END DO
3752 CALL pio_netcdf_put_fvar (ng, model, ncname, 'ad_tnu4', &
3753 & diff, (/1/), (/nt(ng)/), &
3754 & piofile = piofile)
3755 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3756# endif
3757
3758# if defined TANGENT || defined TL_IOMS
3759 DO itrc=1,nt(ng)
3760 diff(itrc)=tl_tnu4(itrc,ng)*tl_tnu4(itrc,ng)
3761 END DO
3762 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tl_tnu4', &
3763 & diff, (/1/), (/nt(ng)/), &
3764 & piofile = piofile)
3765 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3766# endif
3767# endif
3768
3769# ifdef UV_VIS2
3770 CALL pio_netcdf_put_fvar (ng, model, ncname, 'nl_visc2', &
3771 & nl_visc2(ng), (/0/), (/0/), &
3772 & piofile = piofile)
3773 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3774
3775# ifdef ADJOINT
3776 CALL pio_netcdf_put_fvar (ng, model, ncname, 'ad_visc2', &
3777 & ad_visc2(ng), (/0/), (/0/), &
3778 & piofile = piofile)
3779 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3780# endif
3781
3782# if defined TANGENT || defined TL_IOMS
3783 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tl_visc2', &
3784 & tl_visc2(ng), (/0/), (/0/), &
3785 & piofile = piofile)
3786 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3787# endif
3788# endif
3789
3790# ifdef UV_VIS4
3791 CALL pio_netcdf_put_fvar (ng, model, ncname, 'nl_visc4', &
3792 & nl_visc4(ng)**2, (/0/), (/0/), &
3793 & piofile = piofile)
3794 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3795
3796# ifdef ADJOINT
3797 CALL pio_netcdf_put_fvar (ng, model, ncname, 'ad_visc4', &
3798 & ad_visc4(ng)**2, (/0/), (/0/), &
3799 & piofile = piofile)
3800 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3801# endif
3802
3803# if defined TANGENT || defined TL_IOMS
3804 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tl_visc4', &
3805 & tl_visc4(ng)**2, (/0/), (/0/), &
3806 & piofile = piofile)
3807 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3808# endif
3809# endif
3810
3811# if defined SOLVE3D && (defined MY25_MIXING || defined GLS_MIXING)
3812# ifdef TKE_DIF2
3813 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tkenu2', &
3814 & tkenu2(ng), (/0/), (/0/), &
3815 & piofile = piofile)
3816 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3817# endif
3818
3819# ifdef TKE_DIF4
3820 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tkenu4', &
3821 & tkenu4(ng)**2, (/0/), (/0/), &
3822 & piofile = piofile)
3823 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3824# endif
3825# endif
3826
3827# if defined UV_VIS2 || defined UV_VIS4
3828 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LuvSponge', &
3829 & luvsponge(ng), (/0/), (/0/), &
3830 & piofile = piofile)
3831 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3832# endif
3833
3834# if (defined TS_DIF2 || defined TS_DIF4) && defined SOLVE3D
3835 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LtracerSponge', &
3836 & ltracersponge(:,ng), (/1/), (/nt(ng)/), &
3837 & piofile = piofile)
3838 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3839# endif
3840
3841# ifdef SOLVE3D
3842!
3843! Background vertical mixing coefficients.
3844!
3845 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Akt_bak', &
3846 & akt_bak(:,ng), (/1/), (/nt(ng)/), &
3847 & piofile = piofile)
3848 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3849
3850 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Akv_bak', &
3851 & akv_bak(ng), (/0/), (/0/), &
3852 & piofile = piofile)
3853 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3854
3855# if defined MY25_MIXING || defined GLS_MIXING
3856 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Akk_bak', &
3857 & akk_bak(ng), (/0/), (/0/), &
3858 & piofile = piofile)
3859 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3860
3861 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Akp_bak', &
3862 & akp_bak(ng), (/0/), (/0/), &
3863 & piofile = piofile)
3864 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3865# endif
3866
3867# ifdef FORWARD_MIXING
3868!
3869! Basic state vertical mixing scale used in adjoint-based applications.
3870!
3871# ifdef ADJOINT
3872 CALL pio_netcdf_put_fvar (ng, model, ncname, 'ad_Akt_fac', &
3873 & ad_akt_fac(:,ng), (/1/), (/nt(ng)/), &
3874 & piofile = piofile)
3875 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3876# endif
3877
3878# if defined TANGENT || defined TL_IOMS
3879 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tl_Akt_fac', &
3880 & tl_akt_fac(:,ng), (/1/), (/nt(ng)/), &
3881 & piofile = piofile)
3882 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3883# endif
3884
3885# ifdef ADJOINT
3886 CALL pio_netcdf_put_fvar (ng, model, ncname, 'ad_Akv_fac', &
3887 & ad_akv_fac(ng), (/0/), (/0/), &
3888 & piofile = piofile)
3889 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3890# endif
3891
3892# if defined TANGENT || defined TL_IOMS
3893 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tl_Akv_fac', &
3894 & tl_akv_fac(ng), (/0/), (/0/), &
3895 & piofile = piofile)
3896 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3897# endif
3898# endif
3899# endif
3900!
3901! Drag coefficients.
3902!
3903 CALL pio_netcdf_put_fvar (ng, model, ncname, 'rdrg', &
3904 & rdrg(ng), (/0/), (/0/), &
3905 & piofile = piofile)
3906 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3907
3908 CALL pio_netcdf_put_fvar (ng, model, ncname, 'rdrg2', &
3909 & rdrg2(ng), (/0/), (/0/), &
3910 & piofile = piofile)
3911 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3912
3913# ifdef SOLVE3D
3914 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Zob', &
3915 & zob(ng), (/0/), (/0/), &
3916 & piofile = piofile)
3917 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3918
3919 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Zos', &
3920 & zos(ng), (/0/), (/0/), &
3921 & piofile = piofile)
3922 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3923# endif
3924
3925# if defined SOLVE3D && defined GLS_MIXING
3926!
3927! Generic length-scale parameters.
3928!
3929 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_p', &
3930 & gls_p(ng), (/0/), (/0/), &
3931 & piofile = piofile)
3932 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3933
3934 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_m', &
3935 & gls_m(ng), (/0/), (/0/), &
3936 & piofile = piofile)
3937 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3938
3939 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_n', &
3940 & gls_n(ng), (/0/), (/0/), &
3941 & piofile = piofile)
3942 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3943
3944 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_cmu0', &
3945 & gls_cmu0(ng), (/0/), (/0/), &
3946 & piofile = piofile)
3947 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3948
3949 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_c1', &
3950 & gls_c1(ng), (/0/), (/0/), &
3951 & piofile = piofile)
3952 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3953
3954 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_c2', &
3955 & gls_c2(ng), (/0/), (/0/), &
3956 & piofile = piofile)
3957 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3958
3959 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_c3m', &
3960 & gls_c3m(ng), (/0/), (/0/), &
3961 & piofile = piofile)
3962 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3963
3964 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_c3p', &
3965 & gls_c3p(ng), (/0/), (/0/), &
3966 & piofile = piofile)
3967 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3968
3969 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_sigk', &
3970 & gls_sigk(ng), (/0/), (/0/), &
3971 & piofile = piofile)
3972 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3973
3974 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_sigp', &
3975 & gls_sigp(ng), (/0/), (/0/), &
3976 & piofile = piofile)
3977 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3978
3979 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_Kmin', &
3980 & gls_kmin(ng), (/0/), (/0/), &
3981 & piofile = piofile)
3982 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3983
3984 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gls_Pmin', &
3985 & gls_pmin(ng), (/0/), (/0/), &
3986 & piofile = piofile)
3987 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3988
3989 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Charnok_alpha', &
3990 & charnok_alpha(ng), (/0/), (/0/), &
3991 & piofile = piofile)
3992 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3993
3994 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Zos_hsig_alpha', &
3995 & zos_hsig_alpha(ng), (/0/), (/0/), &
3996 & piofile = piofile)
3997 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3998
3999 CALL pio_netcdf_put_fvar (ng, model, ncname, 'sz_alpha', &
4000 & sz_alpha(ng), (/0/), (/0/), &
4001 & piofile = piofile)
4002 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4003
4004 CALL pio_netcdf_put_fvar (ng, model, ncname, 'CrgBan_cw', &
4005 & crgban_cw(ng), (/0/), (/0/), &
4006 & piofile = piofile)
4007 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4008# endif
4009# ifdef WEC
4010 CALL pio_netcdf_put_fvar (ng, model, ncname, 'wec_alpha', &
4011 & wec_alpha(ng), (/0/), (/0/), &
4012 & piofile = piofile)
4013 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4014# endif
4015!
4016! Nudging inverse time scales used in various tasks.
4017!
4018 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Znudg', &
4019 & znudg(ng)/sec2day, (/0/), (/0/), &
4020 & piofile = piofile)
4021 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4022
4023 CALL pio_netcdf_put_fvar (ng, model, ncname, 'M2nudg', &
4024 & m2nudg(ng)/sec2day, (/0/), (/0/), &
4025 & piofile = piofile)
4026 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4027
4028# ifdef SOLVE3D
4029 CALL pio_netcdf_put_fvar (ng, model, ncname, 'M3nudg', &
4030 & m3nudg(ng)/sec2day, (/0/), (/0/), &
4031 & piofile = piofile)
4032 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4033
4034 DO itrc=1,nt(ng)
4035 nudg(itrc)=tnudg(itrc,ng)/sec2day
4036 END DO
4037 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Tnudg', &
4038 & nudg, (/1/), (/nt(ng)/), &
4039 & piofile = piofile)
4040 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4041# endif
4042
4043# ifndef DEBUGGING
4044!
4045! Open boundary nudging, inverse time scales.
4046!
4047 IF (nudgingcoeff(ng)) THEN
4048 CALL pio_netcdf_put_fvar (ng, model, ncname, 'FSobc_in', &
4049 & fsobc_in(ng,:), (/1/), (/4/), &
4050 & piofile = piofile)
4051 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4052
4053 CALL pio_netcdf_put_fvar (ng, model, ncname, 'FSobc_out', &
4054 & fsobc_out(ng,:), (/1/), (/4/), &
4055 & piofile = piofile)
4056 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4057
4058 CALL pio_netcdf_put_fvar (ng, model, ncname, 'M2obc_in', &
4059 & m2obc_in(ng,:), (/1/), (/4/), &
4060 & piofile = piofile)
4061 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4062
4063 CALL pio_netcdf_put_fvar (ng, model, ncname, 'M2obc_out', &
4064 & m2obc_out(ng,:), (/1/), (/4/), &
4065 & piofile = piofile)
4066 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4067
4068# ifdef SOLVE3D
4069 DO ibry=1,4
4070 DO itrc=1,nt(ng)
4071 tobc(itrc,ibry)=tobc_in(itrc,ng,ibry)
4072 END DO
4073 END DO
4074 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Tobc_in', &
4075 & tobc, (/1,1/), (/nt(ng),4/), &
4076 & piofile = piofile)
4077 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4078
4079 DO ibry=1,4
4080 DO itrc=1,nt(ng)
4081 tobc(itrc,ibry)=tobc_out(itrc,ng,ibry)
4082 END DO
4083 END DO
4084 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Tobc_out', &
4085 & tobc, (/1,1/), (/nt(ng),4/), &
4086 & piofile = piofile)
4087 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4088
4089 CALL pio_netcdf_put_fvar (ng, model, ncname, 'M3obc_in', &
4090 & m3obc_in(ng,:), (/1/), (/4/), &
4091 & piofile = piofile)
4092 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4093
4094 CALL pio_netcdf_put_fvar (ng, model, ncname, 'M3obc_out', &
4095 & m3obc_out(ng,:), (/1/), (/4/), &
4096 & piofile = piofile)
4097 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4098# endif
4099 END IF
4100# endif
4101!
4102! Equation of State parameters.
4103!
4104 CALL pio_netcdf_put_fvar (ng, model, ncname, 'rho0', &
4105 & rho0, (/0/), (/0/), &
4106 & piofile = piofile)
4107 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4108
4109# if defined SOLVE3D && defined PROPAGATOR
4110 CALL pio_netcdf_put_fvar (ng, model, ncname, 'bvf_bak', &
4111 & bvf_bak, (/0/), (/0/), &
4112 & piofile = piofile)
4113 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4114# endif
4115
4116# if defined SOLVE3D && \
4117 (!defined NONLIN_EOS || defined FOUR_DVAR || defined PROPAGATOR)
4118 CALL pio_netcdf_put_fvar (ng, model, ncname, 'R0', &
4119 & r0(ng), (/0/), (/0/), &
4120 & piofile = piofile)
4121 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4122
4123 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Tcoef', &
4124 & tcoef(ng), (/0/), (/0/), &
4125 & piofile = piofile)
4126 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4127
4128 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Scoef', &
4129 & scoef(ng), (/0/), (/0/), &
4130 & piofile = piofile)
4131 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4132# endif
4133# ifdef SOLVE3D
4134# ifdef BODYFORCE
4135!
4136! Body force parameters.
4137!
4138 CALL pio_netcdf_put_ivar (ng, model, ncname, 'levsfrc', &
4139 & levsfrc(ng), (/0/), (/0/), &
4140 & piofile = piofile)
4141 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4142
4143 CALL pio_netcdf_put_ivar (ng, model, ncname, 'levbfrc', &
4144 & levbfrc(ng), (/0/), (/0/), &
4145 & piofile = piofile)
4146 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4147# endif
4148# endif
4149!
4150! Slipperiness parameters.
4151!
4152 CALL pio_netcdf_put_fvar (ng, model, ncname, 'gamma2', &
4153 & gamma2(ng), (/0/), (/0/), &
4154 & piofile = piofile)
4155 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4156!
4157! Logical switches to activate horizontal momentum transport
4158! point Sources/Sinks (like river runoff transport) and mass point
4159! Sources/Sinks (like volume vertical influx).
4160!
4161 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LuvSrc', &
4162 & luvsrc(ng), (/0/), (/0/), &
4163 & piofile = piofile)
4164 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4165
4166 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LwSrc', &
4167 & lwsrc(ng), (/0/), (/0/), &
4168 & piofile = piofile)
4169 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4170
4171# ifdef SOLVE3D
4172!
4173! Logical switches to activate tracer point Sources/Sinks.
4174!
4175 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LtracerSrc', &
4176 & ltracersrc(:,ng), (/1/), (/nt(ng)/), &
4177 & piofile = piofile)
4178 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4179# endif
4180!
4181! Logical switches to process climatology fields.
4182!
4183 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LsshCLM', &
4184 & lsshclm(ng), (/0/), (/0/), &
4185 & piofile = piofile)
4186 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4187
4188 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lm2CLM', &
4189 & lm2clm(ng), (/0/), (/0/), &
4190 & piofile = piofile)
4191 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4192
4193# ifdef SOLVE3D
4194 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lm3CLM', &
4195 & lm3clm(ng), (/0/), (/0/), &
4196 & piofile = piofile)
4197 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4198
4199 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LtracerCLM', &
4200 & ltracerclm(:,ng), (/1/), (/nt(ng)/), &
4201 & piofile = piofile)
4202 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4203# endif
4204!
4205! Logical switches for nudging climatology fields.
4206!
4207 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LnudgeM2CLM', &
4208 & lnudgem2clm(ng), (/0/), (/0/), &
4209 & piofile = piofile)
4210 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4211
4212# ifdef SOLVE3D
4213 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LnudgeM3CLM', &
4214 & lnudgem3clm(ng), (/0/), (/0/), &
4215 & piofile = piofile)
4216 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4217
4218 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LnudgeTCLM', &
4219 & lnudgetclm(:,ng), (/1/), (/nt(ng)/), &
4220 & piofile = piofile)
4221 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4222# endif
4223
4224# ifdef FOUR_DVAR
4225!
4226! 4DVAR assimilation parameters.
4227!
4228# ifdef ADJUST_STFLUX
4229 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lstflux', &
4230 & lstflux(:,ng), (/1/), (/nt(ng)/), &
4231 & piofile = piofile)
4232 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4233# endif
4234# ifdef ADJUST_BOUNDARY
4235 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lobc', &
4236 & lobc(:,:,ng), &
4237 & (/1,1/), (/4,nstatevar(ng)/), &
4238 & piofile = piofile)
4239 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4240# endif
4241# ifndef I4DVAR_ANA_SENSITIVITY
4242 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LhessianEV', &
4243 & lhessianev, (/0/), (/0/), &
4244 & piofile = piofile)
4245 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4246
4247# ifdef WEAK_CONSTRAINT
4248 CALL pio_netcdf_put_lvar (ng, model, ncname, 'LhotStart', &
4249 & lhotstart, (/0/), (/0/), &
4250 & piofile = piofile)
4251 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4252# endif
4253
4254 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lprecond', &
4255 & lprecond, (/0/), (/0/), &
4256 & piofile = piofile)
4257 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4258
4259 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lritz', &
4260 & lritz, (/0/), (/0/), &
4261 & piofile = piofile)
4262 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4263
4264# ifdef WEAK_CONSTRAINT
4265 IF (lprecond.and.(nritzev.gt.0)) THEN
4266 CALL pio_netcdf_put_ivar (ng, model, ncname, 'NritzEV', &
4267 & nritzev, (/0/), (/0/), &
4268 & piofile = piofile)
4269 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4270 END IF
4271# endif
4272# endif
4273# if defined POSTERIOR_EOFS && defined WEAK_CONSTRAINT
4274 CALL pio_netcdf_put_ivar (ng, model, ncname, 'NpostI', &
4275 & nposti, (/0/), (/0/), &
4276 & piofile = piofile)
4277# endif
4278# if defined ARRAY_MODES || \
4279 defined i4dvar_ana_sensitivity || \
4280 defined rbl4dvar_ana_sensitivity || \
4281 defined rbl4dvar_fct_sensitivity || \
4282 defined r4dvar_ana_sensitivity
4283 CALL pio_netcdf_put_ivar (ng, model, ncname, 'Nimpact', &
4284 & nimpact, (/0/), (/0/), &
4285 & piofile = piofile)
4286# endif
4287# ifndef I4DVAR_ANA_SENSITIVITY
4288 CALL pio_netcdf_put_fvar (ng, model, ncname, 'GradErr', &
4289 & graderr, (/0/), (/0/), &
4290 & piofile = piofile)
4291 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4292
4293 CALL pio_netcdf_put_fvar (ng, model, ncname, 'HevecErr', &
4294 & hevecerr, (/0/), (/0/), &
4295 & piofile = piofile)
4296 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4297# endif
4298
4299 CALL pio_netcdf_put_ivar (ng, model, ncname, 'Nmethod', &
4300 & nmethod(ng), (/0/), (/0/), &
4301 & piofile = piofile)
4302 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4303
4304 CALL pio_netcdf_put_ivar (ng, model, ncname, 'Rscheme', &
4305 & rscheme(ng), (/0/), (/0/), &
4306 & piofile = piofile)
4307 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4308
4309 CALL pio_netcdf_put_ivar (ng, model, ncname, 'Nrandom', &
4310 & nrandom, (/0/), (/0/), &
4311 & piofile = piofile)
4312 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4313
4314 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Hgamma', &
4315 & hgamma(1), (/0/), (/0/), &
4316 & piofile = piofile)
4317 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4318
4319# ifdef WEAK_CONSTRAINT
4320 CALL pio_netcdf_put_fvar (ng, model, ncname, 'HgammaM', &
4321 & hgamma(2), (/0/), (/0/), &
4322 & piofile = piofile)
4323 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4324# endif
4325
4326# ifdef ADJUST_BOUNDARY
4327 CALL pio_netcdf_put_fvar (ng, model, ncname, 'HgammaB', &
4328 & hgamma(3), (/0/), (/0/), &
4329 & piofile = piofile)
4330 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4331# endif
4332
4333# ifdef ADJUST_STFLUX
4334 CALL pio_netcdf_put_fvar (ng, model, ncname, 'HgammaF', &
4335 & hgamma(4), (/0/), (/0/), &
4336 & piofile = piofile)
4337 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4338# endif
4339
4340# ifdef SOLVE3D
4341 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Vgamma', &
4342 & vgamma(1), (/0/), (/0/), &
4343 & piofile = piofile)
4344 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4345
4346# ifdef WEAK_CONSTRAINT
4347 CALL pio_netcdf_put_fvar (ng, model, ncname, 'VgammaM', &
4348 & vgamma(2), (/0/), (/0/), &
4349 & piofile = piofile)
4350 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4351# endif
4352
4353# ifdef ADJUST_BOUNDARY
4354 CALL pio_netcdf_put_fvar (ng, model, ncname, 'VgammaB', &
4355 & vgamma(3), (/0/), (/0/), &
4356 & piofile = piofile)
4357 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4358# endif
4359# endif
4360
4361 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Hdecay', &
4362 & hdecay(1,:,ng), &
4363 & (/1/), (/nstatevar(ng)/), &
4364 & piofile = piofile)
4365 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4366
4367# ifdef SOLVE3D
4368 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Vdecay', &
4369 & vdecay(1,:,ng), &
4370 & (/1/), (/nstatevar(ng)/), &
4371 & piofile = piofile)
4372 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4373# endif
4374
4375 IF (nsa.eq.2) THEN
4376 CALL pio_netcdf_put_fvar (ng, model, ncname, 'HdecayM', &
4377 & hdecay(2,:,ng), &
4378 & (/1/), (/nstatevar(ng)/), &
4379 & piofile = piofile)
4380 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4381
4382# ifdef SOLVE3D
4383 CALL pio_netcdf_put_fvar (ng, model, ncname, 'VdecayM', &
4384 & vdecay(2,:,ng), &
4385 & (/1/), (/nstatevar(ng)/), &
4386 & piofile = piofile)
4387 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4388# endif
4389 END IF
4390
4391# ifdef ADJUST_BOUNDARY
4392 CALL pio_netcdf_put_fvar (ng, model, ncname, 'HdecayB', &
4393 & hdecayb(:,:,ng), &
4394 & (/1,1/), (/nstatevar(ng),4/), &
4395 & piofile = piofile)
4396 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4397
4398# ifdef SOLVE3D
4399 CALL pio_netcdf_put_fvar (ng, model, ncname, 'VdecayB', &
4400 & vdecayb(:,:,ng), &
4401 & (/1,1/), (/nstatevar(ng),4/), &
4402 & piofile = piofile)
4403 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4404# endif
4405# endif
4406
4407# ifdef RPM_RELAXATION
4408 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tl_M2diff', &
4409 & tl_m2diff(ng), (/0/), (/0/), &
4410 & piofile = piofile)
4411 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4412
4413# ifdef SOLVE3D
4414 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tl_M3diff', &
4415 & tl_m3diff(ng), (/0/), (/0/), &
4416 & piofile = piofile)
4417 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4418
4419 CALL pio_netcdf_put_fvar (ng, model, ncname, 'tl_Tdiff', &
4420 & tl_tdiff(:,ng), (/1/), (/nt(ng)/), &
4421 & piofile = piofile)
4422 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4423# endif
4424# endif
4425
4426# ifdef BALANCE_OPERATOR
4427# ifdef ZETA_ELLIPTIC
4428 CALL pio_netcdf_put_ivar (ng, model, ncname, 'Nbico', &
4429 & nbico(ng), (/0/), (/0/), &
4430 & piofile = piofile)
4431# endif
4432
4433 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lbalance', &
4434 & balance, (/1/), (/nstatevar(ng)/), &
4435 & piofile = piofile)
4436 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4437
4438 CALL pio_netcdf_put_ivar (ng, model, ncname, 'LNM_flag', &
4439 & lnm_flag, (/0/), (/0/), &
4440 & piofile = piofile)
4441 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4442
4443 CALL pio_netcdf_put_fvar (ng, model, ncname, 'LNM_depth', &
4444 & lnm_depth(ng), (/0/), (/0/), &
4445 & piofile = piofile)
4446 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4447
4448 CALL pio_netcdf_put_fvar (ng, model, ncname, 'dTdz_min', &
4449 & dtdz_min(ng), (/0/), (/0/), &
4450 & piofile = piofile)
4451 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4452
4453 CALL pio_netcdf_put_fvar (ng, model, ncname, 'ml_depth', &
4454 & ml_depth(ng), (/0/), (/0/), &
4455 & piofile = piofile)
4456 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4457# endif
4458
4459# ifdef STD_MODEL
4460!
4461! Background error covariance standard deviation modeling parameters.
4462!
4463 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Sigma_max', &
4464 & sigma_max(:,ng), &
4465 & (/1/), (/nstatevar(ng)/), &
4466 & piofile = piofile)
4467 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4468
4469 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Sigma_ml', &
4470 & sigma_ml(:,ng), &
4471 & (/1/), (/nstatevar(ng)/), &
4472 & piofile = piofile)
4473 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4474
4475 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Sigma_do', &
4476 & sigma_do(:,ng), &
4477 & (/1/), (/nstatevar(ng)/), &
4478 & piofile = piofile)
4479 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4480
4481 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Sigma_dz', &
4482 & sigma_dz(:,ng), &
4483 & (/1/), (/nstatevar(ng)/), &
4484 & piofile = piofile)
4485 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4486
4487# ifndef COMPUTE_MLD
4488 CALL pio_netcdf_put_fvar (ng, model, ncname, 'mld_uniform', &
4489 & mld_uniform(ng), (/0/), (/0/), &
4490 & piofile = piofile)
4491 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4492# endif
4493# endif
4494# endif
4495
4496# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
4497 defined opt_observations || defined sensitivity_4dvar || \
4498 defined so_semi
4499!
4500! Adjoint sensitivity parameters.
4501!
4502 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lzeta', &
4503 & scalars(ng)%Lstate(isfsur), &
4504 & (/0/), (/0/), &
4505 & piofile = piofile)
4506 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4507
4508 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lubar', &
4509 & scalars(ng)%Lstate(isubar), &
4510 & (/0/), (/0/), &
4511 & piofile = piofile)
4512 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4513
4514 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lvbar', &
4515 & scalars(ng)%Lstate(isvbar), &
4516 & (/0/), (/0/), &
4517 & piofile = piofile)
4518 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4519
4520# ifdef SOLVE3D
4521 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Luvel', &
4522 & scalars(ng)%Lstate(isuvel), &
4523 & (/0/), (/0/), &
4524 & piofile = piofile)
4525 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4526
4527 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Lvvel', &
4528 & scalars(ng)%Lstate(isvvel), &
4529 & (/0/), (/0/), &
4530 & piofile = piofile)
4531 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4532
4533 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Ltracer', &
4534 & scalars(ng)%Lstate(istvar(:)), &
4535 & (/1/), (/nt(ng)/), &
4536 & piofile = piofile)
4537 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4538
4539 CALL pio_netcdf_put_ivar (ng, model, ncname, 'KstrS', &
4540 & kstrs(ng), (/0/), (/0/), &
4541 & piofile = piofile)
4542 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4543
4544 CALL pio_netcdf_put_ivar (ng, model, ncname, 'KendS', &
4545 & kends(ng), (/0/), (/0/), &
4546 & piofile = piofile)
4547 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4548# endif
4549# endif
4550
4551# if defined FORCING_SV || defined SO_SEMI || defined STOCHASTIC_OPT
4552!
4553! Singular Forcing Vectors or Stochastic Optimals state switches.
4554!
4555 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Fzeta', &
4556 & scalars(ng)%Fstate(isfsur), &
4557 & (/0/), (/0/), &
4558 & piofile = piofile)
4559 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4560
4561# ifndef SOLVE3D
4562 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Fubar', &
4563 & scalars(ng)%Fstate(isubar), &
4564 & (/0/), (/0/), &
4565 & piofile = piofile)
4566 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4567
4568 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Fvbar', &
4569 & scalars(ng)%Fstate(isvbar), &
4570 & (/0/), (/0/), &
4571 & piofile = piofile)
4572 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4573
4574# else
4575
4576 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Fuvel', &
4577 & scalars(ng)%Fstate(isuvel), &
4578 & (/0/), (/0/), &
4579 & piofile = piofile)
4580 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4581
4582 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Fvvel', &
4583 & scalars(ng)%Fstate(isvvel), &
4584 & (/0/), (/0/), &
4585 & piofile = piofile)
4586 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4587
4588 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Ftracer', &
4589 & scalars(ng)%Fstate(istvar(:)), &
4590 & (/1/), (/nt(ng)/), &
4591 & piofile = piofile)
4592 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4593# endif
4594
4595 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Fsustr', &
4596 & scalars(ng)%Fstate(isustr), &
4597 & (/0/), (/0/), &
4598 & piofile = piofile)
4599 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4600
4601 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Fsvstr', &
4602 & scalars(ng)%Fstate(isvstr), &
4603 & (/0/), (/0/), &
4604 & piofile = piofile)
4605 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4606
4607# ifdef SOLVE3D
4608 CALL pio_netcdf_put_lvar (ng, model, ncname, 'Fstflx', &
4609 & scalars(ng)%Fstate(istsur(:)), &
4610 & (/1/), (/nt(ng)/), &
4611 & piofile = piofile)
4612 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4613# endif
4614# endif
4615
4616# ifdef SO_SEMI
4617# ifndef SO_SEMI_WHITE
4618 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SO_decay', &
4619 & so_decay(ng), (/0/), (/0/), &
4620 & piofile = piofile)
4621 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4622# endif
4623
4624 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SO_trace', &
4625 & trnorm(ng), (/0/), (/0/), &
4626 & piofile = piofile)
4627 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4628
4629 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SOsdev_zeta', &
4630 & so_sdev(isfsur,ng), (/0/), (/0/), &
4631 & piofile = piofile)
4632 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4633
4634# ifndef SOLVE3D
4635 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SOsdev_ubar', &
4636 & so_sdev(isubar,ng), (/0/), (/0/), &
4637 & piofile = piofile)
4638 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4639
4640 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SOsdev_vbar', &
4641 & so_sdev(isubar,ng), (/0/), (/0/), &
4642 & piofile = piofile)
4643 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4644
4645# else
4646
4647 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SOsdev_uvel', &
4648 & so_sdev(isuvel,ng), (/0/), (/0/), &
4649 & piofile = piofile)
4650 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4651
4652 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SOsdev_vvel', &
4653 & so_sdev(isvvel,ng), (/0/), (/0/), &
4654 & piofile = piofile)
4655 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4656
4657 DO itrc=1,nt(ng)
4658 nudg(itrc)=so_sdev(istvar(itrc),ng)
4659 END DO
4660 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SOsdev_tracer', &
4661 & nudg, (/1/), (/nt(ng)/), &
4662 & piofile = piofile)
4663 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4664# endif
4665
4666 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SOsdev_sustr', &
4667 & so_sdev(isustr,ng), (/0/), (/0/), &
4668 & piofile = piofile)
4669 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4670
4671
4672 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SOsdev_svstr', &
4673 & so_sdev(isvstr,ng), (/0/), (/0/), &
4674 & piofile = piofile)
4675 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4676
4677# ifdef SOLVE3D
4678 DO itrc=1,nt(ng)
4679 nudg(itrc)=so_sdev(istsur(itrc),ng)
4680 END DO
4681 CALL pio_netcdf_put_fvar (ng, model, ncname, 'SOsdev_stflx', &
4682 & nudg, (/1/), (/nt(ng)/), &
4683 & piofile = piofile)
4684 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4685# endif
4686# endif
4687
4688# if defined BIOLOGY && defined SOLVE3D
4689# if defined BIO_FENNEL
4690# include <fennel_wrt_pio.h>
4691# elif defined ECOSIM
4692# include <ecosim_wrt_pio.h>
4693# elif defined HYPOXIA_SRM
4694# include <hypoxia_srm_wrt_pio.h>
4695# elif defined NEMURO
4696# include <nemuro_wrt_pio.h>
4697# elif defined NPZD_FRANKS
4698# include <npzd_Franks_wrt_pio.h>
4699# elif defined NPZD_IRON
4700# include <npzd_iron_wrt_pio.h>
4701# elif defined NPZD_POWELL
4702# include <npzd_Powell_wrt_pio.h>
4703# elif defined RED_TIDE
4704# include <red_tide_wrt_pio.h>
4705# endif
4706# endif
4707
4708# if defined FLOATS && defined FLOAT_BIOLOGY
4709# if defined FLOAT_OYSTER
4710# include <oyster_floats_wrt_pio.h>
4711# endif
4712# endif
4713
4714# ifdef SEDIMENT
4715# include <sediment_wrt_pio.h>
4716# endif
4717!
4718!-----------------------------------------------------------------------
4719! Write out grid variables.
4720!-----------------------------------------------------------------------
4721!
4722! Grid type switch. Writing characters in parallel I/O is extremely
4723! inefficient. It is better to write this as an integer switch:
4724! 0=Cartesian, 1=spherical.
4725!
4726 CALL pio_netcdf_put_lvar (ng, model, ncname, 'spherical', &
4727 & spherical, (/0/), (/0/), &
4728 & piofile = piofile)
4729 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4730!
4731! Domain Length.
4732!
4733 CALL pio_netcdf_put_fvar (ng, model, ncname, 'xl', &
4734 & xl(ng), (/0/), (/0/), &
4735 & piofile = piofile)
4736 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4737
4738 CALL pio_netcdf_put_fvar (ng, model, ncname, 'el', &
4739 & el(ng), (/0/), (/0/), &
4740 & piofile = piofile)
4741 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4742
4743# ifdef SOLVE3D
4744!
4745! S-coordinate parameters.
4746!
4747 CALL pio_netcdf_put_ivar (ng, model, ncname, 'Vtransform', &
4748 & vtransform(ng), (/0/), (/0/), &
4749 & piofile = piofile)
4750 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4751
4752 CALL pio_netcdf_put_ivar (ng, model, ncname, 'Vstretching', &
4753 & vstretching(ng), (/0/), (/0/), &
4754 & piofile = piofile)
4755 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4756
4757 CALL pio_netcdf_put_fvar (ng, model, ncname, 'theta_s', &
4758 & theta_s(ng), (/0/), (/0/), &
4759 & piofile = piofile)
4760 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4761
4762 CALL pio_netcdf_put_fvar (ng, model, ncname, 'theta_b', &
4763 & theta_b(ng), (/0/), (/0/), &
4764 & piofile = piofile)
4765 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4766
4767 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Tcline', &
4768 & tcline(ng), (/0/), (/0/), &
4769 & piofile = piofile)
4770 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4771
4772 CALL pio_netcdf_put_fvar (ng, model, ncname, 'hc', &
4773 & hc(ng), (/0/), (/0/), &
4774 & piofile = piofile)
4775 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4776!
4777! SGRID conventions for staggered data on structured grids. The value
4778! is arbitrary but is set to unity so it can be used as logical during
4779! post-processing.
4780!
4781 ival=1
4782 CALL pio_netcdf_put_ivar (ng, model, ncname, 'grid', &
4783 & ival, (/0/), (/0/), &
4784 & piofile = piofile)
4785 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4786!
4787! S-coordinate non-dimensional independent variables.
4788!
4789 CALL pio_netcdf_put_fvar (ng, model, ncname, 's_rho', &
4790 & scalars(ng)%sc_r(:), (/1/), (/n(ng)/), &
4791 & piofile = piofile)
4792 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4793
4794 CALL pio_netcdf_put_fvar (ng, model, ncname, 's_w', &
4795 & scalars(ng)%sc_w(0:), &
4796 & (/1/), (/n(ng)+1/), &
4797 & piofile = piofile)
4798 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4799!
4800! S-coordinate non-dimensional stretching curves.
4801!
4802 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Cs_r', &
4803 & scalars(ng)%Cs_r(:), (/1/), (/n(ng)/), &
4804 & piofile = piofile)
4805 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4806
4807 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Cs_w', &
4808 & scalars(ng)%Cs_w(0:), &
4809 & (/1/), (/n(ng)+1/), &
4810 & piofile = piofile)
4811 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4812# endif
4813!
4814! User generic parameters.
4815!
4816 IF (nuser.gt.0) THEN
4817 CALL pio_netcdf_put_fvar (ng, model, ncname, 'user', &
4818 & user, (/1/), (/nuser/), &
4819 & piofile = piofile)
4820 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4821 END IF
4822
4823# ifdef STATIONS
4824!
4825! Stations positions.
4826!
4827 IF (fileh.eq.abs(sta(ng)%pioFile%fh)) THEN
4828 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Ipos', &
4829 & scalars(ng)%SposX(:), (/1/), &
4830 & (/nstation(ng)/), piofile = piofile)
4831 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4832
4833 CALL pio_netcdf_put_fvar (ng, model, ncname, 'Jpos', &
4834 & scalars(ng)%SposY(:), (/1/), &
4835 & (/nstation(ng)/), piofile = piofile)
4836 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4837 END IF
4838# endif
4839!
4840!-----------------------------------------------------------------------
4841! Write out grid tiled variables.
4842!-----------------------------------------------------------------------
4843!
4844# ifdef NO_WRITE_GRID
4845 grid_vars : IF (fileh.eq.abs(sta(ng)%pioFile%fh)) THEN
4846# else
4847 grid_vars : IF (fileh.ne.abs(flt(ng)%pioFile%fh)) THEN
4848# endif
4849# if !(defined SED_MORPH && defined SEDIMENT)
4850!
4851! Bathymetry.
4852!
4853 IF (exit_flag.eq.noerror) THEN
4854 scale=1.0_dp
4855 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
4856 IF (pio_netcdf_find_var(ng, model, piofile, &
4857 & trim(vname(1,idtopo)), &
4858 & piovar%vd)) THEN
4859 piovar%gtype=r2dvar
4860 IF (pio_type.eq.pio_double) THEN
4861 piovar%dkind=pio_double
4862 iodesc => iodesc_dp_r2dvar(ng)
4863 ELSE
4864 piovar%dkind=pio_real
4865 iodesc => iodesc_sp_r2dvar(ng)
4866 END IF
4867 status=nf_fwrite2d(ng, model, piofile, idtopo, &
4868 & piovar, 0, iodesc, &
4869 & lbi, ubi, lbj, ubj, scale, &
4870# ifdef MASKING
4871 & grid(ng) % rmask, &
4872# endif
4873 & grid(ng) % h, &
4874 & setfillval = .false.)
4875 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4876 IF (master) WRITE (stdout,10) trim(vname(1,idtopo)), &
4877 & trim(ncname)
4878 exit_flag=3
4879 ioerror=status
4880 END IF
4881 ELSE
4882 IF (master) WRITE (stdout,20) trim(vname(1,idtopo)), &
4883 & trim(ncname)
4884 exit_flag=3
4885 ioerror=nf90_enotvar
4886 END IF
4887# ifdef STATIONS
4888 ELSE
4889 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
4890 & lbi, ubi, lbj, ubj, &
4891 & scale, grid(ng)%h, &
4892 & nstation(ng), scalars(ng)%SposX, &
4893 & scalars(ng)%SposY, wrk)
4894 CALL pio_netcdf_put_fvar (ng, model, ncname, &
4895 & vname(1,idtopo), &
4896 & wrk, (/1/), (/nstation(ng)/), &
4897 & piofile = piofile)
4898 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4899# endif
4900 END IF
4901 END IF
4902# endif
4903!
4904! Coriolis parameter.
4905!
4906 IF (exit_flag.eq.noerror) THEN
4907 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
4908 scale=1.0_dp
4909 IF (pio_netcdf_find_var(ng, model, piofile, &
4910 & trim(vname(1,idfcor)), &
4911 & piovar%vd)) THEN
4912 piovar%gtype=r2dvar
4913 IF (pio_type.eq.pio_double) THEN
4914 piovar%dkind=pio_double
4915 iodesc => iodesc_dp_r2dvar(ng)
4916 ELSE
4917 piovar%dkind=pio_real
4918 iodesc => iodesc_sp_r2dvar(ng)
4919 END IF
4920 status=nf_fwrite2d(ng, model, piofile, idfcor, &
4921 & piovar, 0, iodesc, &
4922 & lbi, ubi, lbj, ubj, scale, &
4923# ifdef MASKING
4924 & grid(ng) % rmask, &
4925# endif
4926 & grid(ng) % f, &
4927 & setfillval = .false.)
4928 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4929 IF (master) WRITE (stdout,10) trim(vname(1,idfcor)), &
4930 & trim(ncname)
4931 exit_flag=3
4932 ioerror=status
4933 END IF
4934 ELSE
4935 IF (master) WRITE (stdout,20) trim(vname(1,idfcor)), &
4936 & trim(ncname)
4937 exit_flag=3
4938 ioerror=nf90_enotvar
4939 END IF
4940 END IF
4941 END IF
4942!
4943! Curvilinear transformation metrics.
4944!
4945 IF (exit_flag.eq.noerror) THEN
4946 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
4947 scale=1.0_dp
4948 IF (pio_netcdf_find_var(ng, model, piofile, &
4949 & trim(vname(1,idpmdx)), &
4950 & piovar%vd)) THEN
4951 piovar%gtype=r2dvar
4952 IF (pio_type.eq.pio_double) THEN
4953 piovar%dkind=pio_double
4954 iodesc => iodesc_dp_r2dvar(ng)
4955 ELSE
4956 piovar%dkind=pio_real
4957 iodesc => iodesc_sp_r2dvar(ng)
4958 END IF
4959 status=nf_fwrite2d(ng, model, piofile, idpmdx, &
4960 & piovar, 0, iodesc, &
4961 & lbi, ubi, lbj, ubj, scale, &
4962# ifdef MASKING
4963 & grid(ng) % rmask, &
4964# endif
4965 & grid(ng) % pm, &
4966 & setfillval = .false.)
4967 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4968 IF (master) WRITE (stdout,10) trim(vname(1,idpmdx)), &
4969 & trim(ncname)
4970 exit_flag=3
4971 ioerror=status
4972 END IF
4973 ELSE
4974 IF (master) WRITE (stdout,20) trim(vname(1,idpmdx)), &
4975 & trim(ncname)
4976 exit_flag=3
4977 ioerror=nf90_enotvar
4978 END IF
4979 END IF
4980 END IF
4981!
4982 IF (exit_flag.eq.noerror) THEN
4983 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
4984 scale=1.0_dp
4985 IF (pio_netcdf_find_var(ng, model, piofile, &
4986 & trim(vname(1,idpndy)), &
4987 & piovar%vd)) THEN
4988 piovar%gtype=r2dvar
4989 IF (pio_type.eq.pio_double) THEN
4990 piovar%dkind=pio_double
4991 iodesc => iodesc_dp_r2dvar(ng)
4992 ELSE
4993 piovar%dkind=pio_real
4994 iodesc => iodesc_sp_r2dvar(ng)
4995 END IF
4996 status=nf_fwrite2d(ng, model, piofile, idpndy, &
4997 & piovar, 0, iodesc, &
4998 & lbi, ubi, lbj, ubj, scale, &
4999# ifdef MASKING
5000 & grid(ng) % rmask, &
5001# endif
5002 & grid(ng) % pn, &
5003 & setfillval = .false.)
5004 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5005 IF (master) WRITE (stdout,10) trim(vname(1,idpndy)), &
5006 & trim(ncname)
5007 exit_flag=3
5008 ioerror=status
5009 END IF
5010 ELSE
5011 IF (master) WRITE (stdout,20) trim(vname(1,idpndy)), &
5012 & trim(ncname)
5013 exit_flag=3
5014 ioerror=nf90_enotvar
5015 END IF
5016 END IF
5017 END IF
5018!
5019! Grid coordinates of RHO-points.
5020!
5021 IF (spherical) THEN
5022 IF (exit_flag.eq.noerror) THEN
5023 scale=1.0_dp
5024 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5025 IF (pio_netcdf_find_var(ng, model, piofile, &
5026 & trim(vname(1,idlonr)), &
5027 & piovar%vd)) THEN
5028 piovar%gtype=r2dvar
5029 IF (pio_type.eq.pio_double) THEN
5030 piovar%dkind=pio_double
5031 iodesc => iodesc_dp_r2dvar(ng)
5032 ELSE
5033 piovar%dkind=pio_real
5034 iodesc => iodesc_sp_r2dvar(ng)
5035 END IF
5036 status=nf_fwrite2d(ng, model, piofile, idlonr, &
5037 & piovar, 0, iodesc, &
5038 & lbi, ubi, lbj, ubj, scale, &
5039# ifdef MASKING
5040 & grid(ng) % rmask, &
5041# endif
5042 & grid(ng) % lonr, &
5043 & setfillval = .false.)
5044 IF (founderror(status, pio_noerr, &
5045 & __line__, myfile)) THEN
5046 IF (master) WRITE (stdout,10) trim(vname(1,idlonr)), &
5047 & trim(ncname)
5048 exit_flag=3
5049 ioerror=status
5050 END IF
5051 ELSE
5052 IF (master) WRITE (stdout,20) trim(vname(1,idlonr)), &
5053 & trim(ncname)
5054 exit_flag=3
5055 ioerror=nf90_enotvar
5056 END IF
5057# ifdef STATIONS
5058 ELSE
5059 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
5060 & lbi, ubi, lbj, ubj, &
5061 & scale, grid(ng)%lonr, &
5062 & nstation(ng), scalars(ng)%SposX, &
5063 & scalars(ng)%SposY, wrk)
5064 CALL pio_netcdf_put_fvar (ng, model, ncname, &
5065 & vname(1,idlonr), &
5066 & wrk, (/1/), (/nstation(ng)/), &
5067 & piofile = piofile)
5068 IF (founderror(exit_flag, noerror, &
5069 & __line__, myfile)) RETURN
5070# endif
5071 END IF
5072 END IF
5073!
5074 IF (exit_flag.eq.noerror) THEN
5075 scale=1.0_dp
5076 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5077 IF (pio_netcdf_find_var(ng, model, piofile, &
5078 & trim(vname(1,idlatr)), &
5079 & piovar%vd)) THEN
5080 piovar%gtype=r2dvar
5081 IF (pio_type.eq.pio_double) THEN
5082 piovar%dkind=pio_double
5083 iodesc => iodesc_dp_r2dvar(ng)
5084 ELSE
5085 piovar%dkind=pio_real
5086 iodesc => iodesc_sp_r2dvar(ng)
5087 END IF
5088 status=nf_fwrite2d(ng, model, piofile, idlatr, &
5089 & piovar, 0, iodesc, &
5090 & lbi, ubi, lbj, ubj, scale, &
5091# ifdef MASKING
5092 & grid(ng) % rmask, &
5093# endif
5094 & grid(ng) % latr, &
5095 & setfillval = .false.)
5096 IF (founderror(status, pio_noerr, &
5097 & __line__, myfile)) THEN
5098 IF (master) WRITE (stdout,10) trim(vname(1,idlatr)), &
5099 & trim(ncname)
5100 exit_flag=3
5101 ioerror=status
5102 END IF
5103 ELSE
5104 IF (master) WRITE (stdout,20) trim(vname(1,idlatr)), &
5105 & trim(ncname)
5106 exit_flag=3
5107 ioerror=nf90_enotvar
5108 END IF
5109# ifdef STATIONS
5110 ELSE
5111 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
5112 & lbi, ubi, lbj, ubj, &
5113 & scale, grid(ng)%latr, &
5114 & nstation(ng), scalars(ng)%SposX, &
5115 & scalars(ng)%SposY, wrk)
5116 CALL pio_netcdf_put_fvar (ng, model, ncname, &
5117 & vname(1,idlatr), &
5118 & wrk, (/1/), (/nstation(ng)/), &
5119 & piofile = piofile)
5120 IF (founderror(exit_flag, noerror, &
5121 & __line__, myfile)) RETURN
5122# endif
5123 END IF
5124 END IF
5125 END IF
5126!
5127 IF (.not.spherical) THEN
5128 IF (exit_flag.eq.noerror) THEN
5129 scale=1.0_dp
5130 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5131 IF (pio_netcdf_find_var(ng, model, piofile, &
5132 & trim(vname(1,idxgrr)), &
5133 & piovar%vd)) THEN
5134 piovar%gtype=r2dvar
5135 IF (pio_type.eq.pio_double) THEN
5136 piovar%dkind=pio_double
5137 iodesc => iodesc_dp_r2dvar(ng)
5138 ELSE
5139 piovar%dkind=pio_real
5140 iodesc => iodesc_sp_r2dvar(ng)
5141 END IF
5142 status=nf_fwrite2d(ng, model, piofile, idxgrr, &
5143 & piovar, 0, iodesc, &
5144 & lbi, ubi, lbj, ubj, scale, &
5145# ifdef MASKING
5146 & grid(ng) % rmask, &
5147# endif
5148 & grid(ng) % xr, &
5149 & setfillval = .false.)
5150 IF (founderror(status, pio_noerr, &
5151 & __line__, myfile)) THEN
5152 IF (master) WRITE (stdout,10) trim(vname(1,idxgrr)), &
5153 & trim(ncname)
5154 exit_flag=3
5155 ioerror=status
5156 END IF
5157 ELSE
5158 IF (master) WRITE (stdout,20) trim(vname(1,idxgrr)), &
5159 & trim(ncname)
5160 exit_flag=3
5161 ioerror=nf90_enotvar
5162 END IF
5163# ifdef STATIONS
5164 ELSE
5165 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
5166 & lbi, ubi, lbj, ubj, &
5167 & scale, grid(ng)%xr, &
5168 & nstation(ng), scalars(ng)%SposX, &
5169 & scalars(ng)%SposY, wrk)
5170 CALL pio_netcdf_put_fvar (ng, model, ncname, &
5171 & trim(vname(1,idxgrr)), &
5172 & wrk, (/1/), (/nstation(ng)/), &
5173 & piofile = piofile)
5174 IF (founderror(exit_flag, noerror, &
5175 & __line__, myfile)) RETURN
5176# endif
5177 END IF
5178 END IF
5179!
5180 IF (exit_flag.eq.noerror) THEN
5181 scale=1.0_dp
5182 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5183 IF (pio_netcdf_find_var(ng, model, piofile, &
5184 & trim(vname(1,idygrr)), &
5185 & piovar%vd)) THEN
5186 piovar%gtype=r2dvar
5187 IF (pio_type.eq.pio_double) THEN
5188 piovar%dkind=pio_double
5189 iodesc => iodesc_dp_r2dvar(ng)
5190 ELSE
5191 piovar%dkind=pio_real
5192 iodesc => iodesc_sp_r2dvar(ng)
5193 END IF
5194 status=nf_fwrite2d(ng, model, piofile, idygrr, &
5195 & piovar, 0, iodesc, &
5196 & lbi, ubi, lbj, ubj, scale, &
5197# ifdef MASKING
5198 & grid(ng) % rmask, &
5199# endif
5200 & grid(ng) % yr, &
5201 & setfillval = .false.)
5202 IF (founderror(status, pio_noerr, &
5203 & __line__, myfile)) THEN
5204 IF (master) WRITE (stdout,10) trim(vname(1,idygrr)), &
5205 & trim(ncname)
5206 exit_flag=3
5207 ioerror=status
5208 END IF
5209 ELSE
5210 IF (master) WRITE (stdout,20) trim(vname(1,idygrr)), &
5211 & trim(ncname)
5212 exit_flag=3
5213 ioerror=nf90_enotvar
5214 END IF
5215# ifdef STATIONS
5216 ELSE
5217 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
5218 & lbi, ubi, lbj, ubj, &
5219 & scale, grid(ng)%yr, &
5220 & nstation(ng), scalars(ng)%SposX, &
5221 & scalars(ng)%SposY, wrk)
5222 CALL pio_netcdf_put_fvar (ng, model, ncname, &
5223 & trim(vname(1,idygrr)), &
5224 & wrk, (/1/), (/nstation(ng)/), &
5225 & piofile = piofile)
5226 IF (founderror(exit_flag, noerror, &
5227 & __line__, myfile)) RETURN
5228# endif
5229 END IF
5230 END IF
5231 END IF
5232!
5233! Grid coordinates of U-points.
5234!
5235 IF (spherical) THEN
5236 IF (exit_flag.eq.noerror) THEN
5237 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5238 scale=1.0_dp
5239 IF (pio_netcdf_find_var(ng, model, piofile, &
5240 & trim(vname(1,idlonu)), &
5241 & piovar%vd)) THEN
5242 piovar%gtype=u2dvar
5243 IF (pio_type.eq.pio_double) THEN
5244 piovar%dkind=pio_double
5245 iodesc => iodesc_dp_u2dvar(ng)
5246 ELSE
5247 piovar%dkind=pio_real
5248 iodesc => iodesc_sp_u2dvar(ng)
5249 END IF
5250 status=nf_fwrite2d(ng, model, piofile, idlonu, &
5251 & piovar, 0, iodesc, &
5252 & lbi, ubi, lbj, ubj, scale, &
5253# ifdef MASKING
5254 & grid(ng) % umask, &
5255# endif
5256 & grid(ng) % lonu, &
5257 & setfillval = .false.)
5258 IF (founderror(status, pio_noerr, &
5259 & __line__, myfile)) THEN
5260 IF (master) WRITE (stdout,10) trim(vname(1,idlonu)), &
5261 & trim(ncname)
5262 exit_flag=3
5263 ioerror=status
5264 END IF
5265 ELSE
5266 IF (master) WRITE (stdout,20) trim(vname(1,idlonu)), &
5267 & trim(ncname)
5268 exit_flag=3
5269 ioerror=nf90_enotvar
5270 END IF
5271 END IF
5272 END IF
5273!
5274 IF (exit_flag.eq.noerror) THEN
5275 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5276 scale=1.0_dp
5277 IF (pio_netcdf_find_var(ng, model, piofile, &
5278 & trim(vname(1,idlatu)), &
5279 & piovar%vd)) THEN
5280 piovar%gtype=u2dvar
5281 IF (pio_type.eq.pio_double) THEN
5282 piovar%dkind=pio_double
5283 iodesc => iodesc_dp_u2dvar(ng)
5284 ELSE
5285 piovar%dkind=pio_real
5286 iodesc => iodesc_sp_u2dvar(ng)
5287 END IF
5288 status=nf_fwrite2d(ng, model, piofile, idlatu, &
5289 & piovar, 0, iodesc, &
5290 & lbi, ubi, lbj, ubj, scale, &
5291# ifdef MASKING
5292 & grid(ng) % umask, &
5293# endif
5294 & grid(ng) % latu, &
5295 & setfillval = .false.)
5296 IF (founderror(status, pio_noerr, &
5297 & __line__, myfile)) THEN
5298 IF (master) WRITE (stdout,10) trim(vname(1,idlatu)), &
5299 & trim(ncname)
5300 exit_flag=3
5301 ioerror=status
5302 END IF
5303 ELSE
5304 IF (master) WRITE (stdout,20) trim(vname(1,idlatu)), &
5305 & trim(ncname)
5306 exit_flag=3
5307 ioerror=nf90_enotvar
5308 END IF
5309 END IF
5310 END IF
5311 END IF
5312!
5313 IF (.not.spherical) THEN
5314 IF (exit_flag.eq.noerror) THEN
5315 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5316 scale=1.0_dp
5317 IF (pio_netcdf_find_var(ng, model, piofile, &
5318 & trim(vname(1,idxgru)), &
5319 & piovar%vd)) THEN
5320 piovar%gtype=u2dvar
5321 IF (pio_type.eq.pio_double) THEN
5322 piovar%dkind=pio_double
5323 iodesc => iodesc_dp_u2dvar(ng)
5324 ELSE
5325 piovar%dkind=pio_real
5326 iodesc => iodesc_sp_u2dvar(ng)
5327 END IF
5328 status=nf_fwrite2d(ng, model, piofile, idxgru, &
5329 & piovar, 0, iodesc, &
5330 & lbi, ubi, lbj, ubj, scale, &
5331# ifdef MASKING
5332 & grid(ng) % umask, &
5333# endif
5334 & grid(ng) % xu, &
5335 & setfillval = .false.)
5336 IF (founderror(status, pio_noerr, &
5337 & __line__, myfile)) THEN
5338 IF (master) WRITE (stdout,10) trim(vname(1,idxgru)), &
5339 & trim(ncname)
5340 exit_flag=3
5341 ioerror=status
5342 END IF
5343 ELSE
5344 IF (master) WRITE (stdout,20) trim(vname(1,idxgru)), &
5345 & trim(ncname)
5346 exit_flag=3
5347 ioerror=nf90_enotvar
5348 END IF
5349 END IF
5350 END IF
5351!
5352 IF (exit_flag.eq.noerror) THEN
5353 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5354 scale=1.0_dp
5355 IF (pio_netcdf_find_var(ng, model, piofile, &
5356 & trim(vname(1,idygru)), &
5357 & piovar%vd)) THEN
5358 piovar%gtype=u2dvar
5359 IF (pio_type.eq.pio_double) THEN
5360 piovar%dkind=pio_double
5361 iodesc => iodesc_dp_u2dvar(ng)
5362 ELSE
5363 piovar%dkind=pio_real
5364 iodesc => iodesc_sp_u2dvar(ng)
5365 END IF
5366 status=nf_fwrite2d(ng, model, piofile, idygru, &
5367 & piovar, 0, iodesc, &
5368 & lbi, ubi, lbj, ubj, scale, &
5369# ifdef MASKING
5370 & grid(ng) % umask, &
5371# endif
5372 & grid(ng) % yu, &
5373 & setfillval = .false.)
5374 IF (founderror(status, pio_noerr, &
5375 & __line__, myfile)) THEN
5376 IF (master) WRITE (stdout,10) trim(vname(1,idxgru)), &
5377 & trim(ncname)
5378 exit_flag=3
5379 ioerror=status
5380 END IF
5381 ELSE
5382 IF (master) WRITE (stdout,20) trim(vname(1,idxgru)), &
5383 & trim(ncname)
5384 exit_flag=3
5385 ioerror=nf90_enotvar
5386 END IF
5387 END IF
5388 END IF
5389 END IF
5390!
5391! Grid coordinates of V-points.
5392!
5393 IF (spherical) THEN
5394 IF (exit_flag.eq.noerror) THEN
5395 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5396 scale=1.0_dp
5397 IF (pio_netcdf_find_var(ng, model, piofile, &
5398 & trim(vname(1,idlonv)), &
5399 & piovar%vd)) THEN
5400 piovar%gtype=v2dvar
5401 IF (pio_type.eq.pio_double) THEN
5402 piovar%dkind=pio_double
5403 iodesc => iodesc_dp_v2dvar(ng)
5404 ELSE
5405 piovar%dkind=pio_real
5406 iodesc => iodesc_sp_v2dvar(ng)
5407 END IF
5408 status=nf_fwrite2d(ng, model, piofile, idlonv, &
5409 & piovar, 0, iodesc, &
5410 & lbi, ubi, lbj, ubj, scale, &
5411# ifdef MASKING
5412 & grid(ng) % vmask, &
5413# endif
5414 & grid(ng) % lonv, &
5415 & setfillval = .false.)
5416 IF (founderror(status, pio_noerr, &
5417 & __line__, myfile)) THEN
5418 IF (master) WRITE (stdout,10) trim(vname(1,idlonv)), &
5419 & trim(ncname)
5420 exit_flag=3
5421 ioerror=status
5422 END IF
5423 ELSE
5424 IF (master) WRITE (stdout,10) trim(vname(1,idlonv)), &
5425 & trim(ncname)
5426 exit_flag=3
5427 ioerror=nf90_enotvar
5428 END IF
5429 END IF
5430 END IF
5431!
5432 IF (exit_flag.eq.noerror) THEN
5433 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5434 scale=1.0_dp
5435 IF (pio_netcdf_find_var(ng, model, piofile, &
5436 & trim(vname(1,idlatv)), &
5437 & piovar%vd)) THEN
5438 piovar%gtype=v2dvar
5439 IF (pio_type.eq.pio_double) THEN
5440 piovar%dkind=pio_double
5441 iodesc => iodesc_dp_v2dvar(ng)
5442 ELSE
5443 piovar%dkind=pio_real
5444 iodesc => iodesc_sp_v2dvar(ng)
5445 END IF
5446 status=nf_fwrite2d(ng, model, piofile, idlatv, &
5447 & piovar, 0, iodesc, &
5448 & lbi, ubi, lbj, ubj, scale, &
5449# ifdef MASKING
5450 & grid(ng) % vmask, &
5451# endif
5452 & grid(ng) % latv, &
5453 & setfillval = .false.)
5454 IF (founderror(status, pio_noerr, &
5455 & __line__, myfile)) THEN
5456 IF (master) WRITE (stdout,10) trim(vname(1,idlatv)), &
5457 & trim(ncname)
5458 exit_flag=3
5459 ioerror=status
5460 END IF
5461 ELSE
5462 IF (master) WRITE (stdout,20) trim(vname(1,idlatv)), &
5463 & trim(ncname)
5464 exit_flag=3
5465 ioerror=nf90_enotvar
5466 END IF
5467 END IF
5468 END IF
5469 END IF
5470!
5471 IF (.not.spherical) THEN
5472 IF (exit_flag.eq.noerror) THEN
5473 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5474 scale=1.0_dp
5475 IF (pio_netcdf_find_var(ng, model, piofile, &
5476 & trim(vname(1,idxgrv)), &
5477 & piovar%vd)) THEN
5478 piovar%gtype=v2dvar
5479 IF (pio_type.eq.pio_double) THEN
5480 piovar%dkind=pio_double
5481 iodesc => iodesc_dp_v2dvar(ng)
5482 ELSE
5483 piovar%dkind=pio_real
5484 iodesc => iodesc_sp_v2dvar(ng)
5485 END IF
5486 status=nf_fwrite2d(ng, model, piofile, idxgrv, &
5487 & piovar, 0, iodesc, &
5488 & lbi, ubi, lbj, ubj, scale, &
5489# ifdef MASKING
5490 & grid(ng) % vmask, &
5491# endif
5492 & grid(ng) % xv, &
5493 & setfillval = .false.)
5494 IF (founderror(status, pio_noerr, &
5495 & __line__, myfile)) THEN
5496 IF (master) WRITE (stdout,10) trim(vname(1,idxgrv)), &
5497 & trim(ncname)
5498 exit_flag=3
5499 ioerror=status
5500 END IF
5501 ELSE
5502 IF (master) WRITE (stdout,10) trim(vname(1,idxgrv)), &
5503 & trim(ncname)
5504 exit_flag=3
5505 ioerror=nf90_enotvar
5506 END IF
5507 END IF
5508 END IF
5509!
5510 IF (exit_flag.eq.noerror) THEN
5511 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5512 scale=1.0_dp
5513 IF (pio_netcdf_find_var(ng, model, piofile, &
5514 & trim(vname(1,idygrv)), &
5515 & piovar%vd)) THEN
5516 piovar%gtype=v2dvar
5517 IF (pio_type.eq.pio_double) THEN
5518 piovar%dkind=pio_double
5519 iodesc => iodesc_dp_v2dvar(ng)
5520 ELSE
5521 piovar%dkind=pio_real
5522 iodesc => iodesc_sp_v2dvar(ng)
5523 END IF
5524 status=nf_fwrite2d(ng, model, piofile, idygrv, &
5525 & piovar, 0, iodesc, &
5526 & lbi, ubi, lbj, ubj, scale, &
5527# ifdef MASKING
5528 & grid(ng) % vmask, &
5529# endif
5530 & grid(ng) % yv, &
5531 & setfillval = .false.)
5532 IF (founderror(status, pio_noerr, &
5533 & __line__, myfile)) THEN
5534 IF (master) WRITE (stdout,10) trim(vname(1,idygrv)), &
5535 & trim(ncname)
5536 exit_flag=3
5537 ioerror=status
5538 END IF
5539 ELSE
5540 IF (master) WRITE (stdout,20) trim(vname(1,idygrv)), &
5541 & trim(ncname)
5542 exit_flag=3
5543 ioerror=nf90_enotvar
5544 END IF
5545 END IF
5546 END IF
5547 END IF
5548!
5549! Grid coordinates of PSI-points.
5550!
5551 IF (spherical) THEN
5552 IF (exit_flag.eq.noerror) THEN
5553 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5554 scale=1.0_dp
5555 IF (pio_netcdf_find_var(ng, model, piofile, &
5556 & trim(vname(1,idlonp)), &
5557 & piovar%vd)) THEN
5558 piovar%gtype=p2dvar
5559 IF (pio_type.eq.pio_double) THEN
5560 piovar%dkind=pio_double
5561 iodesc => iodesc_dp_p2dvar(ng)
5562 ELSE
5563 piovar%dkind=pio_real
5564 iodesc => iodesc_sp_p2dvar(ng)
5565 END IF
5566 status=nf_fwrite2d(ng, model, piofile, idlonp, &
5567 & piovar, 0, iodesc, &
5568 & lbi, ubi, lbj, ubj, scale, &
5569# ifdef MASKING
5570 & grid(ng) % pmask, &
5571# endif
5572 & grid(ng) % lonp, &
5573 & setfillval = .false.)
5574 IF (founderror(status, pio_noerr, &
5575 & __line__, myfile)) THEN
5576 IF (master) WRITE (stdout,10) trim(vname(1,idlonp)), &
5577 & trim(ncname)
5578 exit_flag=3
5579 ioerror=status
5580 END IF
5581 ELSE
5582 IF (master) WRITE (stdout,20) trim(vname(1,idlonp)), &
5583 & trim(ncname)
5584 exit_flag=3
5585 ioerror=nf90_enotvar
5586 END IF
5587 END IF
5588 END IF
5589!
5590 IF (exit_flag.eq.noerror) THEN
5591 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5592 scale=1.0_dp
5593 IF (pio_netcdf_find_var(ng, model, piofile, &
5594 & trim(vname(1,idlatp)), &
5595 & piovar%vd)) THEN
5596 piovar%gtype=p2dvar
5597 IF (pio_type.eq.pio_double) THEN
5598 piovar%dkind=pio_double
5599 iodesc => iodesc_dp_p2dvar(ng)
5600 ELSE
5601 piovar%dkind=pio_real
5602 iodesc => iodesc_sp_p2dvar(ng)
5603 END IF
5604 status=nf_fwrite2d(ng, model, piofile, idlatp, &
5605 & piovar, 0, iodesc, &
5606 & lbi, ubi, lbj, ubj, scale, &
5607# ifdef MASKING
5608 & grid(ng) % pmask, &
5609# endif
5610 & grid(ng) % latp, &
5611 & setfillval = .false.)
5612 IF (founderror(status, pio_noerr, &
5613 & __line__, myfile)) THEN
5614 IF (master) WRITE (stdout,10) trim(vname(1,idlatp)), &
5615 & trim(ncname)
5616 exit_flag=3
5617 ioerror=status
5618 END IF
5619 ELSE
5620 IF (master) WRITE (stdout,20) trim(vname(1,idlatp)), &
5621 & trim(ncname)
5622 exit_flag=3
5623 ioerror=nf90_enotvar
5624 END IF
5625 END IF
5626 END IF
5627 END IF
5628!
5629 IF (.not.spherical) THEN
5630 IF (exit_flag.eq.noerror) THEN
5631 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5632 scale=1.0_dp
5633 IF (pio_netcdf_find_var(ng, model, piofile, &
5634 & trim(vname(1,idxgrp)), &
5635 & piovar%vd)) THEN
5636 piovar%gtype=p2dvar
5637 IF (pio_type.eq.pio_double) THEN
5638 piovar%dkind=pio_double
5639 iodesc => iodesc_dp_p2dvar(ng)
5640 ELSE
5641 piovar%dkind=pio_real
5642 iodesc => iodesc_sp_p2dvar(ng)
5643 END IF
5644 status=nf_fwrite2d(ng, model, piofile, idxgrp, &
5645 & piovar, 0, iodesc, &
5646 & lbi, ubi, lbj, ubj, scale, &
5647# ifdef MASKING
5648 & grid(ng) % pmask, &
5649# endif
5650 & grid(ng) % xp, &
5651 & setfillval = .false.)
5652 IF (founderror(status, pio_noerr, &
5653 & __line__, myfile)) THEN
5654 IF (master) WRITE (stdout,10) trim(vname(1,idxgrp)), &
5655 & trim(ncname)
5656 exit_flag=3
5657 ioerror=status
5658 END IF
5659 ELSE
5660 IF (master) WRITE (stdout,20) 'x_psi', trim(ncname)
5661 exit_flag=3
5662 ioerror=nf90_enotvar
5663 END IF
5664 END IF
5665 END IF
5666
5667 IF (exit_flag.eq.noerror) THEN
5668 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5669 scale=1.0_dp
5670 IF (pio_netcdf_find_var(ng, model, piofile, &
5671 & trim(vname(1,idygrp)), &
5672 & piovar%vd)) THEN
5673 piovar%gtype=p2dvar
5674 IF (pio_type.eq.pio_double) THEN
5675 piovar%dkind=pio_double
5676 iodesc => iodesc_dp_p2dvar(ng)
5677 ELSE
5678 piovar%dkind=pio_real
5679 iodesc => iodesc_sp_p2dvar(ng)
5680 END IF
5681 status=nf_fwrite2d(ng, model, piofile, idygrp, &
5682 & piovar, 0, iodesc, &
5683 & lbi, ubi, lbj, ubj, scale, &
5684# ifdef MASKING
5685 & grid(ng) % pmask, &
5686# endif
5687 & grid(ng) % yp, &
5688 & setfillval = .false.)
5689 IF (founderror(status, pio_noerr, &
5690 & __line__, myfile)) THEN
5691 IF (master) WRITE (stdout,10) trim(vname(1,idygrp)), &
5692 & trim(ncname)
5693 exit_flag=3
5694 ioerror=status
5695 END IF
5696 ELSE
5697 IF (master) WRITE (stdout,20) trim(vname(1,idygrp)), &
5698 & trim(ncname)
5699 exit_flag=3
5700 ioerror=nf90_enotvar
5701 END IF
5702 END IF
5703 END IF
5704 END IF
5705
5706# ifdef CURVGRID
5707!
5708! Angle between XI-axis and EAST at RHO-points.
5709!
5710 IF (exit_flag.eq.noerror) THEN
5711 scale=1.0_dp
5712 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5713 IF (pio_netcdf_find_var(ng, model, piofile, &
5714 & trim(vname(1,idangr)), &
5715 & piovar%vd)) THEN
5716 piovar%gtype=r2dvar
5717 IF (pio_type.eq.pio_double) THEN
5718 piovar%dkind=pio_double
5719 iodesc => iodesc_dp_r2dvar(ng)
5720 ELSE
5721 piovar%dkind=pio_real
5722 iodesc => iodesc_sp_r2dvar(ng)
5723 END IF
5724 status=nf_fwrite2d(ng, model, piofile, idangr, &
5725 & piovar, 0, iodesc, &
5726 & lbi, ubi, lbj, ubj, scale, &
5727# ifdef MASKING
5728 & grid(ng) % rmask, &
5729# endif
5730 & grid(ng) % angler, &
5731 & setfillval = .false.)
5732 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5733 IF (master) WRITE (stdout,10) trim(vname(1,idangr)), &
5734 & trim(ncname)
5735 exit_flag=3
5736 ioerror=status
5737 END IF
5738 ELSE
5739 IF (master) WRITE (stdout,20) trim(vname(1,idangr)), &
5740 & trim(ncname)
5741 exit_flag=3
5742 ioerror=nf90_enotvar
5743 END IF
5744# ifdef STATIONS
5745 ELSE
5746 CALL extract_sta2d (ng, model, cgrid, ifield, r2dvar, &
5747 & lbi, ubi, lbj, ubj, &
5748 & scale, grid(ng)%angler, &
5749 & nstation(ng), scalars(ng)%SposX, &
5750 & scalars(ng)%SposY, wrk)
5751 CALL pio_netcdf_put_fvar (ng, model, ncname, 'angle', &
5752 & wrk, (/1/), (/nstation(ng)/), &
5753 & piofile = piofile)
5754 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5755# endif
5756 END IF
5757 END IF
5758# endif
5759
5760# ifdef MASKING
5761!
5762! Masking fields at RHO-, U-, V-points, and PSI-points.
5763!
5764 IF (exit_flag.eq.noerror) THEN
5765 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5766 scale=1.0_dp
5767 IF (pio_netcdf_find_var(ng, model, piofile, &
5768 & trim(vname(1,idmskr)), &
5769 & piovar%vd)) THEN
5770 piovar%gtype=r2dvar
5771 IF (pio_type.eq.pio_double) THEN
5772 piovar%dkind=pio_double
5773 iodesc => iodesc_dp_r2dvar(ng)
5774 ELSE
5775 piovar%dkind=pio_real
5776 iodesc => iodesc_sp_r2dvar(ng)
5777 END IF
5778 status=nf_fwrite2d(ng, model, piofile, idmskr, &
5779 & piovar, 0, iodesc, &
5780 & lbi, ubi, lbj, ubj, scale, &
5781 & grid(ng) % rmask, &
5782 & grid(ng) % rmask, &
5783 & setfillval = .false.)
5784 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5785 IF (master) WRITE (stdout,10) trim(vname(1,idmskr)), &
5786 & trim(ncname)
5787 exit_flag=3
5788 ioerror=status
5789 END IF
5790 ELSE
5791 IF (master) WRITE (stdout,20) trim(vname(1,idmskr)), &
5792 & trim(ncname)
5793 exit_flag=3
5794 ioerror=nf90_enotvar
5795 END IF
5796 END IF
5797 END IF
5798!
5799 IF (exit_flag.eq.noerror) THEN
5800 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5801 scale=1.0_dp
5802 IF (pio_netcdf_find_var(ng, model, piofile, &
5803 & trim(vname(1,idmsku)), &
5804 & piovar%vd)) THEN
5805 piovar%gtype=u2dvar
5806 IF (pio_type.eq.pio_double) THEN
5807 piovar%dkind=pio_double
5808 iodesc => iodesc_dp_u2dvar(ng)
5809 ELSE
5810 piovar%dkind=pio_real
5811 iodesc => iodesc_sp_u2dvar(ng)
5812 END IF
5813 status=nf_fwrite2d(ng, model, piofile, idmsku, &
5814 & piovar, 0, iodesc, &
5815 & lbi, ubi, lbj, ubj, scale, &
5816 & grid(ng) % umask, &
5817 & grid(ng) % umask, &
5818 & setfillval = .false.)
5819 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5820 IF (master) WRITE (stdout,10) trim(vname(1,idmsku)), &
5821 & trim(ncname)
5822 exit_flag=3
5823 ioerror=status
5824 END IF
5825 ELSE
5826 IF (master) WRITE (stdout,20) trim(vname(1,idmsku)), &
5827 & trim(ncname)
5828 exit_flag=3
5829 ioerror=nf90_enotvar
5830 END IF
5831 END IF
5832 END IF
5833!
5834 IF (exit_flag.eq.noerror) THEN
5835 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5836 scale=1.0_dp
5837 IF (pio_netcdf_find_var(ng, model, piofile, &
5838 & trim(vname(1,idmskv)), &
5839 & piovar%vd)) THEN
5840 piovar%gtype=v2dvar
5841 IF (pio_type.eq.pio_double) THEN
5842 piovar%dkind=pio_double
5843 iodesc => iodesc_dp_v2dvar(ng)
5844 ELSE
5845 piovar%dkind=pio_real
5846 iodesc => iodesc_sp_v2dvar(ng)
5847 END IF
5848 status=nf_fwrite2d(ng, model, piofile, idmskv, &
5849 & piovar, 0, iodesc, &
5850 & lbi, ubi, lbj, ubj, scale, &
5851 & grid(ng) % vmask, &
5852 & grid(ng) % vmask, &
5853 & setfillval = .false.)
5854 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5855 IF (master) WRITE (stdout,10) trim(vname(1,idmskv)), &
5856 & trim(ncname)
5857 exit_flag=3
5858 ioerror=status
5859 END IF
5860 ELSE
5861 IF (master) WRITE (stdout,20) trim(vname(1,idmskv)), &
5862 & trim(ncname)
5863 exit_flag=3
5864 ioerror=nf90_enotvar
5865 END IF
5866 END IF
5867 END IF
5868!
5869 IF (exit_flag.eq.noerror) THEN
5870 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5871 scale=1.0_dp
5872 IF (pio_netcdf_find_var(ng, model, piofile, &
5873 & trim(vname(1,idmskp)), &
5874 & piovar%vd)) THEN
5875 piovar%gtype=p2dvar
5876 IF (pio_type.eq.pio_double) THEN
5877 piovar%dkind=pio_double
5878 iodesc => iodesc_dp_p2dvar(ng)
5879 ELSE
5880 piovar%dkind=pio_real
5881 iodesc => iodesc_sp_p2dvar(ng)
5882 END IF
5883 status=nf_fwrite2d(ng, model, piofile, idmskp, &
5884 & piovar, 0, iodesc, &
5885 & lbi, ubi, lbj, ubj, scale, &
5886 & grid(ng) % pmask, &
5887 & grid(ng) % pmask, &
5888 & setfillval = .false.)
5889 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5890 IF (master) WRITE (stdout,10) trim(vname(1,idmskp)), &
5891 & trim(ncname)
5892 exit_flag=3
5893 ioerror=status
5894 END IF
5895 ELSE
5896 IF (master) WRITE (stdout,20) trim(vname(1,idmskp)), &
5897 & trim(ncname)
5898 exit_flag=3
5899 ioerror=nf90_enotvar
5900 END IF
5901 END IF
5902 END IF
5903# endif
5904
5905# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
5906 defined opt_observations || defined sensitivity_4dvar || \
5907 defined so_semi
5908!
5909! Adjoint sensitivity spatial scope mask at RHO-, U-, and V-points.
5910!
5911 IF (exit_flag.eq.noerror) THEN
5912 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5913 scale=1.0_dp
5914 IF (pio_netcdf_find_var(ng, model, piofile, &
5915 & trim(vname(1,idscor)), &
5916 & piovar%vd)) THEN
5917 piovar%gtype=r2dvar
5918 IF (pio_type.eq.pio_double) THEN
5919 piovar%dkind=pio_double
5920 iodesc => iodesc_dp_r2dvar(ng)
5921 ELSE
5922 piovar%dkind=pio_real
5923 iodesc => iodesc_sp_r2dvar(ng)
5924 END IF
5925 status=nf_fwrite2d(ng, model, piofile, idscor, &
5926 & piovar, 0, iodesc, &
5927 & lbi, ubi, lbj, ubj, scale, &
5928# ifdef MASKING
5929 & grid(ng) % rmask, &
5930# endif
5931 & grid(ng) % Rscope, &
5932 & setfillval = .false.)
5933 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5934 IF (master) WRITE (stdout,10) trim(vname(1,idscor)), &
5935 & trim(ncname)
5936 exit_flag=3
5937 ioerror=status
5938 END IF
5939 ELSE
5940 IF (master) WRITE (stdout,20) trim(vname(1,idscor)), &
5941 & trim(ncname)
5942 exit_flag=3
5943 ioerror=nf90_enotvar
5944 END IF
5945 END IF
5946 END IF
5947!
5948 IF (exit_flag.eq.noerror) THEN
5949 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5950 scale=1.0_dp
5951 IF (pio_netcdf_find_var(ng, model, piofile, &
5952 & trim(vname(1,idscou)), &
5953 & piovar%vd)) THEN
5954 piovar%gtype=u2dvar
5955 IF (pio_type.eq.pio_double) THEN
5956 piovar%dkind=pio_double
5957 iodesc => iodesc_dp_u2dvar(ng)
5958 ELSE
5959 piovar%dkind=pio_real
5960 iodesc => iodesc_sp_u2dvar(ng)
5961 END IF
5962 status=nf_fwrite2d(ng, model, piofile, idscou, &
5963 & piovar, 0, iodesc, &
5964 & lbi, ubi, lbj, ubj, scale, &
5965# ifdef MASKING
5966 & grid(ng) % umask, &
5967# endif
5968 & grid(ng) % Uscope, &
5969 & setfillval = .false.)
5970 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5971 IF (master) WRITE (stdout,10) trim(vname(1,idscou)), &
5972 & trim(ncname)
5973 exit_flag=3
5974 ioerror=status
5975 END IF
5976 ELSE
5977 IF (master) WRITE (stdout,20) trim(vname(1,idscou)), &
5978 & trim(ncname)
5979 exit_flag=3
5980 ioerror=nf90_enotvar
5981 END IF
5982 END IF
5983 END IF
5984!
5985 IF (exit_flag.eq.noerror) THEN
5986 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
5987 scale=1.0_dp
5988 IF (pio_netcdf_find_var(ng, model, piofile, &
5989 & trim(vname(1,idscov)), &
5990 & piovar%vd)) THEN
5991 piovar%gtype=v2dvar
5992 IF (pio_type.eq.pio_double) THEN
5993 piovar%dkind=pio_double
5994 iodesc => iodesc_dp_v2dvar(ng)
5995 ELSE
5996 piovar%dkind=pio_real
5997 iodesc => iodesc_sp_v2dvar(ng)
5998 END IF
5999 status=nf_fwrite2d(ng, model, piofile, idscov, &
6000 & piovar, 0, iodesc, &
6001 & lbi, ubi, lbj, ubj, scale, &
6002# ifdef MASKING
6003 & grid(ng) % vmask, &
6004# endif
6005 & grid(ng) % Vscope, &
6006 & setfillval = .false.)
6007 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6008 IF (master) WRITE (stdout,10) trim(vname(1,idscov)), &
6009 & trim(ncname)
6010 exit_flag=3
6011 ioerror=status
6012 END IF
6013 ELSE
6014 IF (master) WRITE (stdout,20) trim(vname(1,idscov)), &
6015 & trim(ncname)
6016 exit_flag=3
6017 ioerror=nf90_enotvar
6018 END IF
6019 END IF
6020 END IF
6021# endif
6022# ifdef UV_DRAG_GRID
6023!
6024! Spatially bottom friction parameter.
6025!
6026 IF (exit_flag.eq.noerror) THEN
6027 IF (fileh.ne.abs(sta(ng)%pioFile%fh)) THEN
6028 scale=1.0_dp
6029# if defined UV_LOGDRAG || defined BBL_MODEL
6030 IF (pio_netcdf_find_var(ng, model, piofile, &
6031 & vname(1,idzobl), piovar%vd)) THEN
6032 piovar%gtype=r2dvar
6033 IF (pio_type.eq.pio_double) THEN
6034 piovar%dkind=pio_double
6035 iodesc => iodesc_dp_r2dvar(ng)
6036 ELSE
6037 piovar%dkind=pio_real
6038 iodesc => iodesc_sp_r2dvar(ng)
6039 END IF
6040 status=nf_fwrite2d(ng, model, piofile, idzobl, &
6041 & piovar, 0, iodesc, &
6042 & lbi, ubi, lbj, ubj, scale, &
6043# ifdef MASKING
6044 & grid(ng) % rmask, &
6045# endif
6046 & grid(ng) % ZoBot, &
6047 & setfillval = .false.)
6048 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6049 IF (master) WRITE (stdout,10) trim(vname(1,idzobl)), &
6050 & trim(ncname)
6051 exit_flag=3
6052 ioerror=status
6053 END IF
6054 ELSE
6055 IF (master) WRITE (stdout,20) trim(vname(1,idzobl)), &
6056 & trim(ncname)
6057 exit_flag=3
6058 ioerror=nf90_enotvar
6059 END IF
6060# endif
6061# ifdef UV_LDRAG
6062 IF (pio_netcdf_find_var(ng, model, piofile, &
6063 & vname(1,idragl), piovar%vd)) THEN
6064 piovar%gtype=r2dvar
6065 IF (pio_type.eq.pio_double) THEN
6066 piovar%dkind=pio_double
6067 iodesc => iodesc_dp_r2dvar(ng)
6068 ELSE
6069 piovar%dkind=pio_real
6070 iodesc => iodesc_sp_r2dvar(ng)
6071 END IF
6072 status=nf_fwrite2d(ng, model, piofile, idragl, &
6073 & piovar, 0, iodesc, &
6074 & lbi, ubi, lbj, ubj, scale, &
6075# ifdef MASKING
6076 & grid(ng) % rmask, &
6077# endif
6078 & grid(ng) % rdrag, &
6079 & setfillval = .false.)
6080 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6081 IF (master) WRITE (stdout,10) trim(vname(1,idragl)), &
6082 & trim(ncname)
6083 exit_flag=3
6084 ioerror=status
6085 END IF
6086 ELSE
6087 IF (master) WRITE (stdout,20) trim(vname(1,idragl)), &
6088 & trim(ncname)
6089 exit_flag=3
6090 ioerror=nf90_enotvar
6091 END IF
6092# endif
6093# ifdef UV_QDRAG
6094 IF (pio_netcdf_find_var(ng, model, piofile, &
6095 & vname(1,idragq), piovar%vd)) THEN
6096 piovar%gtype=r2dvar
6097 IF (pio_type.eq.pio_double) THEN
6098 piovar%dkind=pio_double
6099 iodesc => iodesc_dp_r2dvar(ng)
6100 ELSE
6101 piovar%dkind=pio_real
6102 iodesc => iodesc_sp_r2dvar(ng)
6103 END IF
6104 status=nf_fwrite2d(ng, model, piofile, idragq, &
6105 & piovar, 0, iodesc, &
6106 & lbi, ubi, lbj, ubj, scale, &
6107# ifdef MASKING
6108 & grid(ng) % rmask, &
6109# endif
6110 & grid(ng) % rdrag2, &
6111 & setfillval = .false.)
6112 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6113 IF (master) WRITE (stdout,10) trim(vname(1,idragq)), &
6114 & trim(ncname)
6115 exit_flag=3
6116 ioerror=status
6117 END IF
6118 ELSE
6119 IF (master) WRITE (stdout,20) trim(vname(1,idragq)), &
6120 & trim(ncname)
6121 exit_flag=3
6122 ioerror=nf90_enotvar
6123 END IF
6124# endif
6125 END IF
6126 END IF
6127# endif
6128 END IF grid_vars
6129!
6130!-----------------------------------------------------------------------
6131! Synchronize NetCDF file to disk to allow other processes to access
6132! data immediately after it is written.
6133!-----------------------------------------------------------------------
6134!
6135 CALL pio_netcdf_sync (ng, model, ncname, piofile)
6136 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6137!
6138 10 FORMAT (/,' WRT_INFO_PIO - error while writing variable: ',a,/, &
6139 & 16x,'into file: ',a)
6140 20 FORMAT (/,' WRT_INFO_PIO - error while inquiring ID for', &
6141 & ' variable: ',a,/,16x,'in file: ',a)
6142 30 FORMAT (/,' WRT_INFO_PIO - unable to synchronize to disk file:', &
6143 & /,16x,a)
6144!
6145 RETURN
mod_pio_netcdf::pio_netcdf_put_fvar
Definition mod_pio_netcdf.F:94
mod_pio_netcdf::pio_netcdf_put_ivar
Definition mod_pio_netcdf.F:108
mod_pio_netcdf::pio_netcdf_put_lvar
Definition mod_pio_netcdf.F:114
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::pio_type
integer, parameter pio_type
Definition mod_pio_netcdf.F:579
mod_pio_netcdf::pio_netcdf_sync
subroutine, public pio_netcdf_sync(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9275
mod_pio_netcdf::iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
Definition mod_pio_netcdf.F:195
mod_pio_netcdf::iodesc_sp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
Definition mod_pio_netcdf.F:194
mod_pio_netcdf::pio_netcdf_find_var
logical function pio_netcdf_find_var(ng, model, piofile, varname, piovar)
Definition mod_pio_netcdf.F:846
mod_pio_netcdf::iodesc_dp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
Definition mod_pio_netcdf.F:234
mod_pio_netcdf::iodesc_dp_p2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_p2dvar
Definition mod_pio_netcdf.F:232
mod_pio_netcdf::iodesc_dp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dvar
Definition mod_pio_netcdf.F:235
mod_pio_netcdf::iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
Definition mod_pio_netcdf.F:233
mod_pio_netcdf::iodesc_sp_p2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_p2dvar
Definition mod_pio_netcdf.F:193
mod_pio_netcdf::iodesc_sp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
Definition mod_pio_netcdf.F:196