85 & Abry, checksum)
RESULT(status)
92 integer,
intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
93 integer,
intent(in) :: lbij, ubij, nrec
95 integer(i8b),
intent(out),
optional :: checksum
97 real(dp),
intent(in) :: ascl
98 real(r8),
intent(out) :: amin
99 real(r8),
intent(out) :: amax
101 character (len=*),
intent(in) :: ncname
102 character (len=*),
intent(in) :: ncvname
105 real(r8),
intent(out) :: abry(lbij:,:,:)
107 real(r8),
intent(out) :: abry(lbij:ubij,4,nrec)
113 logical,
dimension(3) :: foundit
114 logical,
dimension(4) :: bounded
116 integer :: bc, ghost, i, ib, ic, ij, ir, j, tile
117 integer :: cgrid, iorj, imin, imax, jmin, jmax, npts
118 integer :: istr, iend, jstr, jend
119 integer,
dimension(4) :: start, total
123 real(r8) :: afactor, aoffset, aspval
125 real(r8),
allocatable :: cwrk(:)
127 real(r8),
dimension(3) :: attvalue
129#if !defined PARALLEL_IO && defined DISTRIBUTE
130 real(r8),
dimension(3) :: rbuffer
132 real(r8),
dimension(LBij:UBij,4,Nrec) :: wrk
134 character (len=12),
dimension(3) :: attname
136 character (len=*),
parameter :: myfile = &
137 & __FILE__//
", pio_fread2d_bry"
154 IF (model.eq.
iadm)
THEN
175 imin=
bounds(ng)%Imin(cgrid,ghost,tile)
176 imax=
bounds(ng)%Imax(cgrid,ghost,tile)
177 jmin=
bounds(ng)%Jmin(cgrid,ghost,tile)
178 jmax=
bounds(ng)%Jmax(cgrid,ghost,tile)
192 istr=
bounds(ng)%Istr (tile)
193 iend=
bounds(ng)%Iend (tile)
194 jstr=
bounds(ng)%Jstr (tile)
195 jend=
bounds(ng)%Jend (tile)
228 attname(1)=
'scale_factor'
229 attname(2)=
'add_offset '
230 attname(3)=
'_FillValue '
233 & attvalue, foundit, &
240 IF (.not.foundit(1))
THEN
246 IF (.not.foundit(2))
THEN
252 IF (.not.foundit(3))
THEN
260 IF (
PRESENT(checksum))
THEN
274 status=nf90_get_var(ncid, ncvarid, wrk(lbij:,:,:), start, total)
275 IF (status.eq.nf90_noerr)
THEN
281 IF (abs(wrk(ij,ib,ir)).ge.abs(aspval))
THEN
284 wrk(ij,ib,ir)=ascl*(afactor*wrk(ij,ib,ir)+aoffset)
285 amin=min(amin,wrk(ij,ib,ir))
286 amax=max(amax,wrk(ij,ib,ir))
291 IF ((abs(amin).ge.abs(aspval)).and. &
292 & (abs(amax).ge.abs(aspval)))
THEN
298 npts=(ubij-lbij+1)*nrec*4
299 IF (.not.
allocated(cwrk))
allocate ( cwrk(npts) )
300 cwrk=pack(wrk(lbij:ubij, 1:4, 1:nrec), .true.)
301 CALL get_hash (cwrk, npts, checksum)
302 IF (
allocated(cwrk))
deallocate (cwrk)
307#if !defined PARALLEL_IO && defined DISTRIBUTE
309 rbuffer(1)=real(status,r8)
313 status=int(rbuffer(1))
318 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
324#if !defined PARALLEL_IO && defined DISTRIBUTE
339 IF (bounded(ib))
THEN
342 abry(j,ib,ir)=wrk(j,ib,ir)
346 abry(i,ib,ir)=wrk(i,ib,ir)
362 & LBij, UBij, Nrec, &
363 & Ascl, Amin, Amax, &
364 & Abry, checksum)
RESULT(status)
371 integer,
intent(in) :: ng, model, tindex
372 integer,
intent(in) :: lbij, ubij, nrec
374 integer(i8b),
intent(out),
optional :: checksum
376 real(dp),
intent(in) :: ascl
377 real(r8),
intent(out) :: amin
378 real(r8),
intent(out) :: amax
380 character (len=*),
intent(in) :: ncname
381 character (len=*),
intent(in) :: ncvname
384 real(r8),
intent(out) :: abry(lbij:,:,:)
386 real(r8),
intent(out) :: abry(lbij:ubij,4,nrec)
389 TYPE (file_desc_t),
intent(inout) :: piofile
390 TYPE (io_desc_t),
intent(inout) :: piodesc
396 logical,
dimension(3) :: foundit
397 logical,
dimension(4) :: bounded
399 integer :: i, ib, ic, ij, ir, j
400 integer :: cgrid, dkind, ghost, gtype, tile
401 integer :: iorj, imin, imax, jmin, jmax, npts
402 integer :: istr, iend, jstr, jend
403 integer,
dimension(4) :: start, total
407 real(r8) :: afactor, aoffset, aspval
409 real(r8),
allocatable :: cwrk(:)
411 real(r8),
dimension(3) :: attvalue
413 real(r8),
dimension(LBij:UBij,4,Nrec) :: wrk
415 character (len=12),
dimension(3) :: attname
417 character (len=*),
parameter :: myfile = &
418 & __FILE__//
", pio_fread2d_bry"
435 IF (model.eq.
iadm)
THEN
457 imin=
bounds(ng)%Imin(cgrid,ghost,tile)
458 imax=
bounds(ng)%Imax(cgrid,ghost,tile)
459 jmin=
bounds(ng)%Jmin(cgrid,ghost,tile)
460 jmax=
bounds(ng)%Jmax(cgrid,ghost,tile)
467 istr=
bounds(ng)%Istr(tile)
468 iend=
bounds(ng)%Iend(tile)
469 jstr=
bounds(ng)%Jstr(tile)
470 jend=
bounds(ng)%Jend(tile)
503 attname(1)=
'scale_factor'
504 attname(2)=
'add_offset '
505 attname(3)=
'_FillValue '
508 & attvalue, foundit, &
515 IF (.not.foundit(1))
THEN
521 IF (.not.foundit(2))
THEN
527 IF (.not.foundit(3))
THEN
535 IF (
PRESENT(checksum))
THEN
548 status=pio_get_var(piofile, piovar%vd, start, total, &
550 IF (status.eq.pio_noerr)
THEN
556 IF (abs(wrk(ij,ib,ir)).ge.abs(aspval))
THEN
559 wrk(ij,ib,ir)=ascl*(afactor*wrk(ij,ib,ir)+aoffset)
560 amin=min(amin,wrk(ij,ib,ir))
561 amax=max(amax,wrk(ij,ib,ir))
566 IF ((abs(amin).ge.abs(aspval)).and. &
567 & (abs(amax).ge.abs(aspval)))
THEN
573 npts=(ubij-lbij+1)*nrec*4
574 IF (.not.
allocated(cwrk))
allocate ( cwrk(npts) )
575 cwrk=pack(wrk(lbij:ubij, 1:4, 1:nrec), .true.)
576 CALL get_hash (cwrk, npts, checksum)
577 IF (
allocated(cwrk))
deallocate (cwrk)
581 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
595 IF (bounded(ib))
THEN
598 abry(j,ib,ir)=wrk(j,ib,ir)
602 abry(i,ib,ir)=wrk(i,ib,ir)
integer function nf90_fread2d_bry(ng, model, ncname, ncid, ncvname, ncvarid, tindex, gtype, lbij, ubij, nrec, ascl, amin, amax, abry, checksum)
integer function pio_fread2d_bry(ng, model, ncname, piofile, ncvname, piovar, tindex, piodesc, lbij, ubij, nrec, ascl, amin, amax, abry, checksum)