86
87
89
90
91
92 integer, intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
93 integer, intent(in) :: LBij, UBij, Nrec
94
95 integer(i8b), intent(out), optional :: checksum
96
97 real(dp), intent(in) :: Ascl
98 real(r8), intent(out) :: Amin
99 real(r8), intent(out) :: Amax
100
101 character (len=*), intent(in) :: ncname
102 character (len=*), intent(in) :: ncvname
103
104#ifdef ASSUMED_SHAPE
105 real(r8), intent(out) :: Abry(LBij:,:,:)
106#else
107 real(r8), intent(out) :: Abry(LBij:UBij,4,Nrec)
108#endif
109
110
111
112 logical :: Lchecksum
113 logical, dimension(3) :: foundit
114 logical, dimension(4) :: bounded
115
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
120
121 integer :: status
122
123 real(r8) :: Afactor, Aoffset, Aspval
124
125 real(r8), allocatable :: Cwrk(:)
126
127 real(r8), dimension(3) :: AttValue
128
129#if !defined PARALLEL_IO && defined DISTRIBUTE
130 real(r8), dimension(3) :: rbuffer
131#endif
132 real(r8), dimension(LBij:UBij,4,Nrec) :: wrk
133
134 character (len=12), dimension(3) :: AttName
135
136 character (len=*), parameter :: MyFile = &
137 & __FILE__//", pio_fread2d_bry"
138
139
140
141
142
143 status=nf90_noerr
144
145
146
147
148
149
150
151
152
153
154 IF (model.eq.iadm) THEN
155 ghost=0
156 ELSE
157 ghost=1
158 END IF
159
160 SELECT CASE (gtype)
161 CASE (p2dvar, p3dvar)
162 cgrid=1
163 CASE (r2dvar, r3dvar)
164 cgrid=2
165 CASE (u2dvar, u3dvar)
166 cgrid=3
167 CASE (v2dvar, v3dvar)
168 cgrid=4
169 CASE DEFAULT
170 cgrid=2
171 END SELECT
172
173#ifdef DISTRIBUTE
174 tile=myrank
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)
179#else
180 tile=-1
181 imin=lbij
182 imax=ubij
183 jmin=lbij
184 jmax=ubij
185#endif
186
187 iorj=iobounds(ng)%IorJ
188 npts=iorj*4*nrec
189
190
191
192 istr=bounds(ng)%Istr (tile)
193 iend=bounds(ng)%Iend (tile)
194 jstr=bounds(ng)%Jstr (tile)
195 jend=bounds(ng)%Jend (tile)
196
197
198
199 bounded(iwest )=domain(ng)%Western_Edge(tile)
200 bounded(ieast )=domain(ng)%Eastern_Edge(tile)
201 bounded(isouth)=domain(ng)%Southern_Edge(tile)
202 bounded(inorth)=domain(ng)%Northern_Edge(tile)
203
204
205
206 start(1)=1
207 total(1)=iorj
208 start(2)=1
209 total(2)=4
210 start(3)=1
211 total(3)=nrec
212 start(4)=tindex
213 total(4)=1
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228 attname(1)='scale_factor'
229 attname(2)='add_offset '
230 attname(3)='_FillValue '
231
233 & attvalue, foundit, &
234 & ncid = ncid)
235 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
236 status=ioerror
237 RETURN
238 END IF
239
240 IF (.not.foundit(1)) THEN
241 afactor=1.0_r8
242 ELSE
243 afactor=attvalue(1)
244 END IF
245
246 IF (.not.foundit(2)) THEN
247 aoffset=0.0_r8
248 ELSE
249 aoffset=attvalue(2)
250 END IF
251
252 IF (.not.foundit(3)) THEN
253 aspval=spval_check
254 ELSE
255 aspval=attvalue(3)
256 END IF
257
258
259
260 IF (PRESENT(checksum)) THEN
261 lchecksum=.true.
262 checksum=0_i8b
263 ELSE
264 lchecksum=.false.
265 END IF
266
267
268
269
270
271 wrk=0.0_r8
272
273 IF (inpthread) THEN
274 status=nf90_get_var(ncid, ncvarid, wrk(lbij:,:,:), start, total)
275 IF (status.eq.nf90_noerr) THEN
276 amin=spval
277 amax=-spval
278 DO ir=1,nrec
279 DO ib=1,4
280 DO ij=lbij,ubij
281 IF (abs(wrk(ij,ib,ir)).ge.abs(aspval)) THEN
282 wrk(ij,ib,ir)=0.0_r8
283 ELSE
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))
287 END IF
288 END DO
289 END DO
290 END DO
291 IF ((abs(amin).ge.abs(aspval)).and. &
292 & (abs(amax).ge.abs(aspval))) THEN
293 amin=0.0_r8
294 amax=0.0_r8
295 END IF
296
297 IF (lchecksum) 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)
303 END IF
304 END IF
305 END IF
306
307#if !defined PARALLEL_IO && defined DISTRIBUTE
308
309 rbuffer(1)=real(status,r8)
310 rbuffer(2)=amin
311 rbuffer(3)=amax
312 CALL mp_bcastf (ng, model, rbuffer)
313 status=int(rbuffer(1))
314 amin=rbuffer(2)
315 amax=rbuffer(3)
316#endif
317
318 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
319 exit_flag=2
320 ioerror=status
321 RETURN
322 END IF
323
324#if !defined PARALLEL_IO && defined DISTRIBUTE
325
326
327
328 CALL mp_bcastf (ng, model, wrk)
329#endif
330
331
332
333
334
335 abry=0.0_r8
336
337 DO ir=1,nrec
338 DO ib=1,4
339 IF (bounded(ib)) THEN
340 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
341 DO j=jmin,jmax
342 abry(j,ib,ir)=wrk(j,ib,ir)
343 END DO
344 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
345 DO i=imin,imax
346 abry(i,ib,ir)=wrk(i,ib,ir)
347 END DO
348 END IF
349 END IF
350 END DO
351 END DO
352
353 RETURN