84 & LBij, UBij, LBk, UBk, Nrec, &
86 & Abry, checksum)
RESULT(status)
93 integer,
intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
94 integer,
intent(in) :: lbij, ubij, lbk, ubk, nrec
96 integer(i8b),
intent(out),
optional :: checksum
98 real(dp),
intent(in) :: ascl
99 real(r8),
intent(out) :: amin
100 real(r8),
intent(out) :: amax
102 character (len=*),
intent(in) :: ncname
103 character (len=*),
intent(in) :: ncvname
106 real(r8),
intent(out) :: abry(lbij:,:,:,:)
108 real(r8),
intent(out) :: abry(lbij:ubij,lbk:ubk,4,nrec)
114 logical,
dimension(3) :: foundit
115 logical,
dimension(4) :: bounded
117 integer :: ghost, i, ib, ij, ir, j, k, tile
118 integer :: iorj, ijklen, imin, imax, jmin, jmax, klen, npts
119 integer :: cgrid, istr, iend, jstr, jend
120 integer,
dimension(5) :: start, total
124 real(r8) :: afactor, aoffset, aspval
126 real(r8),
allocatable :: cwrk(:)
128 real(r8),
dimension(3) :: attvalue
130#if !defined PARALLEL_IO && defined DISTRIBUTE
131 real(r8),
dimension(3) :: rbuffer
133 real(r8),
dimension(LBij:UBij,LBk:UBk,4,Nrec) :: wrk
135 character (len=12),
dimension(3) :: attname
137 character (len=*),
parameter :: myfile = &
138 & __FILE__//
", nf90_fread3d_bry"
155 IF (model.eq.
iadm)
THEN
176 imin=
bounds(ng)%Imin(cgrid,ghost,tile)
177 imax=
bounds(ng)%Imax(cgrid,ghost,tile)
178 jmin=
bounds(ng)%Jmin(cgrid,ghost,tile)
179 jmax=
bounds(ng)%Jmax(cgrid,ghost,tile)
194 istr=
bounds(ng)%Istr(tile)
195 iend=
bounds(ng)%Iend(tile)
196 jstr=
bounds(ng)%Jstr(tile)
197 jend=
bounds(ng)%Jend(tile)
232 attname(1)=
'scale_factor'
233 attname(2)=
'add_offset '
234 attname(3)=
'_FillValue '
237 & attvalue, foundit, &
244 IF (.not.foundit(1))
THEN
250 IF (.not.foundit(2))
THEN
256 IF (.not.foundit(3))
THEN
264 IF (
PRESENT(checksum))
THEN
278 status=nf90_get_var(ncid, ncvarid, wrk(lbij:,lbk:,:,:), &
280 IF (status.eq.nf90_noerr)
THEN
287 IF (abs(wrk(ij,k,ib,ir)).ge.abs(aspval))
THEN
288 wrk(ij,k,ib,ir)=0.0_r8
290 wrk(ij,k,ib,ir)=ascl* &
291 & (afactor*wrk(ij,k,ib,ir)+aoffset)
292 amin=min(amin,wrk(ij,k,ib,ir))
293 amax=max(amax,wrk(ij,k,ib,ir))
299 IF ((abs(amin).ge.abs(aspval)).and. &
300 & (abs(amax).ge.abs(aspval)))
THEN
306 npts=(ubij-lbij+1)*(ubk-lbk+1)*nrec*4
307 IF (.not.
allocated(cwrk))
allocate ( cwrk(npts) )
308 cwrk=pack(wrk(lbij:ubij, lbk:ubk, 1:4, 1:nrec), .true.)
309 CALL get_hash (cwrk, npts, checksum)
310 IF (
allocated(cwrk))
deallocate (cwrk)
315#if !defined PARALLEL_IO && defined DISTRIBUTE
317 rbuffer(1)=real(status,r8)
321 status=int(rbuffer(1))
326 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
332#if !defined PARALLEL_IO && defined DISTRIBUTE
347 IF (bounded(ib))
THEN
351 abry(j,k,ib,ir)=wrk(j,k,ib,ir)
357 abry(i,k,ib,ir)=wrk(i,k,ib,ir)
374 & LBij, UBij, LBk, UBk, Nrec, &
375 & Ascl, Amin, Amax, &
376 & Abry, checksum)
RESULT(status)
383 integer,
intent(in) :: ng, model, tindex
384 integer,
intent(in) :: lbij, ubij, lbk, ubk, nrec
386 integer(i8b),
intent(out),
optional :: checksum
388 real(dp),
intent(in) :: ascl
389 real(r8),
intent(out) :: amin
390 real(r8),
intent(out) :: amax
392 character (len=*),
intent(in) :: ncname
393 character (len=*),
intent(in) :: ncvname
396 real(r8),
intent(out) :: abry(lbij:,:,:,:)
398 real(r8),
intent(out) :: abry(lbij:ubij,lbk:ubk,4,nrec)
401 TYPE (file_desc_t),
intent(inout) :: piofile
402 TYPE (io_desc_t),
intent(inout) :: piodesc
408 logical,
dimension(3) :: foundit
409 logical,
dimension(4) :: bounded
411 integer :: i, ib, ij, ir, j, k
412 integer :: cgrid, dkind, ghost, gtype, tile
413 integer :: iorj, ijklen, imin, imax, jmin, jmax, klen, npts
414 integer :: istr, iend, jstr, jend
415 integer,
dimension(5) :: start, total
419 real(r8) :: afactor, aoffset, aspval
421 real(r8),
allocatable :: cwrk(:)
423 real(r8),
dimension(3) :: attvalue
425 real(r8),
allocatable :: wrk(:,:,:,:)
427 character (len=12),
dimension(3) :: attname
429 character (len=*),
parameter :: myfile = &
430 & __FILE__//
", pio_fread3d_bry"
447 IF (model.eq.
iadm)
THEN
469 imin=
bounds(ng)%Imin(cgrid,ghost,tile)
470 imax=
bounds(ng)%Imax(cgrid,ghost,tile)
471 jmin=
bounds(ng)%Jmin(cgrid,ghost,tile)
472 jmax=
bounds(ng)%Jmax(cgrid,ghost,tile)
481 istr=
bounds(ng)%Istr(tile)
482 iend=
bounds(ng)%Iend(tile)
483 jstr=
bounds(ng)%Jstr(tile)
484 jend=
bounds(ng)%Jend(tile)
519 attname(1)=
'scale_factor'
520 attname(2)=
'add_offset '
521 attname(3)=
'_FillValue '
524 & attvalue, foundit, &
531 IF (.not.foundit(1))
THEN
537 IF (.not.foundit(2))
THEN
543 IF (.not.foundit(3))
THEN
551 IF (
PRESENT(checksum))
THEN
562 IF (.not.
allocated(wrk))
THEN
563 allocate ( wrk(0:iorj-1,lbk:ubk,4,nrec) )
567 status=pio_get_var(piofile, piovar%vd, start, total, &
569 IF (status.eq.pio_noerr)
THEN
576 IF (abs(wrk(ij,k,ib,ir)).ge.abs(aspval))
THEN
577 wrk(ij,k,ib,ir)=0.0_r8
579 wrk(ij,k,ib,ir)=ascl*(afactor*wrk(ij,k,ib,ir)+aoffset)
580 amin=min(amin,wrk(ij,k,ib,ir))
581 amax=max(amax,wrk(ij,k,ib,ir))
587 IF ((abs(amin).ge.abs(aspval)).and. &
588 & (abs(amax).ge.abs(aspval)))
THEN
594 npts=(ubij-lbij+1)*(ubk-lbk+1)*nrec*4
595 IF (.not.
allocated(cwrk))
allocate ( cwrk(npts) )
596 cwrk=pack(wrk(lbij:ubij, lbk:ubk, 1:4, 1:nrec), .true.)
597 CALL get_hash (cwrk, npts, checksum)
598 IF (
allocated(cwrk))
deallocate (cwrk)
602 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
616 IF (bounded(ib))
THEN
620 abry(j,k,ib,ir)=wrk(j,k,ib,ir)
626 abry(i,k,ib,ir)=wrk(i,k,ib,ir)
636 IF (
allocated(wrk))
deallocate (wrk)
integer function nf90_fread3d_bry(ng, model, ncname, ncid, ncvname, ncvarid, tindex, gtype, lbij, ubij, lbk, ubk, nrec, ascl, amin, amax, abry, checksum)
integer function pio_fread3d_bry(ng, model, ncname, piofile, ncvname, piovar, tindex, piodesc, lbij, ubij, lbk, ubk, nrec, ascl, amin, amax, abry, checksum)