ROMS
Loading...
Searching...
No Matches
nf_fwrite2d_bry.F
Go to the documentation of this file.
1#include "cppdefs.h"
3
4#ifdef ADJUST_BOUNDARY
5!
6!git $Id$
7!================================================== Hernan G. Arango ===
8! Copyright (c) 2002-2025 The ROMS Group !
9! Licensed under a MIT/X style license !
10! See License_ROMS.md !
11!=======================================================================
12! !
13! This module writes out a generic floating point 2D boundary array !
14! into an output file using either the standard NetCDF library or the !
15! Parallel-IO (PIO) library. !
16! !
17! On Input: !
18! !
19! ng Nested grid number (integer) !
20! model Calling model identifier (integer) !
21! ncname NetCDF output file name (string) !
22! ncid NetCDF file ID (integer) !
23# if defined PIO_LIB && defined DISTRIBUTE
24!or pioFile PIO file descriptor structure, TYPE(file_desc_t) !
25! pioFile%fh file handler !
26! pioFile%iosystem IO system descriptor (struct) !
27# endif
28! ncvname NetCDF variable name (string) !
29! ncvarid NetCDF variable ID (integer) !
30# if defined PIO_LIB && defined DISTRIBUTE
31!or pioVar PIO variable descriptor structure, TYPE(My_VarDesc) !
32! pioVar%vd variable descriptor TYPE(Var_Desc_t)!
33! pioVar%dkind variable data kind !
34! pioVar%gtype variable C-gridtype !
35# endif
36! tindex NetCDF time record index to write (integer) !
37! gtype Grid type (integer) !
38# if defined PIO_LIB && defined DISTRIBUTE
39!or pioDesc IO data decomposition descriptor, TYPE(IO_desc_t) !
40# endif
41! LBij IJ-dimension Lower bound (integer) !
42! UBij IJ-dimension Upper bound (integer) !
43! Nrec Number of boundary records (integer) !
44! Ascl Factor to scale field before writing (real) !
45! Abry Boundary field to write out (real) !
46! ExtractField Field extraction flag (integer, OPTIONAL) !
47! ExtractField = 0 no extraction !
48! ExtractField = 1 extraction by interpolation !
49! ExtractField > 1 extraction by decimation !
50! !
51! On Output: !
52! !
53! status Error flag (integer). !
54! MinValue Minimum value (real, OPTIONAL) !
55! MaxValue Maximum value (real, OPTIONAL) !
56! !
57# ifdef POSITIVE_ZERO
58! Starting F95 zero values can be signed (-0 or +0) following the !
59! IEEE 754 floating point standard. This may produce different !
60! output data in serial and parallel applications. Since comparing !
61! serial and parallel output is essential for tracking parallel !
62! partition bugs, "positive zero" is enforced. !
63! !
64# endif
65!=======================================================================
66!
67 USE mod_param
68 USE mod_parallel
69 USE mod_ncparam
70 USE mod_scalars
71!
72# ifdef DISTRIBUTE
74# endif
76!
77 implicit none
78!
80 MODULE PROCEDURE nf90_fwrite2d_bry
81# if defined PIO_LIB && defined DISTRIBUTE
82 MODULE PROCEDURE pio_fwrite2d_bry
83# endif
84 END INTERFACE nf_fwrite2d_bry
85!
86 CONTAINS
87!
88!***********************************************************************
89 FUNCTION nf90_fwrite2d_bry (ng, model, ncname, ncid, &
90 & ncvname, ncvarid, &
91 & tindex, gtype, &
92 & LBij, UBij, Nrec, &
93 & Ascl, Abry, &
94 & ExtractField, &
95 & MinValue, MaxValue) RESULT(status)
96!***********************************************************************
97!
98 USE mod_netcdf
99!
100! Imported variable declarations.
101!
102 integer, intent(in) :: ng, model, ncid, ncvarid, tindex, gtype
103 integer, intent(in) :: lbij, ubij, nrec
104!
105 integer, intent(in), optional :: extractfield
106!
107 real(dp), intent(in) :: ascl
108!
109 character (len=*), intent(in) :: ncname
110 character (len=*), intent(in) :: ncvname
111!
112# ifdef ASSUMED_SHAPE
113 real(r8), intent(in) :: abry(lbij:,:,:)
114# else
115 real(r8), intent(in) :: abry(lbij:ubij,4,nrec)
116# endif
117 real(r8), intent(out), optional :: minvalue
118 real(r8), intent(out), optional :: maxvalue
119!
120! Local variable declarations.
121!
122 integer :: iorj, npts, i, tile
123 integer :: extract_flag
124 integer :: status
125!
126 integer, dimension(4) :: start, total
127!
128 real(r8), dimension((UBij-LBij+1)*4*Nrec) :: awrk
129!
130!-----------------------------------------------------------------------
131! Initialize local variables.
132!-----------------------------------------------------------------------
133!
134 status=nf90_noerr
135!
136! Set parallel tile.
137!
138# ifdef DISTRIBUTE
139 tile=myrank
140# else
141 tile=-1
142# endif
143!
144! Set length of boundary data as the value of greater of I- or
145! j-dimension.
146!
147 iorj=iobounds(ng)%IorJ
148 npts=iorj*4*nrec
149!
150! If appropriate, set the field extraction flag to the provided grid
151! geometry through interpolation or decimation.
152!
153 IF (PRESENT(extractfield)) THEN
154 extract_flag=extractfield
155 ELSE
156 extract_flag=0
157 END IF
158!
159! Initialize local array to avoid denormalized numbers. This
160! facilitates processing and debugging.
161!
162 awrk=0.0_r8
163!
164!-----------------------------------------------------------------------
165! Pack 2D boundary data into 1D array.
166!-----------------------------------------------------------------------
167!
168 CALL pack_boundary2d (ng, model, tile, &
169 & gtype, ncvname, tindex, &
170 & extract_flag, &
171 & lbij, ubij, nrec, &
172 & ascl, abry, &
173 & start, total, npts, awrk)
174!
175!-----------------------------------------------------------------------
176! If applicable, compute output field minimum and maximum values.
177!-----------------------------------------------------------------------
178!
179 IF (PRESENT(minvalue)) THEN
180 IF (outthread) THEN
181 minvalue=spval
182 maxvalue=-spval
183 DO i=1,npts
184 IF (abs(awrk(i)).lt.spval) THEN
185 minvalue=min(minvalue,awrk(i))
186 maxvalue=max(maxvalue,awrk(i))
187 END IF
188 END DO
189 END IF
190 END IF
191!
192!-----------------------------------------------------------------------
193! Write output buffer into NetCDF file.
194!-----------------------------------------------------------------------
195!
196 status=nf90_noerr
197 IF (outthread) THEN
198 status=nf90_put_var(ncid, ncvarid, awrk, start, total)
199 END IF
200
201# ifdef DISTRIBUTE
202!
203!-----------------------------------------------------------------------
204! Broadcast IO error flag to all nodes.
205!-----------------------------------------------------------------------
206!
207 CALL mp_bcasti (ng, model, status)
208# endif
209!
210 RETURN
211 END FUNCTION nf90_fwrite2d_bry
212
213# if defined PIO_LIB && defined DISTRIBUTE
214!
215!***********************************************************************
216 FUNCTION pio_fwrite2d_bry (ng, model, ncname, pioFile, &
217 & ncvname, pioVar, &
218 & tindex, pioDesc, &
219 & LBij, UBij, Nrec, &
220 & Ascl, Abry, &
221 & MinValue, MaxValue) RESULT(status)
222!***********************************************************************
223!
225!
226! Imported variable declarations.
227!
228 integer, intent(in) :: ng, model, tindex
229 integer, intent(in) :: lbij, ubij, nrec
230!
231 real(dp), intent(in) :: ascl
232!
233 character (len=*), intent(in) :: ncname
234 character (len=*), intent(in) :: ncvname
235!
236# ifdef ASSUMED_SHAPE
237 real(r8), intent(in) :: abry(lbij:,:,:)
238# else
239 real(r8), intent(in) :: abry(lbij:ubij,4,nrec)
240# endif
241 real(r8), intent(out), optional :: minvalue
242 real(r8), intent(out), optional :: maxvalue
243!
244 TYPE (file_desc_t), intent(inout) :: piofile
245 TYPE (io_desc_t), intent(inout) :: piodesc
246 TYPE (my_vardesc), intent(inout) :: piovar
247!
248! Local variable declarations.
249!
250 logical, dimension(4) :: bounded
251!
252 integer :: bc, i, ib, ic, ir, j, rc
253 integer :: dkind, gtype, tile
254 integer :: iorj, imin, imax, jmin, jmax, npts
255 integer :: istr, iend, jstr, jend
256
257 integer, dimension(4) :: start, total
258
259 integer :: status
260!
261 real(r8), parameter :: aspv = 0.0_r8
262
263 real(r8), dimension((UBij-LBij+1)*4*Nrec) :: awrk
264!
265!-----------------------------------------------------------------------
266! Set starting and ending indices to process.
267!-----------------------------------------------------------------------
268!
269 status=pio_noerr
270!
271! Set tile starting and ending bounds.
272!
273 tile=myrank
274 dkind=piovar%dkind
275 gtype=piovar%gtype
276!
277 SELECT CASE (gtype)
278 CASE (p2dvar, p3dvar)
279 imin=bounds(ng)%Istr (tile)
280 imax=bounds(ng)%Iend (tile)
281 jmin=bounds(ng)%Jstr (tile)
282 jmax=bounds(ng)%Jend (tile)
283 CASE (r2dvar, r3dvar)
284 imin=bounds(ng)%IstrR(tile)
285 imax=bounds(ng)%IendR(tile)
286 jmin=bounds(ng)%JstrR(tile)
287 jmax=bounds(ng)%JendR(tile)
288 CASE (u2dvar, u3dvar)
289 imin=bounds(ng)%Istr (tile)
290 imax=bounds(ng)%IendR(tile)
291 jmin=bounds(ng)%JstrR(tile)
292 jmax=bounds(ng)%JendR(tile)
293 CASE (v2dvar, v3dvar)
294 imin=bounds(ng)%IstrR(tile)
295 imax=bounds(ng)%IendR(tile)
296 jmin=bounds(ng)%Jstr (tile)
297 jmax=bounds(ng)%JendR(tile)
298 CASE DEFAULT
299 imin=bounds(ng)%IstrR(tile)
300 imax=bounds(ng)%IendR(tile)
301 jmin=bounds(ng)%JstrR(tile)
302 jmax=bounds(ng)%JendR(tile)
303 END SELECT
304!
305 iorj=iobounds(ng)%IorJ
306 npts=iorj*4*nrec
307!
308! Get tile bounds.
309!
310 istr=bounds(ng)%Istr(tile)
311 iend=bounds(ng)%Iend(tile)
312 jstr=bounds(ng)%Jstr(tile)
313 jend=bounds(ng)%Jend(tile)
314!
315! Set switch to process boundary data by their associated tiles.
316!
317 bounded(iwest )=domain(ng)%Western_Edge (tile)
318 bounded(ieast )=domain(ng)%Eastern_Edge (tile)
319 bounded(isouth)=domain(ng)%Southern_Edge(tile)
320 bounded(inorth)=domain(ng)%Northern_Edge(tile)
321!
322! Set NetCDF dimension counters for processing requested field.
323!
324 start(1)=1
325 total(1)=iorj
326 start(2)=1
327 total(2)=4
328 start(3)=1
329 total(3)=nrec
330 start(4)=tindex
331 total(4)=1
332!
333!-----------------------------------------------------------------------
334! Pack and scale output data.
335!-----------------------------------------------------------------------
336!
337 awrk=aspv
338!
339 DO ir=1,nrec
340 rc=(ir-1)*iorj*4
341 DO ib=1,4
342 IF (bounded(ib)) THEN
343 bc=(ib-1)*iorj+rc
344 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
345 DO j=jmin,jmax
346 ic=1+(j-lbij)+bc
347 awrk(ic)=abry(j,ib,ir)*ascl
348# ifdef POSITIVE_ZERO
349 IF (abs(awrk(ic)).eq.0.0_r8) THEN
350 awrk(ic)=0.0_r8 ! impose positive zero
351 END IF
352# endif
353 END DO
354 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
355 DO i=imin,imax
356 ic=1+(i-lbij)+bc
357 awrk(ic)=abry(i,ib,ir)*ascl
358# ifdef POSITIVE_ZERO
359 IF (abs(awrk(ic)).eq.0.0_r8) THEN
360 awrk(ic)=0.0_r8 ! impose positive zero
361 END IF
362# endif
363 END DO
364 END IF
365 END IF
366 END DO
367 END DO
368!
369! Collect data from all spawned processes.
370!
371 CALL mp_collect (ng, model, npts, aspv, awrk)
372!
373!-----------------------------------------------------------------------
374! If applicable, compute output field minimum and maximum values.
375!-----------------------------------------------------------------------
376!
377 IF (PRESENT(minvalue)) THEN
378 minvalue=spval
379 maxvalue=-spval
380 DO i=1,npts
381 IF (abs(awrk(i)).lt.spval) THEN
382 minvalue=min(minvalue,awrk(i))
383 maxvalue=max(maxvalue,awrk(i))
384 END IF
385 END DO
386 END IF
387!
388!-----------------------------------------------------------------------
389! Write output buffer into NetCDF file.
390!-----------------------------------------------------------------------
391!
392 status=pio_put_var(piofile, piovar%vd, start, total, awrk)
393!
394 RETURN
395 END FUNCTION pio_fwrite2d_bry
396# endif
397#endif
398 END MODULE nf_fwrite2d_bry_mod
logical outthread
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
integer, parameter r3dvar
Definition mod_param.F:721
type(t_iobounds), dimension(:), allocatable iobounds
Definition mod_param.F:282
integer, parameter u3dvar
Definition mod_param.F:722
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
integer, parameter u2dvar
Definition mod_param.F:718
integer, parameter p2dvar
Definition mod_param.F:716
integer, parameter r2dvar
Definition mod_param.F:717
integer, parameter v2dvar
Definition mod_param.F:719
integer, parameter p3dvar
Definition mod_param.F:720
integer, parameter v3dvar
Definition mod_param.F:723
real(dp), parameter spval
integer, parameter iwest
integer, parameter isouth
integer, parameter ieast
integer, parameter inorth
integer function pio_fwrite2d_bry(ng, model, ncname, piofile, ncvname, piovar, tindex, piodesc, lbij, ubij, nrec, ascl, abry, minvalue, maxvalue)
integer function nf90_fwrite2d_bry(ng, model, ncname, ncid, ncvname, ncvarid, tindex, gtype, lbij, ubij, nrec, ascl, abry, extractfield, minvalue, maxvalue)
subroutine, public pack_boundary2d(ng, model, tile, gtype, ncvname, tindex, extract_flag, lbij, ubij, nrec, bscl, bdat, start, total, npts, bwrk)
Definition pack_field.F:58