ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
wrt_impulse_mod Module Reference

Functions/Subroutines

subroutine, public wrt_impulse (ng, tile, model, inpncname)
 
subroutine, private wrt_impulse_nf90 (ng, tile, model, inpncname, lbi, ubi, lbj, ubj)
 
subroutine, private wrt_impulse_pio (ng, tile, model, inpncname, lbi, ubi, lbj, ubj)
 

Function/Subroutine Documentation

◆ wrt_impulse()

subroutine, public wrt_impulse_mod::wrt_impulse ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
character (len=*), intent(in) inpncname )

Definition at line 58 of file wrt_impulse.F.

59!***********************************************************************
60!
61! Imported variable declarations.
62!
63 integer, intent(in) :: ng, tile, model
64!
65 character (len=*), intent(in) :: INPncname
66!
67! Local variable declarations.
68!
69 integer :: LBi, UBi, LBj, UBj
70!
71 character (len=*), parameter :: MyFile = &
72 & __FILE__
73!
74!-----------------------------------------------------------------------
75! Write out time-averaged fields according to IO type.
76!-----------------------------------------------------------------------
77!
78 lbi=bounds(ng)%LBi(tile)
79 ubi=bounds(ng)%UBi(tile)
80 lbj=bounds(ng)%LBj(tile)
81 ubj=bounds(ng)%UBj(tile)
82!
83 SELECT CASE (lze(ng)%IOtype)
84 CASE (io_nf90)
85 CALL wrt_impulse_nf90 (ng, tile, model, inpncname, &
86 & lbi, ubi, lbj, ubj)
87
88# if defined PIO_LIB && defined DISTRIBUTE
89 CASE (io_pio)
90 CALL wrt_impulse_pio (ng, tile, model, inpncname, &
91 & lbi, ubi, lbj, ubj)
92# endif
93 CASE DEFAULT
94 IF (master) WRITE (stdout,10) lze(ng)%IOtype
95 exit_flag=3
96 END SELECT
97 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
98!
99 10 FORMAT (' WRT_IMPULSE - Illegal output file type, io_type = ',i0, &
100 & /,15x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
101!
102 RETURN

References mod_param::bounds, mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_iounits::lze, mod_parallel::master, mod_scalars::noerror, mod_iounits::stdout, wrt_impulse_nf90(), and wrt_impulse_pio().

Referenced by r4dvar_mod::increment(), and rbl4dvar_mod::increment().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_impulse_nf90()

subroutine, private wrt_impulse_mod::wrt_impulse_nf90 ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
character (len=*), intent(in) inpncname,
integer lbi,
integer ubi,
integer lbj,
integer ubj )
private

Definition at line 106 of file wrt_impulse.F.

108!***********************************************************************
109!
110 USE mod_netcdf
111!
112! Imported variable declarations.
113!
114 integer, intent(in) :: ng, tile, model
115!
116 character (len=*), intent(in) :: INPncname
117!
118! Local variable declarations.
119!
120 integer :: LBi, UBi, LBj, UBj
121 integer :: Iinp, Iout, Irec, MyType, Nrec
122 integer :: INPncid, INPvid
123 integer :: i, gtype, status, varid
124 integer :: ibuffer(2), Vsize(4)
125# ifdef CHECKSUM
126 integer(i8b) :: Fhash
127# endif
128!
129 real(r8) :: Fmin, Fmax
130 real(dp) :: scale
131 real(dp) :: inp_time(1)
132!
133 character (len=*), parameter :: MyFile = &
134 & __FILE__//", wrt_impulse_nf90"
135
136# include "set_bounds.h"
137!
138 sourcefile=myfile
139!
140!-----------------------------------------------------------------------
141! Determine variables to read and their availability.
142!-----------------------------------------------------------------------
143!
144! Inquire about the dimensions and check for consistency.
145!
146 CALL netcdf_check_dim (ng, model, inpncname)
147 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
148 nrec=rec_size
149!
150! Inquire about the variables.
151!
152 CALL netcdf_inq_var (ng, model, inpncname)
153 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
154!
155! Set Vsize to zero to deactivate interpolation of input data to model
156! grid in "nf_fread2d".
157!
158 DO i=1,4
159 vsize(i)=0
160 END DO
161!
162# ifdef SP4DVAR
163 IF (master) WRITE (stdout,10) nrec, trim(tlf(ng)%name)
164# else
165 IF (master) WRITE (stdout,10) nrec-1, trim(tlf(ng)%name)
166# endif
167!
168!-----------------------------------------------------------------------
169! Read adjoint solution and convert to impulse forcing. Then, write
170! impulse forcing into output NetCDF file.
171!-----------------------------------------------------------------------
172!
173! Open input NetCDF file.
174!
175 CALL netcdf_open (ng, model, inpncname, 0, inpncid)
176 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
177 WRITE (stdout,20) trim(inpncname)
178 RETURN
179 END IF
180# ifdef SP4DVAR
181!
182 iinp=1
183 scale=1.0_dp
184!
185 DO irec=1,nrec
186 iout=irec
187# else
188!
189! Process each record in input adjoint NetCDF except last. Note that
190! the adjoint records are processed backwards (Nrec-1:1) and written
191! in ascending time order (Iout initialized to 0) since the weak
192! constraint forcing will be read by the TL and RP models. Record
193! Nrec is not processed since it is not needed.
194!
195 iinp=1
196 iout=0
197 scale=1.0_dp
198!
199 DO irec=nrec-1,1,-1
200 iout=iout+1
201# endif
202!
203! Process time.
204!
205 IF (find_string(var_name, n_var, vname(1,idtime), inpvid)) THEN
206 CALL netcdf_get_time (ng, model, inpncname, vname(1,idtime), &
207 & rclock%DateNumber, inp_time, &
208 & ncid = inpncid, &
209 & start = (/irec/), total = (/1/))
210 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
211!
212 CALL netcdf_put_fvar (ng, model, tlf(ng)%name, &
213 & vname(1,idtime), inp_time, &
214 & (/iout/), (/1/), &
215 & ncid = tlf(ng)%ncid)
216 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
217 ELSE
218 IF (master) WRITE (stdout,30) trim(vname(1,idtime)), &
219 & trim(inpncname)
220 exit_flag=2
221 END IF
222!
223! Process free-surface weak-constraint impulse forcing.
224!
225 IF (find_string(var_name, n_var, vname(1,idztlf), inpvid)) THEN
226 gtype=var_flag(inpvid)*r2dvar
227 mytype=gtype
228 status=nf_fread2d(ng, model, inpncname, inpncid, &
229 & vname(1,idztlf), inpvid, &
230 & irec, mytype, vsize, &
231 & lbi, ubi, lbj, ubj, &
232 & scale, fmin, fmax, &
233# ifdef MASKING
234 & grid(ng) % rmask, &
235# endif
236# ifdef CHECKSUM
237 & ocean(ng) % ad_zeta(:,:,iinp), &
238 & checksum = fhash)
239# else
240 & ocean(ng) % ad_zeta(:,:,iinp))
241# endif
242 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
243 IF (master) THEN
244 WRITE (stdout,40) trim(vname(1,idztlf)), irec, &
245 & trim(inpncname)
246 END IF
247 exit_flag=2
248 ioerror=status
249 RETURN
250 ELSE
251 IF (master) THEN
252 WRITE (stdout,50) trim(vname(1,idztlf)), irec, &
253# ifdef CHECKSUM
254 & fmin, fmax, fhash
255# else
256 & fmin, fmax
257# endif
258 END IF
259 END IF
260!
261 mytype=gtype
262 status=nf_fwrite2d(ng, model, tlf(ng)%ncid, idztlf, &
263 & tlf(ng)%Vid(idztlf), &
264 & iout, mytype, &
265 & lbi, ubi, lbj, ubj, scale, &
266# ifdef MASKING
267 & grid(ng) % rmask, &
268# endif
269 & ocean(ng) % ad_zeta(:,:,iinp))
270 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
271 IF (master) THEN
272 WRITE (stdout,60) trim(vname(1,idztlf)), irec, &
273 & trim(tlf(ng)%name)
274 END IF
275 exit_flag=3
276 ioerror=status
277 RETURN
278 END IF
279 ELSE
280 IF (master) WRITE (stdout,30) trim(vname(1,idztlf)), &
281 & trim(inpncname)
282 exit_flag=2
283 RETURN
284 END IF
285
286# ifndef SOLVE3D
287!
288! Process 2D U-momentum weak-constraint impulse forcing.
289!
290 IF (find_string(var_name, n_var, vname(1,idubtf), inpvid)) THEN
291 gtype=var_flag(inpvid)*u2dvar
292 mytype=gtype
293 status=nf_fread2d(ng, model, inpncname, inpncid, &
294 & vname(1,idubtf), inpvid, &
295 & irec, mytype, vsize, &
296 & lbi, ubi, lbj, ubj, &
297 & scale, fmin, fmax, &
298# ifdef MASKING
299 & grid(ng) % umask_full, &
300# endif
301# ifdef CHECKSUM
302 & ocean(ng) % ad_ubar(:,:,iinp), &
303 & checksum = fhash)
304# else
305 & ocean(ng) % ad_ubar(:,:,iinp))
306# endif
307 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
308 IF (master) THEN
309 WRITE (stdout,40) trim(vname(1,idubtf)), irec, &
310 & trim(inpncname)
311 END IF
312 exit_flag=2
313 ioerror=status
314 RETURN
315 ELSE
316 IF (master) THEN
317 WRITE (stdout,50) trim(vname(1,idubtf)), irec, &
318# ifdef CHECKSUM
319 & fmin, fmax, fhash
320# else
321 & fmin, fmax
322# endif
323 END IF
324 END IF
325!
326 mytype=gtype
327 status=nf_fwrite2d(ng, model, tlf(ng)%ncid, idubtf, &
328 & tlf(ng)%Vid(idubtf), &
329 & iout, mytype, &
330 & lbi, ubi, lbj, ubj, scale, &
331# ifdef MASKING
332 & grid(ng) % umask_full, &
333# endif
334 & ocean(ng) % ad_ubar(:,:,iinp))
335 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
336 IF (master) THEN
337 WRITE (stdout,60) trim(vname(1,idubtf)), irec, &
338 & trim(tlf(ng)%name)
339 END IF
340 exit_flag=3
341 ioerror=status
342 RETURN
343 END IF
344 ELSE
345 IF (master) WRITE (stdout,30) trim(vname(1,idubtf)), &
346 & trim(inpncname)
347 exit_flag=2
348 RETURN
349 END IF
350!
351! Process 2D V-momentum weak-constraint impulse forcing.
352!
353 IF (find_string(var_name, n_var, vname(1,idvbtf), inpvid)) THEN
354 gtype=var_flag(inpvid)*v2dvar
355 mytype=gtype
356 status=nf_fread2d(ng, model, inpncname, inpncid, &
357 & vname(1,idvbtf), inpvid, &
358 & irec, mytype, vsize, &
359 & lbi, ubi, lbj, ubj, &
360 & scale, fmin, fmax, &
361# ifdef MASKING
362 & grid(ng) % vmask_full, &
363# endif
364# ifdef CHECKSUM
365 & ocean(ng) % ad_vbar(:,:,iinp), &
366 & checksum = fhash)
367# else
368 & ocean(ng) % ad_vbar(:,:,iinp))
369# endif
370 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
371 IF (master) THEN
372 WRITE (stdout,40) trim(vname(1,idvbtf)), irec, &
373 & trim(inpncname)
374 END IF
375 exit_flag=2
376 ioerror=status
377 RETURN
378 ELSE
379 IF (master) THEN
380 WRITE (stdout,50) trim(vname(1,idvbtf)), irec, &
381# ifdef CHECKSUM
382 & fmin, fmax, fhash
383# else
384 & fmin, fmax
385# endif
386 END IF
387 END IF
388!
389 mytype=gtype
390 status=nf_fwrite2d(ng, model, tlf(ng)%ncid, idvbtf, &
391 & tlf(ng)%Vid(idvbtf), &
392 & iout, mytype, &
393 & lbi, ubi, lbj, ubj, scale, &
394# ifdef MASKING
395 & grid(ng) % vmask_full, &
396# endif
397 & ocean(ng) % ad_vbar(:,:,iinp))
398 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
399 IF (master) THEN
400 WRITE (stdout,60) trim(vname(1,idvbtf)), irec, &
401 & trim(tlf(ng)%name)
402 END IF
403 exit_flag=3
404 ioerror=status
405 RETURN
406 END IF
407 ELSE
408 IF (master) WRITE (stdout,30) trim(vname(1,idvbtf)), &
409 & trim(inpncname)
410 exit_flag=2
411 RETURN
412 END IF
413# endif
414# ifdef SOLVE3D
415!
416! Process 3D U-momentum weak-constraint impulse forcing.
417!
418 IF (find_string(var_name, n_var, vname(1,idutlf), inpvid)) THEN
419 gtype=var_flag(inpvid)*u3dvar
420 mytype=gtype
421 status=nf_fread3d(ng, model, inpncname, inpncid, &
422 & vname(1,idutlf), inpvid, &
423 & irec, mytype, vsize, &
424 & lbi, ubi, lbj, ubj, 1, n(ng), &
425 & scale, fmin, fmax, &
426# ifdef MASKING
427 & grid(ng) % umask_full, &
428# endif
429# ifdef CHECKSUM
430 & ocean(ng) % ad_u(:,:,:,iinp), &
431 & checksum = fhash)
432# else
433 & ocean(ng) % ad_u(:,:,:,iinp))
434# endif
435 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
436 IF (master) THEN
437 WRITE (stdout,40) trim(vname(1,idutlf)), irec, &
438 & trim(inpncname)
439 END IF
440 exit_flag=2
441 ioerror=status
442 RETURN
443 ELSE
444 IF (master) THEN
445 WRITE (stdout,50) trim(vname(1,idutlf)), irec, &
446# ifdef CHECKSUM
447 & fmin, fmax, fhash
448# else
449 & fmin, fmax
450# endif
451 END IF
452 END IF
453!
454 status=nf_fwrite3d(ng, model, tlf(ng)%ncid, idutlf, &
455 & tlf(ng)%Vid(idutlf), &
456 & iout, mytype, &
457 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
458# ifdef MASKING
459 & grid(ng) % umask_full, &
460# endif
461 & ocean(ng) % ad_u(:,:,:,iinp))
462 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
463 IF (master) THEN
464 WRITE (stdout,60) trim(vname(1,idutlf)), irec, &
465 & trim(tlf(ng)%name)
466 END IF
467 exit_flag=3
468 ioerror=status
469 RETURN
470 END IF
471 ELSE
472 IF (master) WRITE (stdout,30) trim(vname(1,idutlf)), &
473 & trim(inpncname)
474 exit_flag=2
475 RETURN
476 END IF
477!
478! Process 3D V-momentum weak-constraint impulse forcing.
479!
480 IF (find_string(var_name, n_var, vname(1,idvtlf), inpvid)) THEN
481 gtype=var_flag(inpvid)*v3dvar
482 mytype=gtype
483 status=nf_fread3d(ng, model, inpncname, inpncid, &
484 & vname(1,idvtlf), inpvid, &
485 & irec, mytype, vsize, &
486 & lbi, ubi, lbj, ubj, 1, n(ng), &
487 & scale, fmin, fmax, &
488# ifdef MASKING
489 & grid(ng) % vmask_full, &
490# endif
491# ifdef CHECKSUM
492 & ocean(ng) % ad_v(:,:,:,iinp), &
493 & checksum = fhash)
494# else
495 & ocean(ng) % ad_v(:,:,:,iinp))
496# endif
497 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
498 IF (master) THEN
499 WRITE (stdout,40) trim(vname(1,idvtlf)), irec, &
500 & trim(inpncname)
501 END IF
502 exit_flag=2
503 ioerror=status
504 RETURN
505 ELSE
506 IF (master) THEN
507 WRITE (stdout,50) trim(vname(1,idvtlf)), irec, &
508# ifdef CHECKSUM
509 & fmin, fmax, fhash
510# else
511 & fmin, fmax
512# endif
513 END IF
514 END IF
515!
516 status=nf_fwrite3d(ng, model, tlf(ng)%ncid, idvtlf, &
517 & tlf(ng)%Vid(idvtlf), &
518 & iout, mytype, &
519 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
520# ifdef MASKING
521 & grid(ng) % vmask_full, &
522# endif
523 & ocean(ng) % ad_v(:,:,:,iinp))
524 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
525 IF (master) THEN
526 WRITE (stdout,60) trim(vname(1,idvtlf)), irec, &
527 & trim(tlf(ng)%name)
528 END IF
529 exit_flag=3
530 ioerror=status
531 RETURN
532 END IF
533 ELSE
534 IF (master) WRITE (stdout,30) trim(vname(1,idvtlf)), &
535 & trim(inpncname)
536 exit_flag=2
537 RETURN
538 END IF
539!
540! Process tracer type variables impulses.
541!
542 DO i=1,nt(ng)
543 IF (find_string(var_name, n_var, vname(1,idttlf(i)), &
544 & inpvid)) THEN
545 gtype=var_flag(inpvid)*r3dvar
546 mytype=gtype
547 status=nf_fread3d(ng, model, inpncname, inpncid, &
548 & vname(1,idttlf(i)), inpvid, &
549 & irec, mytype, vsize, &
550 & lbi, ubi, lbj, ubj, 1, n(ng), &
551 & scale, fmin, fmax, &
552# ifdef MASKING
553 & grid(ng) % rmask, &
554# endif
555# ifdef CHECKSUM
556 & ocean(ng) % ad_t(:,:,:,iinp,i), &
557 & checksum = fhash)
558# else
559 & ocean(ng) % ad_t(:,:,:,iinp,i))
560# endif
561 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
562 IF (master) THEN
563 WRITE (stdout,40) trim(vname(1,idttlf(i))), irec, &
564 & trim(inpncname)
565 END IF
566 exit_flag=2
567 ioerror=status
568 RETURN
569 ELSE
570 IF (master) THEN
571 WRITE (stdout,50) trim(vname(1,idttlf(i))), irec, &
572# ifdef CHECKSUM
573 & fmin, fmax, fhash
574# else
575 & fmin, fmax
576# endif
577 END IF
578 END IF
579!
580 status=nf_fwrite3d(ng, model, tlf(ng)%ncid, idttlf(i), &
581 & tlf(ng)%Tid(i), &
582 & iout, mytype, &
583 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
584# ifdef MASKING
585 & grid(ng) % rmask, &
586# endif
587 & ocean(ng) % ad_t(:,:,:,iinp,i))
588 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
589 IF (master) THEN
590 WRITE (stdout,60) trim(vname(1,idttlf(i))), irec, &
591 & trim(tlf(ng)%name)
592 END IF
593 exit_flag=3
594 ioerror=status
595 RETURN
596 END IF
597 ELSE
598 IF (master) WRITE (stdout,30) trim(vname(1,idttlf(i))), &
599 & trim(inpncname)
600 exit_flag=2
601 RETURN
602 END IF
603 END DO
604# endif
605 END DO
606!
607! Close input NetCDF file.
608!
609 CALL netcdf_close (ng, model, inpncid, inpncname, .false.)
610 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
611 WRITE (stdout,70) trim(inpncname)
612 RETURN
613 END IF
614!
615!-----------------------------------------------------------------------
616! Synchronize impulse NetCDF file to disk to allow other processes
617! to access data immediately after it is written.
618!-----------------------------------------------------------------------
619!
620 CALL netcdf_sync (ng, model, inpncname, tlf(ng)%ncid)
621 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
622!
623 10 FORMAT (2x,'WRT_IMPULSE_NF90 - processing convolved adjoint', &
624 & ' impulses, records: 1 to ',i0,/,21x,'file: ',a)
625 20 FORMAT (/,' WRT_IMPULSE_NF90 - unable to open input NetCDF', &
626 & ' file: ',a)
627 30 FORMAT (/,' WRT_IMPULSE_NF90 - cannot find state variable: ',a, &
628 & /,20x,'in input NetCDF file: ',a)
629 40 FORMAT (/,' WRT_IMPULSE_NF90 - error while reading variable: ',a, &
630 & 2x,'at time record = ',i0, &
631 & /,20x,'in input NetCDF file: ',a)
632# ifdef CHECKSUM
633 50 FORMAT (19x,'- ',a,/,22x,'(Rec = ',i0,' Min = ',1p,e15.8, &
634 & ' Max = ',1p,e15.8,' CheckSum = ',i0,')')
635# else
636 50 FORMAT (19x,'- ',a,/,22x,'(Rec = ',i0,' Min = ',1p,e15.8, &
637 & ' Max = ',1p,e15.8,')')
638# endif
639 60 FORMAT (/,' WRT_IMPULSE_NF90 - error while writing variable: ',a, &
640 & 2x,'at time record = ',i0,/,20x,'into NetCDF file: ',a)
641 70 FORMAT (/,' WRT_IMPULSE_NF90 - unable to close input NetCDF', &
642 & ' file: ',a)
643!
644 RETURN
mod_netcdf::netcdf_get_time
Definition mod_netcdf.F:77
mod_netcdf::netcdf_put_fvar
Definition mod_netcdf.F:82
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_close
subroutine, public netcdf_close(ng, model, ncid, ncname, lupdate)
Definition mod_netcdf.F:8930
mod_netcdf::var_flag
integer, dimension(mvars) var_flag
Definition mod_netcdf.F:162
mod_netcdf::netcdf_check_dim
subroutine, public netcdf_check_dim(ng, model, ncname, ncid)
Definition mod_netcdf.F:538
mod_netcdf::netcdf_open
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
Definition mod_netcdf.F:9293
mod_netcdf::var_name
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
mod_netcdf::n_var
integer n_var
Definition mod_netcdf.F:152
mod_netcdf::netcdf_sync
subroutine, public netcdf_sync(ng, model, ncname, ncid)
Definition mod_netcdf.F:9505
mod_netcdf::rec_size
integer rec_size
Definition mod_netcdf.F:156
mod_netcdf::netcdf_inq_var
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
Definition mod_netcdf.F:1371

References mod_scalars::exit_flag, strings_mod::find_string(), strings_mod::founderror(), mod_grid::grid, mod_ncparam::idtime, mod_ncparam::idttlf, mod_ncparam::idubtf, mod_ncparam::idutlf, mod_ncparam::idvbtf, mod_ncparam::idvtlf, mod_ncparam::idztlf, mod_iounits::ioerror, mod_parallel::master, mod_param::n, mod_netcdf::n_var, mod_netcdf::netcdf_check_dim(), mod_netcdf::netcdf_close(), mod_netcdf::netcdf_inq_var(), mod_netcdf::netcdf_open(), mod_netcdf::netcdf_sync(), mod_scalars::noerror, mod_param::nt, mod_ocean::ocean, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::rclock, mod_netcdf::rec_size, mod_iounits::sourcefile, mod_iounits::stdout, mod_iounits::tlf, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, mod_netcdf::var_flag, mod_netcdf::var_name, and mod_ncparam::vname.

Referenced by wrt_impulse().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_impulse_pio()

subroutine, private wrt_impulse_mod::wrt_impulse_pio ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
character (len=*), intent(in) inpncname,
integer lbi,
integer ubi,
integer lbj,
integer ubj )
private

Definition at line 650 of file wrt_impulse.F.

652!***********************************************************************
653!
654 USE mod_pio_netcdf
655!
656! Imported variable declarations.
657!
658 integer, intent(in) :: ng, tile, model
659!
660 character (len=*), intent(in) :: INPncname
661!
662! Local variable declarations.
663!
664 integer :: LBi, UBi, LBj, UBj
665 integer :: Iinp, Iout, Irec, Nrec
666 integer :: INPncid, INPvid
667 integer :: i, status
668 integer :: ibuffer(2), Vsize(4)
669# ifdef CHECKSUM
670 integer(i8b) :: Fhash
671# endif
672!
673 real(r8) :: Fmin, Fmax
674 real(dp) :: scale
675 real(dp) :: inp_time(1)
676!
677 character (len=*), parameter :: MyFile = &
678 & __FILE__//", wrt_impulse_pio"
679!
680 TYPE (IO_desc_t), pointer :: ioDesc
681 TYPE (File_desc_t) :: pioFile
682 TYPE (My_VarDesc) :: pioVar
683
684
685# include "set_bounds.h"
686!
687 sourcefile=myfile
688!
689!-----------------------------------------------------------------------
690! Determine variables to read and their availability.
691!-----------------------------------------------------------------------
692!
693! Inquire about the dimensions and check for consistency.
694!
695 CALL pio_netcdf_check_dim (ng, model, inpncname)
696 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
697 nrec=rec_size
698!
699! Inquire about the variables.
700!
701 CALL pio_netcdf_inq_var (ng, model, inpncname)
702 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
703!
704! Set Vsize to zero to deactivate interpolation of input data to model
705! grid in "nf_fread2d".
706!
707 DO i=1,4
708 vsize(i)=0
709 END DO
710!
711# ifdef SP4DVAR
712 IF (master) WRITE (stdout,10) nrec, trim(tlf(ng)%name)
713# else
714 IF (master) WRITE (stdout,10) nrec-1, trim(tlf(ng)%name)
715# endif
716!
717!-----------------------------------------------------------------------
718! Read adjoint solution and convert to impulse forcing. Then, write
719! impulse forcing into output NetCDF file.
720!-----------------------------------------------------------------------
721!
722! Open input NetCDF file.
723!
724 CALL pio_netcdf_open (ng, model, inpncname, 0, piofile)
725 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
726 WRITE (stdout,20) trim(inpncname)
727 RETURN
728 END IF
729# ifdef SP4DVAR
730!
731 iinp=1
732 scale=1.0_dp
733!
734 DO irec=1,nrec
735 iout=irec
736# else
737!
738! Process each record in input adjoint NetCDF except last. Note that
739! the adjoint records are processed backwards (Nrec-1:1) and written
740! in ascending time order (Iout initialized to 0) since the weak
741! constraint forcing will be read by the TL and RP models. Record
742! Nrec is not processed since it is not needed.
743!
744 iinp=1
745 iout=0
746 scale=1.0_dp
747!
748 DO irec=nrec-1,1,-1
749 iout=iout+1
750# endif
751!
752! Process time.
753!
754 IF (find_string(var_name, n_var, vname(1,idtime), inpvid)) THEN
755 CALL pio_netcdf_get_time (ng, model, inpncname, &
756 & vname(1,idtime), &
757 & rclock%DateNumber, inp_time, &
758 & piofile = piofile, &
759 & start = (/irec/), &
760 & total = (/1/))
761 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
762!
763 CALL pio_netcdf_put_fvar (ng, model, tlf(ng)%name, &
764 & vname(1,idtime), inp_time, &
765 & (/iout/), (/1/), &
766 & piofile = tlf(ng)%pioFile)
767 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
768 ELSE
769 IF (master) WRITE (stdout,30) trim(vname(1,idtime)), &
770 & trim(inpncname)
771 exit_flag=2
772 END IF
773!
774! Process free-surface weak-constraint impulse forcing.
775!
776 IF (find_string(var_name, n_var, vname(1,idztlf), inpvid)) THEN
777
778 piovar%vd=var_desc(inpvid)
779 IF (kind(ocean(ng)%ad_zeta).eq.8) THEN
780 piovar%dkind=pio_double
781 iodesc => iodesc_dp_r2dvar(ng)
782 ELSE
783 piovar%dkind=pio_real
784 iodesc => iodesc_sp_r2dvar(ng)
785 END IF
786 piovar%gtype=r2dvar
787
788 status=nf_fread2d(ng, model, inpncname, piofile, &
789 & vname(1,idztlf), piovar, irec, &
790 & iodesc, vsize, &
791 & lbi, ubi, lbj, ubj, &
792 & scale, fmin, fmax, &
793# ifdef MASKING
794 & grid(ng) % rmask, &
795# endif
796# ifdef CHECKSUM
797 & ocean(ng) % ad_zeta(:,:,iinp), &
798 & checksum = fhash)
799# else
800 & ocean(ng) % ad_zeta(:,:,iinp))
801# endif
802 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
803 IF (master) THEN
804 WRITE (stdout,40) trim(vname(1,idztlf)), irec, &
805 & trim(inpncname)
806 END IF
807 exit_flag=2
808 ioerror=status
809 RETURN
810 ELSE
811 IF (master) THEN
812 WRITE (stdout,50) trim(vname(1,idztlf)), irec, &
813# ifdef CHECKSUM
814 & fmin, fmax, fhash
815# else
816 & fmin, fmax
817# endif
818 END IF
819 END IF
820!
821 IF (tlf(ng)%pioVar(idztlf)%dkind.eq.pio_double) THEN
822 iodesc => iodesc_dp_r2dvar(ng)
823 ELSE
824 iodesc => iodesc_sp_r2dvar(ng)
825 END IF
826
827 status=nf_fwrite2d(ng, model, tlf(ng)%pioFile, idztlf, &
828 & tlf(ng)%pioVar(idztlf), iout, &
829 & iodesc, &
830 & lbi, ubi, lbj, ubj, scale, &
831# ifdef MASKING
832 & grid(ng) % rmask, &
833# endif
834 & ocean(ng) % ad_zeta(:,:,iinp))
835 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
836 IF (master) THEN
837 WRITE (stdout,60) trim(vname(1,idztlf)), irec, &
838 & trim(tlf(ng)%name)
839 END IF
840 exit_flag=3
841 ioerror=status
842 RETURN
843 END IF
844 ELSE
845 IF (master) WRITE (stdout,30) trim(vname(1,idztlf)), &
846 & trim(inpncname)
847 exit_flag=2
848 RETURN
849 END IF
850
851# ifndef SOLVE3D
852!
853! Process 2D U-momentum weak-constraint impulse forcing.
854!
855 IF (find_string(var_name, n_var, vname(1,idubtf), inpvid)) THEN
856
857 piovar%vd=var_desc(inpvid)
858 IF (kind(ocean(ng)%ad_ubar).eq.8) THEN
859 piovar%dkind=pio_double
860 iodesc => iodesc_dp_u2dvar(ng)
861 ELSE
862 piovar%dkind=pio_real
863 iodesc => iodesc_sp_u2dvar(ng)
864 END IF
865 piovar%gtype=u2dvar
866
867 status=nf_fread2d(ng, model, inpncname, piofile, &
868 & vname(1,idubtf), piovar, irec, &
869 & iodesc, vsize, &
870 & lbi, ubi, lbj, ubj, &
871 & scale, fmin, fmax, &
872# ifdef MASKING
873 & grid(ng) % umask_full, &
874# endif
875# ifdef CHECKSUM
876 & ocean(ng) % ad_ubar(:,:,iinp), &
877 & checksum = fhash)
878# else
879 & ocean(ng) % ad_ubar(:,:,iinp))
880# endif
881 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
882 IF (master) THEN
883 WRITE (stdout,40) trim(vname(1,idubtf)), irec, &
884 & trim(inpncname)
885 END IF
886 exit_flag=2
887 ioerror=status
888 RETURN
889 ELSE
890 IF (master) THEN
891 WRITE (stdout,50) trim(vname(1,idubtf)), irec, &
892# ifdef CHECKSUM
893 & fmin, fmax, fhash
894# else
895 & fmin, fmax
896# endif
897 END IF
898 END IF
899!
900 IF (tlf(ng)%pioVar(idubtf)%dkind.eq.pio_double) THEN
901 iodesc => iodesc_dp_u2dvar(ng)
902 ELSE
903 iodesc => iodesc_sp_u2dvar(ng)
904 END IF
905
906 status=nf_fwrite2d(ng, model, tlf(ng)%pioFile, idubtf, &
907 & tlf(ng)%pioVar(idubtf), iout, &
908 & iodesc, &
909 & lbi, ubi, lbj, ubj, scale, &
910# ifdef MASKING
911 & grid(ng) % umask_full, &
912# endif
913 & ocean(ng) % ad_ubar(:,:,iinp))
914 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
915 IF (master) THEN
916 WRITE (stdout,60) trim(vname(1,idubtf)), irec, &
917 & trim(tlf(ng)%name)
918 END IF
919 exit_flag=3
920 ioerror=status
921 RETURN
922 END IF
923 ELSE
924 IF (master) WRITE (stdout,30) trim(vname(1,idubtf)), &
925 & trim(inpncname)
926 exit_flag=2
927 RETURN
928 END IF
929!
930! Process 2D V-momentum weak-constraint impulse forcing.
931!
932 IF (find_string(var_name, n_var, vname(1,idvbtf), inpvid)) THEN
933
934 piovar%vd=var_desc(inpvid)
935 IF (kind(ocean(ng)%ad_vbar).eq.8) THEN
936 piovar%dkind=pio_double
937 iodesc => iodesc_dp_v2dvar(ng)
938 ELSE
939 piovar%dkind=pio_real
940 iodesc => iodesc_sp_v2dvar(ng)
941 END IF
942 piovar%gtype=v2dvar
943
944 status=nf_fread2d(ng, model, inpncname, piofile, &
945 & vname(1,idvbtf), piovar, irec, &
946 & iodesc, vsize, &
947 & lbi, ubi, lbj, ubj, &
948 & scale, fmin, fmax, &
949# ifdef MASKING
950 & grid(ng) % vmask_full, &
951# endif
952# ifdef CHECKSUM
953 & ocean(ng) % ad_vbar(:,:,iinp), &
954 & checksum = fhash)
955# else
956 & ocean(ng) % ad_vbar(:,:,iinp))
957# endif
958 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
959 IF (master) THEN
960 WRITE (stdout,40) trim(vname(1,idvbtf)), irec, &
961 & trim(inpncname)
962 END IF
963 exit_flag=2
964 ioerror=status
965 RETURN
966 ELSE
967 IF (master) THEN
968 WRITE (stdout,50) trim(vname(1,idvbtf)), irec, &
969# ifdef CHECKSUM
970 & fmin, fmax, fhash
971# else
972 & fmin, fmax
973# endif
974 END IF
975 END IF
976!
977 IF (tlf(ng)%pioVar(idvbtf)%dkind.eq.pio_double) THEN
978 iodesc => iodesc_dp_v2dvar(ng)
979 ELSE
980 iodesc => iodesc_sp_v2dvar(ng)
981 END IF
982
983 status=nf_fwrite2d(ng, model, tlf(ng)%pioFile, idvbtf, &
984 & tlf(ng)%pioVar(idvbtf), iout, &
985 & iodesc, &
986 & lbi, ubi, lbj, ubj, scale, &
987# ifdef MASKING
988 & grid(ng) % vmask_full, &
989# endif
990 & ocean(ng) % ad_vbar(:,:,iinp))
991 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
992 IF (master) THEN
993 WRITE (stdout,60) trim(vname(1,idvbtf)), irec, &
994 & trim(tlf(ng)%name)
995 END IF
996 exit_flag=3
997 ioerror=status
998 RETURN
999 END IF
1000 ELSE
1001 IF (master) WRITE (stdout,30) trim(vname(1,idvbtf)), &
1002 & trim(inpncname)
1003 exit_flag=2
1004 RETURN
1005 END IF
1006# endif
1007# ifdef SOLVE3D
1008!
1009! Process 3D U-momentum weak-constraint impulse forcing.
1010!
1011 IF (find_string(var_name, n_var, vname(1,idutlf), inpvid)) THEN
1012
1013 piovar%vd=var_desc(inpvid)
1014 IF (kind(ocean(ng)%ad_u).eq.8) THEN
1015 piovar%dkind=pio_double
1016 iodesc => iodesc_dp_u3dvar(ng)
1017 ELSE
1018 piovar%dkind=pio_real
1019 iodesc => iodesc_sp_u3dvar(ng)
1020 END IF
1021 piovar%gtype=u3dvar
1022
1023 status=nf_fread3d(ng, model, inpncname, piofile, &
1024 & vname(1,idutlf), piovar, irec, &
1025 & iodesc, vsize, &
1026 & lbi, ubi, lbj, ubj, 1, n(ng), &
1027 & scale, fmin, fmax, &
1028# ifdef MASKING
1029 & grid(ng) % umask_full, &
1030# endif
1031# ifdef CHECKSUM
1032 & ocean(ng) % ad_u(:,:,:,iinp), &
1033 & checksum = fhash)
1034# else
1035 & ocean(ng) % ad_u(:,:,:,iinp))
1036# endif
1037 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1038 IF (master) THEN
1039 WRITE (stdout,40) trim(vname(1,idutlf)), irec, &
1040 & trim(inpncname)
1041 END IF
1042 exit_flag=2
1043 ioerror=status
1044 RETURN
1045 ELSE
1046 IF (master) THEN
1047 WRITE (stdout,50) trim(vname(1,idutlf)), irec, &
1048# ifdef CHECKSUM
1049 & fmin, fmax, fhash
1050# else
1051 & fmin, fmax
1052# endif
1053 END IF
1054 END IF
1055!
1056 IF (tlf(ng)%pioVar(idutlf)%dkind.eq.pio_double) THEN
1057 iodesc => iodesc_dp_u3dvar(ng)
1058 ELSE
1059 iodesc => iodesc_sp_u3dvar(ng)
1060 END IF
1061
1062 status=nf_fwrite3d(ng, model, tlf(ng)%pioFile, idutlf, &
1063 & tlf(ng)%pioVar(idutlf), iout, &
1064 & iodesc, &
1065 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1066# ifdef MASKING
1067 & grid(ng) % umask_full, &
1068# endif
1069 & ocean(ng) % ad_u(:,:,:,iinp))
1070 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1071 IF (master) THEN
1072 WRITE (stdout,60) trim(vname(1,idutlf)), irec, &
1073 & trim(tlf(ng)%name)
1074 END IF
1075 exit_flag=3
1076 ioerror=status
1077 RETURN
1078 END IF
1079 ELSE
1080 IF (master) WRITE (stdout,30) trim(vname(1,idutlf)), &
1081 & trim(inpncname)
1082 exit_flag=2
1083 RETURN
1084 END IF
1085!
1086! Process 3D V-momentum weak-constraint impulse forcing.
1087!
1088 IF (find_string(var_name, n_var, vname(1,idvtlf), inpvid)) THEN
1089
1090 piovar%vd=var_desc(inpvid)
1091 IF (kind(ocean(ng)%ad_v).eq.8) THEN
1092 piovar%dkind=pio_double
1093 iodesc => iodesc_dp_v3dvar(ng)
1094 ELSE
1095 piovar%dkind=pio_real
1096 iodesc => iodesc_sp_v3dvar(ng)
1097 END IF
1098 piovar%gtype=v3dvar
1099
1100 status=nf_fread3d(ng, model, inpncname, piofile, &
1101 & vname(1,idvtlf), piovar, irec, &
1102 & iodesc, vsize, &
1103 & lbi, ubi, lbj, ubj, 1, n(ng), &
1104 & scale, fmin, fmax, &
1105# ifdef MASKING
1106 & grid(ng) % vmask_full, &
1107# endif
1108# ifdef CHECKSUM
1109 & ocean(ng) % ad_v(:,:,:,iinp), &
1110 & checksum = fhash)
1111# else
1112 & ocean(ng) % ad_v(:,:,:,iinp))
1113# endif
1114 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1115 IF (master) THEN
1116 WRITE (stdout,40) trim(vname(1,idvtlf)), irec, &
1117 & trim(inpncname)
1118 END IF
1119 exit_flag=2
1120 ioerror=status
1121 RETURN
1122 ELSE
1123 IF (master) THEN
1124 WRITE (stdout,50) trim(vname(1,idvtlf)), irec, &
1125# ifdef CHECKSUM
1126 & fmin, fmax, fhash
1127# else
1128 & fmin, fmax
1129# endif
1130 END IF
1131 END IF
1132!
1133 IF (tlf(ng)%pioVar(idvtlf)%dkind.eq.pio_double) THEN
1134 iodesc => iodesc_dp_v3dvar(ng)
1135 ELSE
1136 iodesc => iodesc_sp_v3dvar(ng)
1137 END IF
1138
1139 status=nf_fwrite3d(ng, model, tlf(ng)%pioFile, idvtlf, &
1140 & tlf(ng)%pioVar(idvtlf), iout, &
1141 & iodesc, &
1142 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1143# ifdef MASKING
1144 & grid(ng) % vmask_full, &
1145# endif
1146 & ocean(ng) % ad_v(:,:,:,iinp))
1147 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1148 IF (master) THEN
1149 WRITE (stdout,60) trim(vname(1,idvtlf)), irec, &
1150 & trim(tlf(ng)%name)
1151 END IF
1152 exit_flag=3
1153 ioerror=status
1154 RETURN
1155 END IF
1156 ELSE
1157 IF (master) WRITE (stdout,30) trim(vname(1,idvtlf)), &
1158 & trim(inpncname)
1159 exit_flag=2
1160 RETURN
1161 END IF
1162!
1163! Process tracer type variables impulses.
1164!
1165 DO i=1,nt(ng)
1166 IF (find_string(var_name, n_var, vname(1,idttlf(i)), &
1167 & inpvid)) THEN
1168
1169 piovar%vd=var_desc(inpvid)
1170 IF (kind(ocean(ng)%ad_t).eq.8) THEN
1171 piovar%dkind=pio_double
1172 iodesc => iodesc_dp_r3dvar(ng)
1173 ELSE
1174 piovar%dkind=pio_real
1175 iodesc => iodesc_sp_r3dvar(ng)
1176 END IF
1177 piovar%gtype=r3dvar
1178
1179 status=nf_fread3d(ng, model, inpncname, piofile, &
1180 & vname(1,idttlf(i)), piovar, &
1181 & irec, iodesc, vsize, &
1182 & lbi, ubi, lbj, ubj, 1, n(ng), &
1183 & scale, fmin, fmax, &
1184# ifdef MASKING
1185 & grid(ng) % rmask, &
1186# endif
1187# ifdef CHECKSUM
1188 & ocean(ng) % ad_t(:,:,:,iinp,i), &
1189 & checksum = fhash)
1190# else
1191 & ocean(ng) % ad_t(:,:,:,iinp,i))
1192# endif
1193 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1194 IF (master) THEN
1195 WRITE (stdout,40) trim(vname(1,idttlf(i))), irec, &
1196 & trim(inpncname)
1197 END IF
1198 exit_flag=2
1199 ioerror=status
1200 RETURN
1201 ELSE
1202 IF (master) THEN
1203 WRITE (stdout,50) trim(vname(1,idttlf(i))), irec, &
1204# ifdef CHECKSUM
1205 & fmin, fmax, fhash
1206# else
1207 & fmin, fmax
1208# endif
1209 END IF
1210 END IF
1211!
1212 IF (tlf(ng)%pioTrc(i)%dkind.eq.pio_double) THEN
1213 iodesc => iodesc_dp_r3dvar(ng)
1214 ELSE
1215 iodesc => iodesc_sp_r3dvar(ng)
1216 END IF
1217
1218 status=nf_fwrite3d(ng, model, tlf(ng)%pioFile, idttlf(i), &
1219 & tlf(ng)%pioTrc(i), iout, &
1220 & iodesc, &
1221 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1222# ifdef MASKING
1223 & grid(ng) % rmask, &
1224# endif
1225 & ocean(ng) % ad_t(:,:,:,iinp,i))
1226 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1227 IF (master) THEN
1228 WRITE (stdout,60) trim(vname(1,idttlf(i))), irec, &
1229 & trim(tlf(ng)%name)
1230 END IF
1231 exit_flag=3
1232 ioerror=status
1233 RETURN
1234 END IF
1235 ELSE
1236 IF (master) WRITE (stdout,30) trim(vname(1,idttlf(i))), &
1237 & trim(inpncname)
1238 exit_flag=2
1239 RETURN
1240 END IF
1241 END DO
1242# endif
1243 END DO
1244!
1245! Close input NetCDF file.
1246!
1247 CALL pio_netcdf_close (ng, model, piofile, inpncname, .false.)
1248 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1249 WRITE (stdout,70) trim(inpncname)
1250 RETURN
1251 END IF
1252!
1253!-----------------------------------------------------------------------
1254! Synchronize impulse NetCDF file to disk to allow other processes
1255! to access data immediately after it is written.
1256!-----------------------------------------------------------------------
1257!
1258 CALL pio_netcdf_sync (ng, model, inpncname, tlf(ng)%pioFile)
1259 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1260!
1261 10 FORMAT (2x,'WRT_IMPULSE_PIO - processing convolved adjoint', &
1262 & ' impulses, records: 1 to ',i0,/,21x,'file: ',a)
1263 20 FORMAT (/,' WRT_IMPULSE_PIO - unable to open input NetCDF', &
1264 & ' file: ',a)
1265 30 FORMAT (/,' WRT_IMPULSE_PIO - cannot find state variable: ',a, &
1266 & /,20x,'in input NetCDF file: ',a)
1267 40 FORMAT (/,' WRT_IMPULSE_PIO - error while reading variable: ',a, &
1268 & 2x,'at time record = ',i0, &
1269 & /,20x,'in input NetCDF file: ',a)
1270# ifdef CHECKSUM
1271 50 FORMAT (19x,'- ',a,/,22x,'(Rec = ',i0,' Min = ',1p,e15.8, &
1272 & ' Max = ',1p,e15.8,' CheckSum = ',i0,')')
1273# else
1274 50 FORMAT (19x,'- ',a,/,22x,'(Rec = ',i0,' Min = ',1p,e15.8, &
1275 & ' Max = ',1p,e15.8,')')
1276# endif
1277 60 FORMAT (/,' WRT_IMPULSE_PIO - error while writing variable: ',a, &
1278 & 2x,'at time record = ',i0,/,20x,'into NetCDF file: ',a)
1279 70 FORMAT (/,' WRT_IMPULSE_PIO - unable to close input NetCDF', &
1280 & ' file: ',a)
1281!
1282 RETURN
mod_pio_netcdf::pio_netcdf_get_time
Definition mod_pio_netcdf.F:89
mod_pio_netcdf::pio_netcdf_put_fvar
Definition mod_pio_netcdf.F:94
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
Definition mod_pio_netcdf.F:248
mod_pio_netcdf::iodesc_sp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
Definition mod_pio_netcdf.F:210
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_dp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
Definition mod_pio_netcdf.F:249
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
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_inq_var
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
Definition mod_pio_netcdf.F:1923
mod_pio_netcdf::pio_netcdf_close
subroutine, public pio_netcdf_close(ng, model, piofile, ncname, lupdate)
Definition mod_pio_netcdf.F:8858
mod_pio_netcdf::pio_netcdf_open
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
Definition mod_pio_netcdf.F:9148
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_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dvar
Definition mod_pio_netcdf.F:250
mod_pio_netcdf::pio_netcdf_check_dim
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:1080
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_sp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
Definition mod_pio_netcdf.F:211
mod_pio_netcdf::iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
Definition mod_pio_netcdf.F:209
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_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
Definition mod_pio_netcdf.F:196

References mod_scalars::exit_flag, strings_mod::find_string(), strings_mod::founderror(), mod_grid::grid, mod_ncparam::idtime, mod_ncparam::idttlf, mod_ncparam::idubtf, mod_ncparam::idutlf, mod_ncparam::idvbtf, mod_ncparam::idvtlf, mod_ncparam::idztlf, mod_pio_netcdf::iodesc_dp_r2dvar, mod_pio_netcdf::iodesc_dp_r3dvar, mod_pio_netcdf::iodesc_dp_u2dvar, mod_pio_netcdf::iodesc_dp_u3dvar, mod_pio_netcdf::iodesc_dp_v2dvar, mod_pio_netcdf::iodesc_dp_v3dvar, mod_pio_netcdf::iodesc_sp_r2dvar, mod_pio_netcdf::iodesc_sp_r3dvar, mod_pio_netcdf::iodesc_sp_u2dvar, mod_pio_netcdf::iodesc_sp_u3dvar, mod_pio_netcdf::iodesc_sp_v2dvar, mod_pio_netcdf::iodesc_sp_v3dvar, mod_iounits::ioerror, mod_parallel::master, mod_param::n, mod_scalars::noerror, mod_param::nt, mod_ocean::ocean, mod_pio_netcdf::pio_netcdf_check_dim(), mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_inq_var(), mod_pio_netcdf::pio_netcdf_open(), mod_pio_netcdf::pio_netcdf_sync(), mod_param::r2dvar, mod_param::r3dvar, mod_scalars::rclock, mod_iounits::sourcefile, mod_iounits::stdout, mod_iounits::tlf, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, mod_pio_netcdf::var_desc, and mod_ncparam::vname.

Referenced by wrt_impulse().

Here is the call graph for this function:
Here is the caller graph for this function: