ROMS
Loading...
Searching...
No Matches
nf_fread3d_mod::nf_fread3d Interface Reference

Public Member Functions

integer function nf90_fread3d (ng, model, ncname, ncid, ncvname, ncvarid, tindex, gtype, vsize, lbi, ubi, lbj, ubj, lbk, ubk, ascl, amin, amax, amask, adat, checksum)
 
integer function pio_fread3d (ng, model, ncname, piofile, ncvname, piovar, tindex, piodesc, vsize, lbi, ubi, lbj, ubj, lbk, ubk, ascl, amin, amax, amask, adat, checksum)
 

Detailed Description

Definition at line 69 of file nf_fread3d.F.

Member Function/Subroutine Documentation

◆ nf90_fread3d()

integer function nf_fread3d_mod::nf_fread3d::nf90_fread3d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
integer, intent(in) ncid,
character (len=*), intent(in) ncvname,
integer, intent(in) ncvarid,
integer, intent(in) tindex,
integer, intent(in) gtype,
integer, dimension(4), intent(in) vsize,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) lbk,
integer, intent(in) ubk,
real(dp), intent(in) ascl,
real(r8), intent(out) amin,
real(r8), intent(out) amax,
real(r8), dimension(lbi:,lbj:), intent(in) amask,
real(r8), dimension(lbi:,lbj:,lbk:), intent(out) adat,
integer(i8b), intent(out), optional checksum )

Definition at line 81 of file nf_fread3d.F.

91!***********************************************************************
92!
93 USE mod_netcdf
94!
96# if defined MASKING && defined READ_WATER
97 USE distribute_mod, ONLY : mp_collect
98# endif
100!
101! Imported variable declarations.
102!
103 integer, intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
104 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
105 integer, intent(in) :: Vsize(4)
106!
107 integer(i8b), intent(out), optional :: checksum
108!
109 real(dp), intent(in) :: Ascl
110 real(r8), intent(out) :: Amin
111 real(r8), intent(out) :: Amax
112!
113 character (len=*), intent(in) :: ncname
114 character (len=*), intent(in) :: ncvname
115!
116# ifdef ASSUMED_SHAPE
117# ifdef MASKING
118 real(r8), intent(in) :: Amask(LBi:,LBj:)
119# endif
120 real(r8), intent(out) :: Adat(LBi:,LBj:,LBk:)
121# else
122# ifdef MASKING
123 real(r8), intent(in) :: Amask(LBi:UBi,LBj:UBj)
124# endif
125 real(r8), intent(out) :: Adat(LBi:UBi,LBj:UBj,LBk:UBk)
126# endif
127!
128! Local variable declarations.
129!
130 logical :: Lchecksum
131 logical, dimension(3) :: foundit
132!
133 integer :: i, ic, ij, j, jc, k, kc, np, MyNpts, Npts
134 integer :: Imin, Imax, Isize, Jmin, Jmax, Jsize, IJsize
135 integer :: Istr, Iend
136 integer :: Ioff, Joff, Koff
137 integer :: Ilen, Jlen, Klen, IJlen
138 integer :: Cgrid, MyType, ghost, status, wtype
139
140 integer, dimension(4) :: start, total
141!
142 real(r8) :: Afactor, Aoffset, Aspval
143
144 real(r8), parameter :: IniVal= 0.0_r8
145
146 real(r8), dimension(2) :: rbuffer
147 real(r8), dimension(3) :: AttValue
148
149# if defined MASKING && defined READ_WATER
150 real(r8), allocatable :: A2d(:)
151# endif
152 real(r8), allocatable :: wrk(:)
153!
154 character (len= 3), dimension(2) :: op_handle
155 character (len=12), dimension(3) :: AttName
156
157 character (len=*), parameter :: MyFile = &
158 & __FILE__//", nf90_fread3d"
159!
160!-----------------------------------------------------------------------
161! Set starting and ending indices to process.
162!-----------------------------------------------------------------------
163!
164 status=nf90_noerr
165!
166! Set first and last grid point according to staggered C-grid
167! classification. Set the offsets for variables with starting
168! zero-index. Recall the NetCDF does not support a zero-index.
169!
170! Notice that (Imin,Jmin) and (Imax,Jmax) are the corner of the
171! computational tile. If ghost=0, ghost points are not processed.
172! They will be processed elsewhere by the appropriate call to any
173! of the routines in "mp_exchange.F". If ghost=1, the ghost points
174! are read.
175!
176# ifdef NO_READ_GHOST
177 ghost=0 ! non-overlapping, no ghost points
178# else
179 IF (model.eq.iadm) THEN
180 ghost=0 ! non-overlapping, no ghost points
181 ELSE
182 ghost=1 ! overlapping, read ghost points
183 END IF
184# endif
185
186 mytype=gtype
187
188 SELECT CASE (abs(mytype))
189 CASE (p2dvar, p3dvar)
190 cgrid=1
191 isize=iobounds(ng)%xi_psi
192 jsize=iobounds(ng)%eta_psi
193 CASE (r2dvar, r3dvar, w3dvar)
194 cgrid=2
195 isize=iobounds(ng)%xi_rho
196 jsize=iobounds(ng)%eta_rho
197 CASE (u2dvar, u3dvar)
198 cgrid=3
199 isize=iobounds(ng)%xi_u
200 jsize=iobounds(ng)%eta_u
201 CASE (v2dvar, v3dvar)
202 cgrid=4
203 isize=iobounds(ng)%xi_v
204 jsize=iobounds(ng)%eta_v
205 CASE DEFAULT
206 cgrid=2
207 isize=iobounds(ng)%xi_rho
208 jsize=iobounds(ng)%eta_rho
209 END SELECT
210
211 imin=bounds(ng)%Imin(cgrid,ghost,myrank)
212 imax=bounds(ng)%Imax(cgrid,ghost,myrank)
213 jmin=bounds(ng)%Jmin(cgrid,ghost,myrank)
214 jmax=bounds(ng)%Jmax(cgrid,ghost,myrank)
215
216 ilen=imax-imin+1
217 jlen=jmax-jmin+1
218 klen=ubk-lbk+1
219!
220! Check if the following attributes: "scale_factor", "add_offset", and
221! "_FillValue" are present in the input NetCDF variable:
222!
223! If the "scale_value" attribute is present, the data is multiplied by
224! this factor after reading.
225! If the "add_offset" attribute is present, this value is added to the
226! data after reading.
227! If both "scale_factor" and "add_offset" attributes are present, the
228! data are first scaled before the offset is added.
229! If the "_FillValue" attribute is present, the data having this value
230! is treated as missing and it is replaced with zero. This feature it
231! is usually related with the land/sea masking.
232!
233 attname(1)='scale_factor'
234 attname(2)='add_offset '
235 attname(3)='_FillValue '
236
237 CALL netcdf_get_fatt (ng, model, ncname, ncvarid, attname, &
238 & attvalue, foundit, &
239 & ncid = ncid)
240 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
241 status=ioerror
242 RETURN
243 END IF
244
245 IF (.not.foundit(1)) THEN
246 afactor=1.0_r8
247 ELSE
248 afactor=attvalue(1)
249 END IF
250
251 IF (.not.foundit(2)) THEN
252 aoffset=0.0_r8
253 ELSE
254 aoffset=attvalue(2)
255 END IF
256
257 IF (.not.foundit(3)) THEN
258 aspval=spval_check
259 ELSE
260 aspval=attvalue(3)
261 END IF
262!
263! Initialize checsum value.
264!
265 IF (PRESENT(checksum)) THEN
266 lchecksum=.true.
267 checksum=0_i8b
268 ELSE
269 lchecksum=.false.
270 END IF
271!
272!-----------------------------------------------------------------------
273! Parallel I/O: Read in tile data from requested field and scale it.
274! Processing both water and land points.
275!-----------------------------------------------------------------------
276!
277 IF (gtype.gt.0) THEN
278!
279! Set offsets due the NetCDF dimensions. Recall that some output
280! variables not always start at one.
281!
282 SELECT CASE (abs(mytype))
283 CASE (p2dvar, p3dvar)
284 ioff=0
285 joff=0
286 CASE (r2dvar, r3dvar, w3dvar)
287 ioff=1
288 joff=1
289 CASE (u2dvar, u3dvar)
290 ioff=0
291 joff=1
292 CASE (v2dvar, v3dvar)
293 ioff=1
294 joff=0
295 CASE DEFAULT
296 ioff=1
297 joff=1
298 END SELECT
299
300 IF (lbk.eq.0) THEN
301 koff=1
302 ELSE
303 koff=0
304 END IF
305
306 npts=ilen*jlen*klen
307!
308! Allocate scratch work array.
309!
310 IF (.not.allocated(wrk)) THEN
311 allocate ( wrk(npts) )
312 wrk=0.0_r8
313 END IF
314!
315! Read in data: all parallel nodes read their own tile data.
316!
317 start(1)=imin+ioff
318 total(1)=ilen
319 start(2)=jmin+joff
320 total(2)=jlen
321 start(3)=lbk+koff
322 total(3)=klen
323 start(4)=tindex
324 total(4)=1
325
326 status=nf90_get_var(ncid, ncvarid, wrk, start, total)
327!
328! Scale read data and process fill values, if any. Compute minimum
329! and maximum values.
330!
331 IF (status.eq.nf90_noerr) THEN
332 amin=spval
333 amax=-spval
334 DO i=1,npts
335 IF (abs(wrk(i)).ge.abs(aspval)) THEN
336 wrk(i)=0.0_r8 ! masked with _FillValue
337 ELSE
338 wrk(i)=ascl*(afactor*wrk(i)+aoffset)
339 amin=min(amin,wrk(i))
340 amax=max(amax,wrk(i))
341 END IF
342 END DO
343 IF ((abs(amin).ge.abs(aspval)).and. &
344 & (abs(amax).ge.abs(aspval))) THEN
345 amin=0.0_r8 ! the entire data is all
346 amax=0.0_r8 ! field value, _FillValue
347 END IF
348!
349! Set minimum and maximum values: global reduction.
350!
351 rbuffer(1)=amin
352 op_handle(1)='MIN'
353 rbuffer(2)=amax
354 op_handle(2)='MAX'
355 CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
356 amin=rbuffer(1)
357 amax=rbuffer(2)
358!
359! Unpack read data.
360!
361 ic=0
362 DO k=lbk,ubk
363 DO j=jmin,jmax
364 DO i=imin,imax
365 ic=ic+1
366 adat(i,j,k)=wrk(ic)
367 END DO
368 END DO
369 END DO
370 ELSE
371 exit_flag=2
372 ioerror=status
373 END IF
374 END IF
375
376# if defined MASKING && defined READ_WATER
377!
378!-----------------------------------------------------------------------
379! Parallel I/O: Read in tile data from requested field and scale it.
380! Processing water points only.
381!-----------------------------------------------------------------------
382!
383 IF (gtype.lt.0) THEN
384!
385! Set number of points to process, grid type switch, and offsets due
386! array packing into 1D array in column-major order.
387!
388 SELECT CASE (abs(mytype))
389 CASE (p3dvar)
390 ijlen=iobounds(ng)%xy_psi
391 wtype=p2dvar
392 ioff=0
393 joff=1
394 CASE (r3dvar, w3dvar)
395 ijlen=iobounds(ng)%xy_rho
396 wtype=r2dvar
397 ioff=1
398 joff=0
399 CASE (u3dvar)
400 ijlen=iobounds(ng)%xy_u
401 wtype=u2dvar
402 ioff=0
403 joff=0
404 CASE (v3dvar)
405 ijlen=iobounds(ng)%xy_v
406 wtype=v2dvar
407 ioff=1
408 joff=1
409 CASE DEFAULT
410 ijlen=iobounds(ng)%xy_rho
411 wtype=r2dvar
412 ioff=1
413 joff=0
414 END SELECT
415
416 IF (lbk.eq.0) THEN
417 koff=0
418 ELSE
419 koff=1
420 END IF
421
422 npts=ijlen*klen
423 ijsize=isize*jsize
424!
425! Allocate scratch work arrays.
426!
427 IF (.not.allocated(a2d)) THEN
428 allocate ( a2d(ijsize) )
429 END IF
430 IF (.not.allocated(wrk)) THEN
431 allocate ( wrk(npts) )
432 wrk=inival
433 END IF
434!
435! Read in data: all parallel nodes read a segment of the 1D data.
436! Recall that water points are pack in the NetCDF file in a single
437! dimension.
438!
439 CALL tile_bounds_1d (ng, myrank, npts, istr, iend)
440
441 start(1)=istr
442 total(1)=iend-istr+1
443 start(2)=1
444 total(2)=tindex
445
446 status=nf90_get_var(ncid, ncvarid, wrk(istr:), start, total)
447!
448! Global reduction of work array. We need this because the packing
449! of the water point only affects the model tile partition.
450!
451 IF (status.eq.nf90_noerr) THEN
452 CALL mp_collect (ng, model, npts, inival, wrk)
453!
454! Scale read data and process fill values, if any. Compute minimum
455! and maximum values.
456!
457 amin=spval
458 amax=-spval
459 DO i=1,npts
460 IF (abs(wrk(i)).ge.abs(aspval)) THEN
461 wrk(i)=0.0_r8 ! set _FillValue to zero
462 ELSE
463 wrk(i)=ascl*(afactor*wrk(i)+aoffset)
464 amin=min(amin,wrk(i))
465 amax=max(amax,wrk(i))
466 END IF
467 END DO
468 IF ((abs(amin).ge.abs(aspval)).and. &
469 & (abs(amax).ge.abs(aspval))) THEN
470 amin=0.0_r8 ! the entire data is all
471 amax=0.0_r8 ! field value, _FillValue
472 END IF
473!
474! Unpack read data. This is tricky in parallel I/O. The cheapeast
475! thing to do is reconstruct a packed 2D global array and then select
476! the appropriate values for the tile.
477!
478 DO k=lbk,ubk
479 kc=(k-koff)*ijlen
480 a2d=inival
481 DO np=1,ijlen
482 ij=scalars(ng)%IJwater(np,wtype)
483 a2d(ij)=wrk(np+kc)
484 END DO
485 DO j=jmin,jmax
486 jc=(j-joff)*isize
487 DO i=imin,imax
488 ij=i+ioff+jc
489 adat(i,j,k)=a2d(ij)
490 END DO
491 END DO
492 END DO
493 ELSE
494 exit_flag=2
495 ioerror=status
496 END IF
497 END IF
498# endif
499!
500!-----------------------------------------------------------------------
501! Deallocate scratch work vector.
502!-----------------------------------------------------------------------
503!
504# if defined MASKING && defined READ_WATER
505 IF (allocated(a2d)) THEN
506 deallocate (a2d)
507 END IF
508# endif
509
510 IF (allocated(wrk)) THEN
511 deallocate (wrk)
512 END IF
513!
514 RETURN
subroutine, public tile_bounds_1d(ng, tile, imax, istr, iend)
Definition get_bounds.F:921

References mod_param::bounds, mod_scalars::exit_flag, strings_mod::founderror(), get_hash_mod::get_hash(), mod_param::iadm, mod_parallel::inpthread, mod_param::iobounds, mod_iounits::ioerror, mod_param::lm, mod_param::mm, distribute_mod::mp_scatter2d(), distribute_mod::mp_scatter3d(), mod_parallel::myrank, mod_param::nghostpoints, mod_scalars::noerror, mod_param::p2dvar, mod_param::p3dvar, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::scalars, mod_scalars::spval, mod_scalars::spval_check, get_bounds_mod::tile_bounds_1d(), mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, and mod_param::w3dvar.

Here is the call graph for this function:

◆ pio_fread3d()

integer function nf_fread3d_mod::nf_fread3d::pio_fread3d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
type (file_desc_t), intent(inout) piofile,
character (len=*), intent(in) ncvname,
type (my_vardesc), intent(inout) piovar,
integer, intent(in) tindex,
type (io_desc_t), intent(inout) piodesc,
integer, dimension(4), intent(in) vsize,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) lbk,
integer, intent(in) ubk,
real(dp), intent(in) ascl,
real(r8), intent(out) amin,
real(r8), intent(out) amax,
real(r8), dimension(lbi:,lbj:), intent(in) amask,
real(r8), dimension(lbi:,lbj:,lbk:), intent(out) adat,
integer(i8b), intent(out), optional checksum )

Definition at line 920 of file nf_fread3d.F.

930!***********************************************************************
931!
933!
934 USE distribute_mod, ONLY : mp_reduce
935!
936! Imported variable declarations.
937!
938 integer, intent(in) :: ng, model, tindex
939 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
940 integer, intent(in) :: Vsize(4)
941!
942 integer(i8b), intent(out), optional :: checksum
943!
944 real(dp), intent(in) :: Ascl
945 real(r8), intent(out) :: Amin
946 real(r8), intent(out) :: Amax
947!
948 character (len=*), intent(in) :: ncname
949 character (len=*), intent(in) :: ncvname
950!
951# ifdef ASSUMED_SHAPE
952# ifdef MASKING
953 real(r8), intent(in) :: Amask(LBi:,LBj:)
954# endif
955 real(r8), intent(out) :: Adat(LBi:,LBj:,LBk:)
956# else
957# ifdef MASKING
958 real(r8), intent(in) :: Amask(LBi:UBi,LBj:UBj)
959# endif
960 real(r8), intent(out) :: Adat(LBi:UBi,LBj:UBj,LBk:UBk)
961# endif
962!
963 TYPE (File_desc_t), intent(inout) :: pioFile
964 TYPE (IO_Desc_t), intent(inout) :: pioDesc
965 TYPE (My_VarDesc), intent(inout) :: pioVar
966!
967! Local variable declarations.
968!
969 logical :: Lchecksum
970 logical, dimension(3) :: foundit
971!
972 integer :: i, j, k, Npts, status
973 integer :: Is, Ie, Js, Je
974 integer :: Imin, Imax, Jmin, Jmax
975 integer :: Cgrid, ghost, dkind, gtype
976
977 integer, dimension(4) :: start, total
978!
979 real(r8) :: Afactor, Aoffset, Aspval, Avalue
980 real(r8) :: my_Amin, my_Amax
981
982 real(r8), dimension(3) :: AttValue
983 real(r8), dimension(2) :: rbuffer
984!
985 real(r4), pointer :: Awrk4(:,:,:) ! single precision
986 real(r8), pointer :: Awrk8(:,:,:) ! double precision
987 real(r8), allocatable :: Cwrk(:) ! used for checksum
988!
989 character (len=12), dimension(3) :: AttName
990 character (len= 3), dimension(2) :: op_handle
991
992 character (len=*), parameter :: MyFile = &
993 & __FILE__//", pio_fread3d"
994!
995!-----------------------------------------------------------------------
996! Set starting and ending indices to process.
997!-----------------------------------------------------------------------
998!
999 status=pio_noerr
1000 amin=spval
1001 amax=-spval
1002 my_amin=spval
1003 my_amax=-spval
1004!
1005! Set global (interior plus boundary) starting and ending grid cell
1006! indices in the I- and J-directions according to staggered C-grid
1007! classification.
1008!
1009 dkind=piovar%dkind
1010 gtype=piovar%gtype
1011!
1012 SELECT CASE (abs(gtype))
1013 CASE (p2dvar, p3dvar)
1014 cgrid=1 ! PSI-points
1015 is=iobounds(ng)%ILB_psi
1016 ie=iobounds(ng)%IUB_psi
1017 js=iobounds(ng)%JLB_psi
1018 je=iobounds(ng)%JUB_psi
1019 CASE (b3dvar, l3dvar, r2dvar, r3dvar, w3dvar)
1020 cgrid=2 ! RHO-points
1021 is=iobounds(ng)%ILB_rho
1022 ie=iobounds(ng)%IUB_rho
1023 js=iobounds(ng)%JLB_rho
1024 je=iobounds(ng)%JUB_rho
1025 CASE (u2dvar, u3dvar)
1026 cgrid=3 ! U-points
1027 is=iobounds(ng)%ILB_u
1028 ie=iobounds(ng)%IUB_u
1029 js=iobounds(ng)%JLB_u
1030 je=iobounds(ng)%JUB_u
1031 CASE (v2dvar, v3dvar)
1032 cgrid=4 ! V-points
1033 is=iobounds(ng)%ILB_v
1034 ie=iobounds(ng)%IUB_v
1035 js=iobounds(ng)%JLB_v
1036 je=iobounds(ng)%JUB_v
1037 CASE DEFAULT
1038 cgrid=2 ! RHO-points
1039 is=iobounds(ng)%ILB_rho
1040 ie=iobounds(ng)%IUB_rho
1041 js=iobounds(ng)%JLB_rho
1042 je=iobounds(ng)%JUB_rho
1043 END SELECT
1044!
1045! Set the tile computational I- and J-bounds (no ghost points).
1046!
1047 ghost=0
1048 imin=bounds(ng)%Imin(cgrid,ghost,myrank)
1049 imax=bounds(ng)%Imax(cgrid,ghost,myrank)
1050 jmin=bounds(ng)%Jmin(cgrid,ghost,myrank)
1051 jmax=bounds(ng)%Jmax(cgrid,ghost,myrank)
1052!
1053! Check if the following attributes: "scale_factor", "add_offset", and
1054! "_FillValue" are present in the input NetCDF variable:
1055!
1056! If the "scale_value" attribute is present, the data is multiplied by
1057! this factor after reading.
1058! If the "add_offset" attribute is present, this value is added to the
1059! data after reading.
1060! If both "scale_factor" and "add_offset" attributes are present, the
1061! data are first scaled before the offset is added.
1062! If the "_FillValue" attribute is present, the data having this value
1063! is treated a missing and it is replaced with zero. This feature it is
1064! usually related with the land/sea masking.
1065!
1066 attname(1)='scale_factor'
1067 attname(2)='add_offset '
1068 attname(3)='_FillValue '
1069
1070 CALL pio_netcdf_get_fatt (ng, model, ncname, piovar%vd, attname, &
1071 & attvalue, foundit, &
1072 & piofile = piofile)
1073 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1074 status=ioerror
1075 RETURN
1076 END IF
1077
1078 IF (.not.foundit(1)) THEN
1079 afactor=1.0_r8
1080 ELSE
1081 afactor=attvalue(1)
1082 END IF
1083
1084 IF (.not.foundit(2)) THEN
1085 aoffset=0.0_r8
1086 ELSE
1087 aoffset=attvalue(2)
1088 END IF
1089
1090 IF (.not.foundit(3)) THEN
1091 aspval=spval_check
1092 ELSE
1093 aspval=attvalue(3)
1094 END IF
1095!
1096! Initialize checsum value.
1097!
1098 IF (PRESENT(checksum)) THEN
1099 lchecksum=.true.
1100 checksum=0_i8b
1101 ELSE
1102 lchecksum=.false.
1103 END IF
1104!
1105!-----------------------------------------------------------------------
1106! Read in requested field and scale it.
1107!-----------------------------------------------------------------------
1108!
1109! Allocate and initialize local array used for reading. The local array
1110! needs to be of the same precision as "A" and its IO decomposition
1111! descriptor "pioDesc".
1112!
1113 IF (dkind.eq.pio_double) THEN ! double precision
1114 IF (.not.associated(awrk8)) THEN
1115 allocate ( awrk8(imin:imax, jmin:jmax, lbk:ubk) )
1116 END IF
1117 awrk8=0.0_r8
1118 ELSE ! single precision
1119 IF (.not.associated(awrk4)) THEN
1120 allocate ( awrk4(imin:imax, jmin:jmax, lbk:ubk) )
1121 END IF
1122 awrk4=0.0_r4
1123 END IF
1124!
1125! Set unlimited time dimension record to read, if any.
1126!
1127 IF (tindex.gt.0) THEN
1128 CALL pio_setframe (piofile, &
1129 & piovar%vd, &
1130 & int(tindex, kind=pio_offset_kind))
1131 END IF
1132!
1133! Read in double precision data from NetCDF file.
1134!
1135 IF (dkind.eq.pio_double) THEN
1136 CALL pio_read_darray (piofile, &
1137 & piovar%vd, &
1138 & piodesc, &
1139 & awrk8(imin:,jmin:,lbk:), &
1140 & status)
1141!
1142 DO k=lbk,ubk
1143 DO j=jmin,jmax
1144 DO i=imin,imax
1145 IF (abs(awrk8(i,j,k)).ge.abs(aspval)) THEN
1146 adat(i,j,k)=0.0_r8 ! masked with _FillValue
1147 ELSE
1148 avalue=ascl*(afactor*awrk8(i,j,k)+aoffset)
1149 adat(i,j,k)=avalue
1150 my_amin=min(my_amin,avalue)
1151 my_amax=max(my_amax,avalue)
1152 END IF
1153 END DO
1154 END DO
1155 END DO
1156 IF (associated(awrk8)) deallocate (awrk8)
1157!
1158! Read in single precision data from NetCDF file.
1159!
1160 ELSE
1161 CALL pio_read_darray (piofile, &
1162 & piovar%vd, &
1163 & piodesc, &
1164 & awrk4(imin:,jmin:,lbk:), &
1165 & status)
1166!
1167 DO k=lbk,ubk
1168 DO j=jmin,jmax
1169 DO i=imin,imax
1170 IF (abs(awrk4(i,j,k)).ge.abs(aspval)) THEN
1171 adat(i,j,k)=0.0_r8 ! masked with _FillValue
1172 ELSE
1173 avalue=real(ascl*(afactor*awrk4(i,j,k)+aoffset),r8)
1174 adat(i,j,k)=avalue
1175 my_amin=real(min(my_amin,avalue),r8)
1176 my_amax=real(max(my_amax,avalue),r8)
1177 END IF
1178 END DO
1179 END DO
1180 END DO
1181 IF (associated(awrk4)) deallocate (awrk4)
1182 END IF
1183!
1184! If requested, compute input data checksum value.
1185!
1186 IF (lchecksum) THEN
1187 npts=(imax-imin+1)*(jmax-jmin+1)*(ubk-lbk+1)
1188 IF (.not.allocated(cwrk)) allocate ( cwrk(npts) )
1189 cwrk=pack(adat(imin:imax, jmin:jmax, lbk:ubk), .true.)
1190 CALL get_hash (cwrk, npts, checksum, .true.)
1191 IF (allocated(cwrk)) deallocate (cwrk)
1192 END IF
1193!
1194! Compute global minimum and maximum values.
1195!
1196 rbuffer(1)=my_amin
1197 rbuffer(2)=my_amax
1198 op_handle(1)='MIN'
1199 op_handle(2)='MAX'
1200 CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
1201 amin=rbuffer(1)
1202 amax=rbuffer(2)
1203!
1204 IF ((abs(amin).ge.abs(spval)).and. &
1205 & (abs(amax).ge.abs(spval))) THEN
1206 amin=0.0_r8 ! the entire data is all
1207 amax=0.0_r8 ! field value, _FillValue
1208 END IF ! and was zeroth out
1209!
1210 RETURN

References mod_param::b3dvar, mod_param::bounds, mod_scalars::exit_flag, strings_mod::founderror(), get_hash_mod::get_hash(), mod_param::iobounds, mod_iounits::ioerror, mod_param::l3dvar, mod_parallel::myrank, mod_scalars::noerror, mod_param::p2dvar, mod_param::p3dvar, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::spval, mod_scalars::spval_check, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, and mod_param::w3dvar.

Here is the call graph for this function:

The documentation for this interface was generated from the following file: