ROMS
Loading...
Searching...
No Matches
get_gst.F
Go to the documentation of this file.
1#include "cppdefs.h"
3#if defined PROPAGATOR && defined CHECKPOINTING
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This routine reads in GST checkpointing restart file using either !
13! the standard NetCDF library or the Parallel-IO (PIO) library. !
14! !
15!=======================================================================
16!
17 USE mod_param
18 USE mod_parallel
19 USE mod_iounits
20 USE mod_ncparam
21 USE mod_scalars
22 USE mod_storage
23!
24 USE strings_mod, ONLY : founderror
25!
26 implicit none
27!
28 PUBLIC :: get_gst
29 PRIVATE :: get_gst_nf90
30# if defined PIO_LIB && defined DISTRIBUTE
31 PRIVATE :: get_gst_pio
32# endif
33!
34 CONTAINS
35!
36!***********************************************************************
37 SUBROUTINE get_gst (ng, model)
38!***********************************************************************
39!
40! Imported variable declarations.
41!
42 integer, intent(in) :: ng, model
43!
44! Local variable declarations.
45!
46 character (len=*), parameter :: myfile = &
47 & __FILE__
48!
49!-----------------------------------------------------------------------
50! Read in GST checkpointing restart file according to IO type.
51!-----------------------------------------------------------------------
52!
53 SELECT CASE (gst(ng)%IOtype)
54 CASE (io_nf90)
55 CALL get_gst_nf90 (ng, model)
56
57# if defined PIO_LIB && defined DISTRIBUTE
58 CASE (io_pio)
59 CALL get_gst_pio (ng, model)
60# endif
61 CASE DEFAULT
62 IF (master) WRITE (stdout,10) gst(ng)%IOtype
63 exit_flag=3
64 END SELECT
65 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
66!
67 10 FORMAT (' GET_GST - Illegal input file type, io_type = ',i0, &
68 & /,11x,'Check KeyWord ''INP_LIB'' in ''roms.in''.')
69!
70 RETURN
71 END SUBROUTINE get_gst
72!
73!***********************************************************************
74 SUBROUTINE get_gst_nf90 (ng, model)
75!***********************************************************************
76!
77 USE mod_netcdf
78
79# ifdef DISTRIBUTE
80!
81 USE distribute_mod, ONLY : mp_bcasti
83# endif
84!
85! Imported variable declarations.
86!
87 integer, intent(in) :: ng, model
88!
89! Local variable declarations.
90!
91 integer :: i, ivar, status
92
93# ifdef DISTRIBUTE
94 integer :: vrecord = -1
95
96 real(r8) :: scale = 1.0_r8
97# endif
98 real(r8) :: rval
99!
100 character (len=1 ) :: char1
101 character (len=2 ) :: char2
102 character (len=256) :: ncname
103
104 character (len=*), parameter :: myfile = &
105 & __FILE__//", get_gst_nf90"
106!
107 sourcefile=myfile
108!
109!-----------------------------------------------------------------------
110! Read GST checkpointing restart variables. Check for consistency.
111!-----------------------------------------------------------------------
112!
113! Open checkpointing NetCDF file for reading and writing.
114!
115 ncname=gst(ng)%name
116 IF (gst(ng)%ncid.eq.-1) THEN
117 CALL netcdf_open (ng, model, ncname, 1, gst(ng)%ncid)
118 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
119 WRITE (stdout,10) trim(ncname)
120 RETURN
121 END IF
122 END IF
123!
124! Read in number of eigenvalues to compute.
125!
126 CALL netcdf_get_ivar (ng, model, ncname, 'NEV', ivar, &
127 & ncid = gst(ng)%ncid)
128 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
129 IF (ivar.ne.nev) THEN
130 IF (master) WRITE (stdout,20) ', NEV = ', ivar, nev
131 exit_flag=6
132 RETURN
133 END IF
134!
135! Read in number of Lanczos vectors to compute.
136!
137 CALL netcdf_get_ivar (ng, model, ncname, 'NCV', ivar, &
138 & ncid = gst(ng)%ncid)
139 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
140 IF (ivar.ne.ncv) THEN
141 IF (master) WRITE (stdout,20) ', NCV = ', ivar, ncv
142 exit_flag=6
143 RETURN
144 END IF
145!
146! Read in size of the eigenvalue problem.
147!
148 CALL netcdf_get_ivar (ng, model, ncname, 'Mstate', ivar, &
149 & ncid = gst(ng)%ncid)
150 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
151 IF (ivar.ne.mstate(ng)) THEN
152 IF (master) WRITE (stdout,20) ', Mstate = ', ivar, mstate(ng)
153 exit_flag=6
154 RETURN
155 END IF
156
157# ifdef DISTRIBUTE
158!
159! Read in number of Lanczos vectors to compute.
160!
161 CALL netcdf_get_ivar (ng, model, ncname, 'Nnodes', ivar, &
162 & ncid = gst(ng)%ncid)
163 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
164 IF (ivar.ne.numthreads) THEN
165 IF (master) WRITE (stdout,20) ', Nnodes = ', ivar, numthreads
166 exit_flag=6
167 RETURN
168 END IF
169# endif
170!
171! Read in iteration number.
172!
173 CALL netcdf_get_ivar (ng, model, ncname, 'iter', nrun, &
174 & ncid = gst(ng)%ncid)
175 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
176!
177! Read in reverse communications flag.
178!
179 CALL netcdf_get_ivar (ng, model, ncname, 'ido', ido, &
180 & ncid = gst(ng)%ncid)
181 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
182!
183! Read in information and error flag.
184!
185 CALL netcdf_get_ivar (ng, model, ncname, 'info', ido, &
186 & ncid = gst(ng)%ncid)
187 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
188!
189! Read in eigenvalue problem type.
190!
191 CALL netcdf_get_svar (ng, model, ncname, 'bmat', char1, &
192 & ncid = gst(ng)%ncid, &
193 & start = (/1/), &
194 & total = (/1/))
195 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
196 IF (char1.ne.bmat) THEN
197 IF (master) WRITE (stdout,30) ', bmat = ', char1, bmat
198 exit_flag=6
199 RETURN
200 END IF
201!
202! Read in Ritz eigenvalues to compute.
203!
204 CALL netcdf_get_svar (ng, model, ncname, 'which', char2, &
205 & ncid = gst(ng)%ncid, &
206 & start = (/1/), &
207 & total = (/2/))
208 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
209 IF (char2(1:2).ne.which(1:2)) THEN
210 IF (master) WRITE (stdout,30) ', which = ', char2, which
211 exit_flag=6
212 RETURN
213 END IF
214!
215! Read in form of basis function.
216!
217 CALL netcdf_get_svar (ng, model, ncname, 'howmany', char1, &
218 & ncid = gst(ng)%ncid, &
219 & start = (/1/), &
220 & total = (/1/))
221 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
222 IF (char1.ne.howmany) THEN
223 IF (master) WRITE (stdout,30) ', howmany = ', char1, howmany
224 exit_flag=6
225 RETURN
226 END IF
227!
228! Read in relative accuracy of computed Ritz values.
229!
230 CALL netcdf_get_fvar (ng, model, ncname, 'Ritz_tol', rval, &
231 & ncid = gst(ng)%ncid)
232 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
233 IF (rval.ne.ritz_tol) THEN
234 IF (master) WRITE (stdout,40) ', Ritz_tol = ', rval, ritz_tol
235 END IF
236 ritz_tol=rval
237!
238! Read in eigenproblem parameters.
239!
240 CALL netcdf_get_ivar (ng, model, ncname, 'iparam', iparam, &
241 & ncid = gst(ng)%ncid, &
242 & start = (/1/), &
243 & total = (/SIZE(iparam)/))
244 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
245!
246! Read in pointers to mark starting location in work arrays.
247!
248 CALL netcdf_get_ivar (ng, model, ncname, 'ipntr', ipntr, &
249 & ncid = gst(ng)%ncid, &
250 & start = (/1/), &
251 & total = (/SIZE(ipntr)/))
252 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
253!
254! Read in ARPACK internal integer parameters to _aupd routines.
255!
256 CALL netcdf_get_ivar (ng, model, ncname, 'iaupd', iaupd, &
257 & ncid = gst(ng)%ncid, &
258 & start = (/1/), &
259 & total = (/SIZE(iaupd)/))
260 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
261!
262! Read in ARPACK internal integer parameters to _aitr routines.
263!
264 CALL netcdf_get_ivar (ng, model, ncname, 'iaitr', iaitr, &
265 & ncid = gst(ng)%ncid, &
266 & start = (/1/), &
267 & total = (/SIZE(iaitr)/))
268 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
269!
270! Read in ARPACK internal integer parameters to _aup2 routines.
271!
272 CALL netcdf_get_ivar (ng, model, ncname, 'iaup2', iaup2, &
273 & ncid = gst(ng)%ncid, &
274 & start = (/1/), &
275 & total = (/SIZE(iaup2)/))
276 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
277!
278! Read in ARPACK internal logical parameters to _aup2 routines.
279!
280 CALL netcdf_get_lvar (ng, model, ncname, 'laitr', laitr, &
281 & ncid = gst(ng)%ncid, &
282 & start = (/1/), &
283 & total = (/SIZE(laitr)/))
284 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
285!
286! Read in ARPACK internal logical parameters to _aup2 routines.
287!
288 CALL netcdf_get_lvar (ng, model, ncname, 'laup2', laup2, &
289 & ncid = gst(ng)%ncid, &
290 & start = (/1/), &
291 & total = (/SIZE(laup2)/))
292 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
293!
294! Read in ARPACK internal real parameters to _aup2 routines.
295!
296 CALL netcdf_get_fvar (ng, model, ncname, 'raitr', raitr, &
297 & ncid = gst(ng)%ncid, &
298 & start = (/1/), &
299 & total = (/SIZE(raitr)/))
300 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
301!
302! Read in ARPACK internal real parameters to _aup2 routines.
303!
304 CALL netcdf_get_fvar (ng, model, ncname, 'raup2', raup2, &
305 & ncid = gst(ng)%ncid, &
306 & start = (/1/), &
307 & total = (/SIZE(raup2)/))
308 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
309!
310!-----------------------------------------------------------------------
311! Read in checkpointing variables associated with the state vector.
312!-----------------------------------------------------------------------
313!
314! Read in Lanczos/Arnoldi basis vectors.
315!
316# ifdef DISTRIBUTE
317 status=mp_ncread2d(ng, model, gst(ng)%ncid, 'Bvec', &
318 & trim(ncname), vrecord, &
319 & nstr(ng), nend(ng), 1, ncv, scale, &
320 & storage(ng)%Bvec(nstr(ng):,:))
321# else
322 CALL netcdf_get_fvar (ng, model, ncname, 'Bvec', &
323 & storage(ng)%Bvec, &
324 & ncid = gst(ng)%ncid, &
325 & start = (/1,1/), &
326 & total = (/nend(ng)-nstr(ng)+1,ncv/))
327# endif
328 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
329!
330! Read in eigenproblem residual vector.
331!
332# ifdef DISTRIBUTE
333 status=mp_ncread1d(ng, model, gst(ng)%ncid, 'resid', &
334 & trim(ncname), vrecord, &
335 & nstr(ng), nend(ng), scale, &
336 & storage(ng)%resid(nstr(ng):))
337# else
338 CALL netcdf_get_fvar (ng, model, ncname, 'resid', &
339 & storage(ng)%resid, &
340 & ncid = gst(ng)%ncid, &
341 & start = (/1/), &
342 & total = (/nend(ng)-nstr(ng)+1/))
343# endif
344 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
345!
346! Read in state reverse communication work array.
347!
348# ifdef DISTRIBUTE
349 status=mp_ncread1d(ng, model, gst(ng)%ncid, 'SworkD', &
350 & trim(ncname), vrecord, &
351 & 1, 3*nstate(ng), scale, &
352 & storage(ng)%SworkD)
353# else
354 CALL netcdf_get_fvar (ng, model, ncname, 'SworkD', &
355 & storage(ng)%SworkD, &
356 & ncid = gst(ng)%ncid, &
357 & start = (/1/), &
358 & total = (/3*nstate(ng)/))
359# endif
360 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
361!
362! Read in eigenproblem work array.
363!
364 CALL netcdf_get_fvar (ng, model, ncname, 'SworkL', &
365 & sworkl(:,ng), &
366 & ncid = gst(ng)%ncid, &
367 & start = (/1/), &
368 & total = (/lworkl/))
369 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
370!
371 10 FORMAT (/,' GET_GST_NF90 - unable to open checkpointing NetCDF', &
372 & ' file:', a)
373 20 FORMAT (/,' GET_GST_NF90 - inconsistent input parameter', a, 2i4)
374 30 FORMAT (/,' GET_GST_NF90 - inconsistent input parameter', a, a, a)
375 40 FORMAT (/,' GET_GST_NF90 - input parameter', a, 1pe10.2,0p, &
376 & /, 16x,'has been reset to: ', 1pe10.2)
377!
378 RETURN
379 END SUBROUTINE get_gst_nf90
380
381# if defined PIO_LIB && defined DISTRIBUTE
382!
383!***********************************************************************
384 SUBROUTINE get_gst_pio (ng, model)
385!***********************************************************************
386!
388!
389! Imported variable declarations.
390!
391 integer, intent(in) :: ng, model
392!
393! Local variable declarations.
394!
395 integer :: is, ie
396 integer :: i, ivar, status
397
398# ifdef DISTRIBUTE
399 integer :: vrecord = -1
400
401 real(r8) :: scale = 1.0_r8
402# endif
403 real(r8) :: rval
404!
405 character (len=1 ) :: char1
406 character (len=2 ) :: char2
407 character (len=256) :: ncname
408
409 character (len=*), parameter :: myfile = &
410 & __FILE__//", get_gst_pio"
411!
412 TYPE (var_desc_t) :: piovar
413!
414 sourcefile=myfile
415!
416!-----------------------------------------------------------------------
417! Read GST checkpointing restart variables. Check for consistency.
418!-----------------------------------------------------------------------
419!
420! Open checkpointing NetCDF file for reading and writing.
421!
422 ncname=gst(ng)%name
423 IF (gst(ng)%pioFile%fh.eq.-1) THEN
424 CALL pio_netcdf_open (ng, model, ncname, 1, gst(ng)%pioFile)
425 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
426 WRITE (stdout,10) trim(ncname)
427 RETURN
428 END IF
429 END IF
430!
431! Read in number of eigenvalues to compute.
432!
433 CALL pio_netcdf_get_ivar (ng, model, ncname, 'NEV', ivar, &
434 & piofile = gst(ng)%pioFile)
435 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
436 IF (ivar.ne.nev) THEN
437 IF (master) WRITE (stdout,20) ', NEV = ', ivar, nev
438 exit_flag=6
439 RETURN
440 END IF
441!
442! Read in number of Lanczos vectors to compute.
443!
444 CALL pio_netcdf_get_ivar (ng, model, ncname, 'NCV', ivar, &
445 & piofile = gst(ng)%pioFile)
446 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
447 IF (ivar.ne.ncv) THEN
448 IF (master) WRITE (stdout,20) ', NCV = ', ivar, ncv
449 exit_flag=6
450 RETURN
451 END IF
452!
453! Read in size of the eigenvalue problem.
454!
455 CALL pio_netcdf_get_ivar (ng, model, ncname, 'Mstate', ivar, &
456 & piofile = gst(ng)%pioFile)
457 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
458 IF (ivar.ne.mstate(ng)) THEN
459 IF (master) WRITE (stdout,20) ', Mstate = ', ivar, mstate(ng)
460 exit_flag=6
461 RETURN
462 END IF
463!
464! Read in number of Lanczos vectors to compute.
465!
466 CALL pio_netcdf_get_ivar (ng, model, ncname, 'Nnodes', ivar, &
467 & piofile = gst(ng)%pioFile)
468 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
469 IF (ivar.ne.numthreads) THEN
470 IF (master) WRITE (stdout,20) ', Nnodes = ', ivar, numthreads
471 exit_flag=6
472 RETURN
473 END IF
474!
475! Read in iteration number.
476!
477 CALL pio_netcdf_get_ivar (ng, model, ncname, 'iter', nrun, &
478 & piofile = gst(ng)%pioFile)
479 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
480!
481! Read in reverse communications flag.
482!
483 CALL pio_netcdf_get_ivar (ng, model, ncname, 'ido', ido, &
484 & piofile = gst(ng)%pioFile)
485 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
486!
487! Read in information and error flag.
488!
489 CALL pio_netcdf_get_ivar (ng, model, ncname, 'info', ido, &
490 & piofile = gst(ng)%pioFile)
491 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
492!
493! Read in eigenvalue problem type.
494!
495 CALL pio_netcdf_get_svar (ng, model, ncname, 'bmat', char1, &
496 & piofile = gst(ng)%pioFile)
497 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
498 IF (char1.ne.bmat) THEN
499 IF (master) WRITE (stdout,30) ', bmat = ', char1, bmat
500 exit_flag=6
501 RETURN
502 END IF
503!
504! Read in Ritz eigenvalues to compute.
505!
506 CALL pio_netcdf_get_svar (ng, model, ncname, 'which', char2, &
507 & piofile = gst(ng)%pioFile, &
508 & start = (/1/), &
509 & total = (/2/))
510 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
511 IF (char2(1:2).ne.which(1:2)) THEN
512 IF (master) WRITE (stdout,30) ', which = ', char2, which
513 exit_flag=6
514 RETURN
515 END IF
516!
517! Read in form of basis function.
518!
519 CALL pio_netcdf_get_svar (ng, model, ncname, 'howmany', char1, &
520 & piofile = gst(ng)%pioFile, &
521 & start = (/1/), &
522 & total = (/1/))
523 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
524 IF (char1.ne.howmany) THEN
525 IF (master) WRITE (stdout,30) ', howmany = ', char1, howmany
526 exit_flag=6
527 RETURN
528 END IF
529!
530! Read in relative accuracy of computed Ritz values.
531!
532 CALL pio_netcdf_get_fvar (ng, model, ncname, 'Ritz_tol', rval, &
533 & piofile = gst(ng)%pioFile)
534 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
535 IF (rval.ne.ritz_tol) THEN
536 IF (master) WRITE (stdout,40) ', Ritz_tol = ', rval, ritz_tol
537 END IF
538 ritz_tol=rval
539!
540! Read in eigenproblem parameters.
541!
542 CALL pio_netcdf_get_ivar (ng, model, ncname, 'iparam', iparam, &
543 & piofile = gst(ng)%pioFile, &
544 & start = (/1/), &
545 & total = (/SIZE(iparam)/))
546 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
547!
548! Read in pointers to mark starting location in work arrays.
549!
550 CALL pio_netcdf_get_ivar (ng, model, ncname, 'ipntr', ipntr, &
551 & piofile = gst(ng)%pioFile, &
552 & start = (/1/), &
553 & total = (/SIZE(ipntr)/))
554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
555!
556! Read in ARPACK internal integer parameters to _aupd routines.
557!
558 CALL pio_netcdf_get_ivar (ng, model, ncname, 'iaupd', iaupd, &
559 & piofile = gst(ng)%pioFile, &
560 & start = (/1/), &
561 & total = (/SIZE(iaupd)/))
562 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
563!
564! Read in ARPACK internal integer parameters to _aitr routines.
565!
566 CALL pio_netcdf_get_ivar (ng, model, ncname, 'iaitr', iaitr, &
567 & piofile = gst(ng)%pioFile, &
568 & start = (/1/), &
569 & total = (/SIZE(iaitr)/))
570 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
571!
572! Read in ARPACK internal integer parameters to _aup2 routines.
573!
574 CALL pio_netcdf_get_ivar (ng, model, ncname, 'iaup2', iaup2, &
575 & piofile = gst(ng)%pioFile, &
576 & start = (/1/), &
577 & total = (/SIZE(iaup2)/))
578 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
579!
580! Read in ARPACK internal logical parameters to _aup2 routines.
581!
582 CALL pio_netcdf_get_lvar (ng, model, ncname, 'laitr', laitr, &
583 & piofile = gst(ng)%pioFile, &
584 & start = (/1/), &
585 & total = (/SIZE(laitr)/))
586 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
587!
588! Read in ARPACK internal logical parameters to _aup2 routines.
589!
590 CALL pio_netcdf_get_lvar (ng, model, ncname, 'laup2', laup2, &
591 & piofile = gst(ng)%pioFile, &
592 & start = (/1/), &
593 & total = (/SIZE(laup2)/))
594 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
595!
596! Read in ARPACK internal real parameters to _aup2 routines.
597!
598 CALL pio_netcdf_get_fvar (ng, model, ncname, 'raitr', raitr, &
599 & piofile = gst(ng)%pioFile, &
600 & start = (/1/), &
601 & total = (/SIZE(raitr)/))
602 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
603!
604! Read in ARPACK internal real parameters to _aup2 routines.
605!
606 CALL pio_netcdf_get_fvar (ng, model, ncname, 'raup2', raup2, &
607 & piofile = gst(ng)%pioFile, &
608 & start = (/1/), &
609 & total = (/SIZE(raup2)/))
610 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
611!
612!-----------------------------------------------------------------------
613! Read in checkpointing variables associated with the state vector.
614!-----------------------------------------------------------------------
615!
616! Read in Lanczos/Arnoldi basis vectors.
617!
618 status=pio_inq_varid(gst(ng)%pioFile, 'Bvec', piovar)
619 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
620!
621 IF (kind(storage(ng)%Bvec).eq.8) THEN
622 CALL pio_read_darray (gst(ng)%pioFile, piovar, &
623 & iodesc_dp_bvec(ng), &
624 & storage(ng)%Bvec(nstr(ng):,:), status)
625 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
626 ELSE
627 CALL pio_read_darray (gst(ng)%pioFile, piovar, &
628 & iodesc_sp_bvec(ng), &
629 & storage(ng)%Bvec(nstr(ng):,:), status)
630 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
631 END IF
632!
633! Read in eigenproblem residual vector.
634!
635 status=pio_inq_varid(gst(ng)%pioFile, 'resid', piovar)
636 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
637!
638 IF (kind(storage(ng)%Bvec).eq.8) THEN
639 CALL pio_read_darray (gst(ng)%pioFile, piovar, &
640 & iodesc_dp_resid(ng), &
641 & storage(ng)%resid(nstr(ng):), status)
642 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
643 ELSE
644 CALL pio_read_darray (gst(ng)%pioFile, piovar, &
645 & iodesc_dp_resid(ng), &
646 & storage(ng)%resid(nstr(ng):), status)
647 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
648 END IF
649!
650! Read in state reverse communication work array.
651!
652 is=myrank*3*nstate(ng)+1
653 ie=min(is+3*nstate(ng)-1, 3*mstate(ng))
654!
655 status=pio_inq_varid(gst(ng)%pioFile, 'SworkD', piovar)
656 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
657!
658 IF (kind(storage(ng)%SworkD).eq.8) THEN
659 CALL pio_read_darray (gst(ng)%pioFile, piovar, &
660 & iodesc_dp_sworkd(ng), &
661 & storage(ng)%SworkD(nstr(ng):), status)
662 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
663 ELSE
664 CALL pio_read_darray (gst(ng)%pioFile, piovar, &
665 & iodesc_sp_sworkd(ng), &
666 & storage(ng)%SworkD(nstr(ng):), status)
667 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
668 END IF
669!
670! Read in eigenproblem work array.
671!
672 CALL pio_netcdf_get_fvar (ng, model, ncname, 'SworkL', &
673 & sworkl(:,ng), &
674 & piofile = gst(ng)%pioFile, &
675 & start = (/1/), &
676 & total = (/lworkl/))
677 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
678!
679 10 FORMAT (/,' GET_GST_PIO - unable to open checkpointing NetCDF', &
680 & ' file:', a)
681 20 FORMAT (/,' GET_GST_PIO - inconsistent input parameter', a, 2i4)
682 30 FORMAT (/,' GET_GST_PIO - inconsistent input parameter', a, a, a)
683 40 FORMAT (/,' GET_GST_PIO - input parameter', a, 1pe10.2,0p, &
684 & /, 16x,'has been reset to: ', 1pe10.2)
685!
686 RETURN
687 END SUBROUTINE get_gst_pio
688# endif
689#endif
690 END MODULE get_gst_mod
691
692
integer function mp_ncread1d(ng, model, ncid, ncvname, ncname, ncrec, lb1, ub1, ascale, a)
integer function mp_ncread2d(ng, model, ncid, ncvname, ncname, ncrec, lb1, ub1, lb2, ub2, ascale, a)
subroutine, private get_gst_nf90(ng, model)
Definition get_gst.F:75
subroutine, private get_gst_pio(ng, model)
Definition get_gst.F:385
subroutine, public get_gst(ng, model)
Definition get_gst.F:38
type(t_io), dimension(:), allocatable gst
integer stdout
character(len=256) sourcefile
integer, parameter io_nf90
Definition mod_ncparam.F:95
integer, parameter io_pio
Definition mod_ncparam.F:96
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
integer numthreads
logical master
integer, dimension(:), allocatable nstate
Definition mod_param.F:645
integer, dimension(:), allocatable mstate
Definition mod_param.F:644
integer, dimension(:), allocatable nstr
Definition mod_param.F:646
integer, dimension(:), allocatable nend
Definition mod_param.F:647
type(io_desc_t), dimension(:), pointer iodesc_dp_resid
type(io_desc_t), dimension(:), pointer iodesc_sp_bvec
type(io_desc_t), dimension(:), pointer iodesc_dp_bvec
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
type(io_desc_t), dimension(:), pointer iodesc_sp_sworkd
type(io_desc_t), dimension(:), pointer iodesc_dp_sworkd
integer exit_flag
real(dp) ritz_tol
integer nrun
integer noerror
real(r8), dimension(2) raup2
integer, dimension(8) iaup2
integer, dimension(:), allocatable ido
integer, dimension(20) iaupd
real(r8), dimension(:,:), allocatable sworkl
integer, dimension(:,:), allocatable ipntr
integer ncv
real(r8), dimension(8) raitr
character(len=1) howmany
logical, dimension(5) laup2
character(len=1) bmat
integer nev
type(t_storage), dimension(:), allocatable storage
Definition mod_storage.F:91
character(len=2) which
integer lworkl
integer, dimension(:,:), allocatable iparam
integer, dimension(8) iaitr
logical, dimension(5) laitr
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52