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

Functions/Subroutines

subroutine, public wrt_gst (ng, model)
 
subroutine, private wrt_gst_nf90 (ng, model)
 
subroutine, private wrt_gst_pio (ng, model)
 

Function/Subroutine Documentation

◆ wrt_gst()

subroutine, public wrt_gst_mod::wrt_gst ( integer, intent(in) ng,
integer, intent(in) model )

Definition at line 38 of file wrt_gst.F.

39!***********************************************************************
40!
41! Imported variable declarations.
42!
43 integer, intent(in) :: ng, model
44!
45! Local variable declarations.
46!
47 character (len=*), parameter :: MyFile = &
48 & __FILE__
49!
50!-----------------------------------------------------------------------
51! Write out GST checkpointing fields according to IO type.
52!-----------------------------------------------------------------------
53!
54 SELECT CASE (gst(ng)%IOtype)
55 CASE (io_nf90)
56 CALL wrt_gst_nf90 (ng, model)
57
58# if defined PIO_LIB && defined DISTRIBUTE
59 CASE (io_pio)
60 CALL wrt_gst_pio (ng, model)
61# endif
62 CASE DEFAULT
63 IF (master) WRITE (stdout,10) gst(ng)%IOtype
64 exit_flag=3
65 END SELECT
66 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
67!
68 10 FORMAT (' WRT_GST - Illegal output file type, io_type = ',i0, &
69 & /,11x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
70!
71 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::gst, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, mod_iounits::stdout, wrt_gst_nf90(), and wrt_gst_pio().

Here is the call graph for this function:

◆ wrt_gst_nf90()

subroutine, private wrt_gst_mod::wrt_gst_nf90 ( integer, intent(in) ng,
integer, intent(in) model )
private

Definition at line 75 of file wrt_gst.F.

76!***********************************************************************
77!
78 USE mod_netcdf
79
80# ifdef DISTRIBUTE
81!
82 USE distribute_mod, ONLY : mp_bcasti
83 USE distribute_mod, ONLY : mp_ncwrite1d, mp_ncwrite2d
84# endif
85
86!
87! Imported variable declarations.
88!
89 integer, intent(in) :: ng, model
90!
91! Local variable declarations.
92!
93 integer :: status
94
95# ifdef DISTRIBUTE
96 integer :: Is, Ie
97 integer :: vrecord = -1
98
99 real(r8) :: scale = 1.0_r8
100# endif
101!
102 character (len=*), parameter :: MyFile = &
103 & __FILE__//", wrt_gst_nf90"
104!
105 sourcefile=myfile
106!
107!-----------------------------------------------------------------------
108! Write out checkpointing information variables.
109!-----------------------------------------------------------------------
110!
111 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
112!
113! Report.
114!
115 IF (master) WRITE (stdout,10) nrun+1
116!
117! Write out number of eigenvalues to compute.
118!
119 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'NEV', &
120 & nev, (/0/), (/0/), &
121 & ncid = gst(ng)%ncid)
122 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
123!
124! Write out number of Lanczos vectors to compute.
125!
126 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'NCV', &
127 & ncv, (/0/), (/0/), &
128 & ncid = gst(ng)%ncid)
129 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
130!
131! Write out size of the eigenvalue problem.
132!
133 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'Mstate', &
134 & mstate(ng), (/0/), (/0/), &
135 & ncid = gst(ng)%ncid)
136 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
137!
138! Write out iteration number.
139!
140 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'iter', &
141 & nrun, (/0/), (/0/), &
142 & ncid = gst(ng)%ncid)
143 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
144!
145! Write out reverse communications flag.
146!
147 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'ido', &
148 & ido(ng), (/0/), (/0/), &
149 & ncid = gst(ng)%ncid)
150 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
151!
152! Write out information and error flag.
153!
154 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'info', &
155 & info(ng), (/0/), (/0/), &
156 & ncid = gst(ng)%ncid)
157 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
158!
159! Write out eigenvalue problem type.
160!
161 CALL netcdf_put_svar (ng, model, gst(ng)%name, 'bmat', &
162 & bmat, (/1/), (/1/), &
163 & ncid = gst(ng)%ncid)
164 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
165!
166! Write out Ritz eigenvalues to compute.
167!
168 CALL netcdf_put_svar (ng, model, gst(ng)%name, 'which', &
169 & which, (/1/), (/2/), &
170 & ncid = gst(ng)%ncid)
171 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
172!
173! Write out form of basis function.
174!
175 CALL netcdf_put_svar (ng, model, gst(ng)%name, 'howmany', &
176 & howmany, (/1/), (/1/), &
177 & ncid = gst(ng)%ncid)
178 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
179!
180! Write out relative accuracy of computed Ritz values.
181!
182 CALL netcdf_put_fvar (ng, model, gst(ng)%name, 'Ritz_tol', &
183 & ritz_tol, (/0/), (/0/), &
184 & ncid = gst(ng)%ncid)
185 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
186!
187! Write out eigenproblem parameters.
188!
189 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'iparam', &
190 & iparam(:,ng), (/1/), (/SIZE(iparam)/), &
191 & ncid = gst(ng)%ncid)
192 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
193!
194! Write out pointers to mark starting location in work arrays.
195!
196 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'ipntr', &
197 & ipntr(:,ng), (/1/), (/SIZE(ipntr)/), &
198 & ncid = gst(ng)%ncid)
199 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
200!
201! Write ARPACK internal integer parameters to _aupd routines.
202!
203 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'iaupd', &
204 & iaupd, (/1/), (/SIZE(iaupd)/), &
205 & ncid = gst(ng)%ncid)
206 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
207!
208! Write ARPACK internal integer parameters to _aitr routines.
209!
210 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'iaitr', &
211 & iaitr, (/1/), (/SIZE(iaitr)/), &
212 & ncid = gst(ng)%ncid)
213 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
214!
215! Write ARPACK internal integer parameters to _aup2 routines.
216!
217 CALL netcdf_put_ivar (ng, model, gst(ng)%name, 'iaup2', &
218 & iaup2, (/1/), (/SIZE(iaup2)/), &
219 & ncid = gst(ng)%ncid)
220 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
221!
222! Write ARPACK internal logical parameters to _aitr routines.
223!
224 CALL netcdf_put_lvar (ng, model, gst(ng)%name, 'laitr', &
225 & laitr, (/1/), (/SIZE(laitr)/), &
226 & ncid = gst(ng)%ncid)
227 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
228!
229! Write ARPACK internal logical parameters to _aupd routines.
230!
231 CALL netcdf_put_lvar (ng, model, gst(ng)%name, 'laup2', &
232 & laup2, (/1/), (/SIZE(laup2)/), &
233 & ncid = gst(ng)%ncid)
234 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
235!
236! Define ARPACK internal real parameters to _aitr routines.
237!
238 CALL netcdf_put_fvar (ng, model, gst(ng)%name, 'raitr', &
239 & raitr, (/1/), (/SIZE(raitr)/), &
240 & ncid = gst(ng)%ncid)
241 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
242!
243! Define ARPACK internal real parameters to _aup2 routines.
244!
245 CALL netcdf_put_fvar (ng, model, gst(ng)%name, 'raup2', &
246 & raup2, (/1/), (/SIZE(raup2)/), &
247 & ncid = gst(ng)%ncid)
248 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
249!
250!-----------------------------------------------------------------------
251! Write out checkpointing variables associated with the state vector.
252!-----------------------------------------------------------------------
253!
254! Write out Lanczos/Arnoldi basis vectors.
255!
256# ifdef DISTRIBUTE
257 status=mp_ncwrite2d(ng, model, gst(ng)%ncid, 'Bvec', &
258 & gst(ng)%name, vrecord, &
259 & nstr(ng), nend(ng), 1, ncv, scale, &
260 & storage(ng)%Bvec(nstr(ng):,:))
261# else
262 CALL netcdf_put_fvar (ng, model, gst(ng)%name, 'Bvec', &
263 & storage(ng)%Bvec(nstr(ng):,1), &
264 & (/nstr(ng),1/), &
265 & (/nend(ng)-nstr(ng)+1,ncv/), &
266 & ncid = gst(ng)%ncid)
267# endif
268 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
269!
270! Write out eigenproblem residual vector.
271!
272# ifdef DISTRIBUTE
273 status=mp_ncwrite1d(ng, model, gst(ng)%ncid, 'resid', &
274 & gst(ng)%name, vrecord, &
275 & nstr(ng), nend(ng), scale, &
276 & storage(ng)%resid(nstr(ng):))
277# else
278 CALL netcdf_put_fvar (ng, model, gst(ng)%name, 'resid', &
279 & storage(ng)%resid(nstr(ng):), &
280 & (/nstr(ng)/), (/nend(ng)-nstr(ng)+1/), &
281 & ncid = gst(ng)%ncid)
282# endif
283 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
284!
285! Write out state reverse communication work array.
286!
287# ifdef DISTRIBUTE
288 is=myrank*3*nstate(ng)+1
289 ie=min(is+3*nstate(ng)-1, 3*mstate(ng))
290 status=mp_ncwrite1d(ng, model, gst(ng)%ncid, 'SworkD', &
291 & gst(ng)%name, vrecord, &
292 & is, ie, scale, &
293 & storage(ng)%SworkD)
294# else
295 CALL netcdf_put_fvar (ng, model, gst(ng)%name, 'SworkD', &
296 & storage(ng)%SworkD, &
297 & (/1/), (/3*nstate(ng)/), &
298 & ncid = gst(ng)%ncid)
299# endif
300 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
301!
302! Write out eigenproblem work array. In distributed-memory
303! applications, this array is identical in all the nodes.
304!
305 CALL netcdf_put_fvar (ng, model, gst(ng)%name, 'SworkL', &
306 & sworkl(:,ng), (/1/), (/lworkl/), &
307 & ncid = gst(ng)%ncid)
308 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
309!
310!-----------------------------------------------------------------------
311! Synchronize GST checkpointing NetCDF file to disk so the file
312! is available to other processes.
313!-----------------------------------------------------------------------
314!
315 CALL netcdf_sync (ng, model, gst(ng)%name, gst(ng)%ncid)
316 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
317!
318 10 FORMAT (2x,'WRT_GST_NF90 - writing GST checkpointing fields', &
319 & ' at iteration: ', i0)
320
321 RETURN
distribute_mod::mp_bcasti
Definition distribute.F:95
mod_netcdf::netcdf_put_fvar
Definition mod_netcdf.F:82
mod_netcdf::netcdf_put_ivar
Definition mod_netcdf.F:96
mod_netcdf::netcdf_put_lvar
Definition mod_netcdf.F:102
mod_netcdf::netcdf_put_svar
Definition mod_netcdf.F:108
distribute_mod
Definition distribute.F:3
distribute_mod::mp_ncwrite2d
integer function mp_ncwrite2d(ng, model, ncid, ncvname, ncname, ncrec, lb1, ub1, lb2, ub2, ascale, a)
Definition distribute.F:5940
distribute_mod::mp_ncwrite1d
integer function mp_ncwrite1d(ng, model, ncid, ncvname, ncname, ncrec, lb1, ub1, ascale, a)
Definition distribute.F:5722
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_sync
subroutine, public netcdf_sync(ng, model, ncname, ncid)
Definition mod_netcdf.F:9505

References mod_storage::bmat, mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::gst, mod_storage::howmany, mod_storage::iaitr, mod_storage::iaup2, mod_storage::iaupd, mod_storage::ido, mod_storage::info, mod_storage::iparam, mod_storage::ipntr, mod_storage::laitr, mod_storage::laup2, mod_storage::lworkl, mod_parallel::master, distribute_mod::mp_ncwrite1d(), distribute_mod::mp_ncwrite2d(), mod_param::mstate, mod_parallel::myrank, mod_storage::ncv, mod_param::nend, mod_netcdf::netcdf_sync(), mod_storage::nev, mod_scalars::noerror, mod_scalars::nrun, mod_param::nstate, mod_param::nstr, mod_storage::raitr, mod_storage::raup2, mod_scalars::ritz_tol, mod_iounits::sourcefile, mod_iounits::stdout, mod_storage::storage, mod_storage::sworkl, and mod_storage::which.

Referenced by wrt_gst().

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

◆ wrt_gst_pio()

subroutine, private wrt_gst_mod::wrt_gst_pio ( integer, intent(in) ng,
integer, intent(in) model )
private

Definition at line 327 of file wrt_gst.F.

328!***********************************************************************
329!
330 USE mod_pio_netcdf
331!
332! Imported variable declarations.
333!
334 integer, intent(in) :: ng, model
335!
336! Local variable declarations.
337!
338 integer :: status
339 integer :: Is, Ie, i, j
340!
341 real(r8) :: scale = 1.0_r8
342
343 real(r4), pointer :: A1d_4(:), A2d_4(:,:) ! single precision
344 real(r8), pointer :: A1d_8(:), A2d_8(:,:) ! double precision
345!
346 character (len=*), parameter :: MyFile = &
347 & __FILE__//", wrt_gst_pio"
348!
349 TYPE (Var_desc_t) :: pioVar
350!
351 sourcefile=myfile
352!
353!-----------------------------------------------------------------------
354! Write out checkpointing information variables.
355!-----------------------------------------------------------------------
356!
357 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
358!
359! Report.
360!
361 IF (master) WRITE (stdout,10) nrun+1
362!
363! Write out number of eigenvalues to compute.
364!
365 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'NEV', &
366 & nev, (/0/), (/0/), &
367 & piofile = gst(ng)%pioFile)
368 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
369!
370! Write out number of Lanczos vectors to compute.
371!
372 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'NCV', &
373 & ncv, (/0/), (/0/), &
374 & piofile = gst(ng)%pioFile)
375 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
376!
377! Write out size of the eigenvalue problem.
378!
379 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'Mstate', &
380 & mstate(ng), (/0/), (/0/), &
381 & piofile = gst(ng)%pioFile)
382 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
383!
384! Write out iteration number.
385!
386 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'iter', &
387 & nrun, (/0/), (/0/), &
388 & piofile = gst(ng)%pioFile)
389 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
390!
391! Write out reverse communications flag.
392!
393 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'ido', &
394 & ido(ng), (/0/), (/0/), &
395 & piofile = gst(ng)%pioFile)
396 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
397!
398! Write out information and error flag.
399!
400 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'info', &
401 & info(ng), (/0/), (/0/), &
402 & piofile = gst(ng)%pioFile)
403 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
404!
405! Write out eigenvalue problem type.
406!
407 CALL pio_netcdf_put_svar (ng, model, gst(ng)%name, 'bmat', &
408 & bmat, (/1/), (/1/), &
409 & piofile = gst(ng)%pioFile)
410 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
411!
412! Write out Ritz eigenvalues to compute.
413!
414 CALL pio_netcdf_put_svar (ng, model, gst(ng)%name, 'which', &
415 & which, (/1/), (/2/), &
416 & piofile = gst(ng)%pioFile)
417 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
418!
419! Write out form of basis function.
420!
421 CALL pio_netcdf_put_svar (ng, model, gst(ng)%name, 'howmany', &
422 & howmany, (/1/), (/1/), &
423 & piofile = gst(ng)%pioFile)
424 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
425!
426! Write out relative accuracy of computed Ritz values.
427!
428 CALL pio_netcdf_put_fvar (ng, model, gst(ng)%name, 'Ritz_tol', &
429 & ritz_tol, (/0/), (/0/), &
430 & piofile = gst(ng)%pioFile)
431 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
432!
433! Write out eigenproblem parameters.
434!
435 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'iparam', &
436 & iparam(:,ng), (/1/), (/SIZE(iparam)/), &
437 & piofile = gst(ng)%pioFile)
438 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
439!
440! Write out pointers to mark starting location in work arrays.
441!
442 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'ipntr', &
443 & ipntr(:,ng), (/1/), (/SIZE(ipntr)/), &
444 & piofile = gst(ng)%pioFile)
445 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
446!
447! Write ARPACK internal integer parameters to _aupd routines.
448!
449 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'iaupd', &
450 & iaupd, (/1/), (/SIZE(iaupd)/), &
451 & piofile = gst(ng)%pioFile)
452 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
453!
454! Write ARPACK internal integer parameters to _aitr routines.
455!
456 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'iaitr', &
457 & iaitr, (/1/), (/SIZE(iaitr)/), &
458 & piofile = gst(ng)%pioFile)
459 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
460!
461! Write ARPACK internal integer parameters to _aup2 routines.
462!
463 CALL pio_netcdf_put_ivar (ng, model, gst(ng)%name, 'iaup2', &
464 & iaup2, (/1/), (/SIZE(iaup2)/), &
465 & piofile = gst(ng)%pioFile)
466 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
467!
468! Write ARPACK internal logical parameters to _aitr routines.
469!
470 CALL pio_netcdf_put_lvar (ng, model, gst(ng)%name, 'laitr', &
471 & laitr, (/1/), (/SIZE(laitr)/), &
472 & piofile = gst(ng)%pioFile)
473 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
474!
475! Write ARPACK internal logical parameters to _aupd routines.
476!
477 CALL pio_netcdf_put_lvar (ng, model, gst(ng)%name, 'laup2', &
478 & laup2, (/1/), (/SIZE(laup2)/), &
479 & piofile = gst(ng)%pioFile)
480 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
481!
482! Define ARPACK internal real parameters to _aitr routines.
483!
484 CALL pio_netcdf_put_fvar (ng, model, gst(ng)%name, 'raitr', &
485 & raitr, (/1/), (/SIZE(raitr)/), &
486 & piofile = gst(ng)%pioFile)
487 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
488!
489! Define ARPACK internal real parameters to _aup2 routines.
490!
491 CALL pio_netcdf_put_fvar (ng, model, gst(ng)%name, 'raup2', &
492 & raup2, (/1/), (/SIZE(raup2)/), &
493 & piofile = gst(ng)%pioFile)
494 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
495!
496!-----------------------------------------------------------------------
497! Write out checkpointing variables associated with the state vector.
498!-----------------------------------------------------------------------
499!
500! Write out Lanczos/Arnoldi basis vectors.
501!
502 status=pio_inq_varid(gst(ng)%pioFile, 'Bvec', piovar)
503 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
504!
505 IF (pio_frst.eq.pio_double) THEN
506 allocate ( a2d_8(nstr(ng):nend(ng),1:ncv) )
507 DO j=1,ncv
508 DO i=nstr(ng),nend(ng)
509 a2d_8(i,j)=scale*storage(ng)%Bvec(i,j)
510 END DO
511 END DO
512 CALL pio_write_darray (gst(ng)%pioFile, piovar, &
513 & iodesc_dp_bvec(ng), &
514 & a2d_8, status)
515 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
516 deallocate (a2d_8)
517 ELSE
518 allocate ( a2d_4(nstr(ng):nend(ng),1:ncv) )
519 DO j=1,ncv
520 DO i=nstr(ng),nend(ng)
521 a2d_4(i,j)=real(scale*storage(ng)%Bvec(i,j), r4)
522 END DO
523 END DO
524 CALL pio_write_darray (gst(ng)%pioFile, piovar, &
525 & iodesc_sp_bvec(ng), &
526 & a2d_4, status)
527 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
528 deallocate (a2d_4)
529 END IF
530!
531! Write out eigenproblem residual vector.
532!
533 status=pio_inq_varid(gst(ng)%pioFile, 'resid', piovar)
534 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
535!
536 IF (pio_frst.eq.pio_double) THEN
537 allocate ( a1d_8(nstr(ng):nend(ng)) )
538 DO i=nstr(ng),nend(ng)
539 a1d_8(i)=scale*storage(ng)%resid(i)
540 END DO
541 CALL pio_write_darray (gst(ng)%pioFile, piovar, &
542 & iodesc_dp_resid(ng), &
543 & a1d_8, status)
544 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
545 deallocate (a1d_8)
546 ELSE
547 allocate ( a1d_4(nstr(ng):nend(ng)) )
548 DO i=nstr(ng),nend(ng)
549 a1d_4(i)=real(scale*storage(ng)%resid(i), r4)
550 END DO
551 CALL pio_write_darray (gst(ng)%pioFile, piovar, &
552 & iodesc_sp_resid(ng), &
553 & a1d_4, status)
554 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
555 deallocate (a1d_4)
556 END IF
557!
558! Write out state reverse communication work array.
559!
560 is=myrank*3*nstate(ng)+1
561 ie=min(is+3*nstate(ng)-1, 3*mstate(ng))
562!
563 status=pio_inq_varid(gst(ng)%pioFile, 'SworkD', piovar)
564 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
565!
566 IF (pio_frst.eq.pio_double) THEN
567 allocate ( a1d_8(is:ie) )
568 DO i=is,ie
569 a1d_8(i)=scale*storage(ng)%SworkD(i)
570 END DO
571 CALL pio_write_darray (gst(ng)%pioFile, piovar, &
572 & iodesc_dp_sworkd(ng), &
573 & a1d_8, status)
574 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
575 deallocate (a1d_8)
576 ELSE
577 allocate ( a1d_4(is:ie) )
578 DO i=is,ie
579 a1d_4(i)=real(scale*storage(ng)%SworkD(i), r4)
580 END DO
581 CALL pio_write_darray (gst(ng)%pioFile, piovar, &
582 & iodesc_sp_sworkd(ng), &
583 & a1d_4, status)
584 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
585 deallocate (a1d_4)
586 END IF
587!
588! Write out eigenproblem work array. In distributed-memory
589! applications, this array is identical in all the nodes.
590!
591 CALL pio_netcdf_put_fvar (ng, model, gst(ng)%name, 'SworkL', &
592 & sworkl(:,ng), (/1/), (/lworkl/), &
593 & piofile = gst(ng)%pioFile)
594 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
595!
596!-----------------------------------------------------------------------
597! Synchronize GST checkpointing NetCDF file to disk so the file
598! is available to other processes.
599!-----------------------------------------------------------------------
600!
601 CALL pio_netcdf_sync (ng, model, gst(ng)%name, gst(ng)%pioFile)
602 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
603!
604 10 FORMAT (2x,'WRT_GST_PIO - writing GST checkpointing fields', &
605 & ' at iteration: ', i0)
606
607 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::pio_netcdf_put_svar
Definition mod_pio_netcdf.F:120
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::iodesc_dp_resid
type(io_desc_t), dimension(:), pointer iodesc_dp_resid
Definition mod_pio_netcdf.F:431
mod_pio_netcdf::iodesc_sp_bvec
type(io_desc_t), dimension(:), pointer iodesc_sp_bvec
Definition mod_pio_netcdf.F:426
mod_pio_netcdf::iodesc_dp_bvec
type(io_desc_t), dimension(:), pointer iodesc_dp_bvec
Definition mod_pio_netcdf.F:430
mod_pio_netcdf::pio_netcdf_sync
subroutine, public pio_netcdf_sync(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9275
mod_pio_netcdf::pio_frst
integer, parameter pio_frst
Definition mod_pio_netcdf.F:574
mod_pio_netcdf::iodesc_sp_sworkd
type(io_desc_t), dimension(:), pointer iodesc_sp_sworkd
Definition mod_pio_netcdf.F:428
mod_pio_netcdf::iodesc_sp_resid
type(io_desc_t), dimension(:), pointer iodesc_sp_resid
Definition mod_pio_netcdf.F:427
mod_pio_netcdf::iodesc_dp_sworkd
type(io_desc_t), dimension(:), pointer iodesc_dp_sworkd
Definition mod_pio_netcdf.F:432

References mod_storage::bmat, mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::gst, mod_storage::howmany, mod_storage::iaitr, mod_storage::iaup2, mod_storage::iaupd, mod_storage::ido, mod_storage::info, mod_pio_netcdf::iodesc_dp_bvec, mod_pio_netcdf::iodesc_dp_resid, mod_pio_netcdf::iodesc_dp_sworkd, mod_pio_netcdf::iodesc_sp_bvec, mod_pio_netcdf::iodesc_sp_resid, mod_pio_netcdf::iodesc_sp_sworkd, mod_storage::iparam, mod_storage::ipntr, mod_storage::laitr, mod_storage::laup2, mod_storage::lworkl, mod_parallel::master, mod_param::mstate, mod_parallel::myrank, mod_storage::ncv, mod_param::nend, mod_storage::nev, mod_scalars::noerror, mod_scalars::nrun, mod_param::nstate, mod_param::nstr, mod_pio_netcdf::pio_frst, mod_pio_netcdf::pio_netcdf_sync(), mod_storage::raitr, mod_storage::raup2, mod_scalars::ritz_tol, mod_iounits::sourcefile, mod_iounits::stdout, mod_storage::storage, mod_storage::sworkl, and mod_storage::which.

Referenced by wrt_gst().

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