MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
DisvNCMesh.f90
Go to the documentation of this file.
1 !> @brief This module contains the MeshDisvModelModule
2 !!
3 !! This module defines UGRID layered mesh compliant netcdf
4 !! export type for DISV models. It is dependent on netcdf
5 !! libraries.
6 !!
7 !<
9 
10  use kindmodule, only: dp, i4b, lgp
13  use simvariablesmodule, only: errmsg
22  use disvmodule, only: disvtype
23  use netcdfcommonmodule, only: nf_verify
24  use netcdf
25 
26  implicit none
27  private
28  public :: mesh2ddisvexporttype
29 
30  ! -- UGRID layered mesh DISV
32  type(disvtype), pointer :: disv => null() !< pointer to model disv package
33  contains
34  procedure :: init => disv_export_init
35  procedure :: destroy => disv_export_destroy
36  procedure :: df
37  procedure :: step
38  procedure :: export_input_array
39  procedure :: package_step_ilayer
40  procedure :: package_step
41  procedure :: export_layer_2d
42  procedure :: define_dim
43  procedure :: add_mesh_data
44  end type mesh2ddisvexporttype
45 
46 contains
47 
48  !> @brief netcdf export disv init
49  !<
50  subroutine disv_export_init(this, modelname, modeltype, modelfname, disenum, &
51  nctype, iout)
53  class(mesh2ddisvexporttype), intent(inout) :: this
54  character(len=*), intent(in) :: modelname
55  character(len=*), intent(in) :: modeltype
56  character(len=*), intent(in) :: modelfname
57  integer(I4B), intent(in) :: disenum
58  integer(I4B), intent(in) :: nctype
59  integer(I4B), intent(in) :: iout
60  !
61  ! -- set nlay
62  this%nlay = this%disv%nlay
63  !
64  ! allocate var_id arrays
65  allocate (this%var_ids%dependent(this%nlay))
66  !
67  ! -- initialize base class
68  call this%mesh_init(modelname, modeltype, modelfname, disenum, nctype, iout)
69  end subroutine disv_export_init
70 
71  !> @brief netcdf export disv destroy
72  !<
73  subroutine disv_export_destroy(this)
74  class(mesh2ddisvexporttype), intent(inout) :: this
75  !
76  deallocate (this%var_ids%dependent)
77  !
78  ! -- destroy base class
79  call this%mesh_destroy()
80  call this%NCModelExportType%destroy()
81  end subroutine disv_export_destroy
82 
83  !> @brief netcdf export define
84  !<
85  subroutine df(this)
86  use constantsmodule, only: mvalidate
87  use simvariablesmodule, only: isim_mode
88  class(mesh2ddisvexporttype), intent(inout) :: this
89  ! -- put root group file scope attributes
90  call this%add_global_att()
91  ! -- define root group dimensions and coordinate variables
92  call this%define_dim()
93  ! -- define mesh variables
94  call this%create_mesh()
95  if (isim_mode /= mvalidate) then
96  ! -- define the dependent variable
97  call this%define_dependent()
98  end if
99  ! -- exit define mode
100  call nf_verify(nf90_enddef(this%ncid), this%nc_fname)
101  ! -- create mesh
102  call this%add_mesh_data()
103  ! -- define and set package input griddata
104  call this%add_pkg_data()
105  ! -- define and set gridmap variable
106  call this%define_gridmap()
107  ! -- synchronize file
108  call nf_verify(nf90_sync(this%ncid), this%nc_fname)
109  end subroutine df
110 
111  !> @brief netcdf export step
112  !<
113  subroutine step(this)
114  use constantsmodule, only: dhnoflo
115  use tdismodule, only: totim
116  class(mesh2ddisvexporttype), intent(inout) :: this
117  real(DP), dimension(:), pointer, contiguous :: dbl1d
118  integer(I4B) :: n, k, nvals
119  integer(I4B), dimension(2) :: dis_shape
120  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
121  !
122  ! -- initialize
123  nullify (dbl1d)
124  nullify (dbl2d)
125  !
126  ! -- increment step
127  this%stepcnt = this%stepcnt + 1
128  !
129  dis_shape(1) = this%disv%ncpl
130  dis_shape(2) = this%disv%nlay
131  !
132  nvals = product(dis_shape)
133  !
134  ! -- add data to dependent variable
135  if (size(this%disv%nodeuser) < &
136  size(this%disv%nodereduced)) then
137  !
138  ! -- allocate nodereduced size 1d array
139  allocate (dbl1d(size(this%disv%nodereduced)))
140  !
141  ! -- initialize DHNOFLO for non-active cells
142  dbl1d = dhnoflo
143  !
144  ! -- update active cells
145  do n = 1, size(this%disv%nodereduced)
146  if (this%disv%nodereduced(n) > 0) then
147  dbl1d(n) = this%x(this%disv%nodereduced(n))
148  end if
149  end do
150  !
151  dbl2d(1:dis_shape(1), 1:dis_shape(2)) => dbl1d(1:nvals)
152  else
153  !
154  dbl2d(1:dis_shape(1), 1:dis_shape(2)) => this%x(1:nvals)
155  !
156  end if
157  !
158  do k = 1, this%disv%nlay
159  ! -- extend array with step data
160  call nf_verify(nf90_put_var(this%ncid, &
161  this%var_ids%dependent(k), dbl2d(:, k), &
162  start=(/1, this%stepcnt/), &
163  count=(/this%disv%ncpl, 1/)), &
164  this%nc_fname)
165  end do
166  !
167  ! -- write to time coordinate variable
168  call nf_verify(nf90_put_var(this%ncid, this%var_ids%time, &
169  totim, start=(/this%stepcnt/)), &
170  this%nc_fname)
171  !
172  ! -- update file
173  call nf_verify(nf90_sync(this%ncid), this%nc_fname)
174  !
175  ! -- cleanup
176  if (associated(dbl1d)) deallocate (dbl1d)
177  nullify (dbl1d)
178  nullify (dbl2d)
179  end subroutine step
180 
181  !> @brief netcdf export package dynamic input with ilayer index variable
182  !<
183  subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer)
184  use constantsmodule, only: dnodata, dzero
185  use tdismodule, only: kper
188  class(mesh2ddisvexporttype), intent(inout) :: this
189  class(exportpackagetype), pointer, intent(in) :: export_pkg
190  character(len=*), intent(in) :: ilayer_varname
191  integer(I4B), intent(in) :: ilayer
192  ! -- local
193  type(inputparamdefinitiontype), pointer :: idt
194  integer(I4B), dimension(:), pointer, contiguous :: int1d
195  real(DP), dimension(:), pointer, contiguous :: dbl1d
196  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
197  integer(I4B), dimension(:), pointer, contiguous :: ialayer
198  real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr
199  character(len=LINELENGTH) :: nc_varname, input_attr
200  integer(I4B) :: n, iparam, nvals
201  logical(LGP) :: ilayer_read
202  !
203  ! -- initialize
204  nullify (ialayer)
205  ilayer_read = .false.
206  !
207  ! -- set pointer to ilayer variable
208  call mem_setptr(ialayer, export_pkg%param_names(ilayer), &
209  export_pkg%mf6_input%mempath)
210  !
211  ! -- check if layer index variable was read
212  if (export_pkg%param_reads(ilayer)%invar == 1) then
213  ilayer_read = .true.
214  end if
215  !
216  ! -- export defined period input
217  do iparam = 1, export_pkg%nparam
218  !
219  ! -- check if variable was read this period
220  if (export_pkg%param_reads(iparam)%invar < 1) cycle
221  !
222  ! -- set input definition
223  idt => &
224  get_param_definition_type(export_pkg%mf6_input%param_dfns, &
225  export_pkg%mf6_input%component_type, &
226  export_pkg%mf6_input%subcomponent_type, &
227  'PERIOD', export_pkg%param_names(iparam), '')
228  !
229  ! -- set variable name and input string
230  nc_varname = trim(export_pkg%mf6_input%subcomponent_name)//'_'// &
231  trim(idt%mf6varname)
232  input_attr = this%input_attribute(export_pkg%mf6_input%subcomponent_name, &
233  idt)
234  !
235  ! -- export arrays
236  select case (idt%datatype)
237  case ('INTEGER1D')
238  call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath)
239  call nc_export_int1d(this%ncid, this%dim_ids, this%var_ids, this%disv, &
240  int1d, nc_varname, &
241  export_pkg%mf6_input%subcomponent_name, &
242  idt%tagname, this%gridmap_name, idt%shape, &
243  idt%longname, input_attr, this%deflate, &
244  this%shuffle, this%chunk_face, kper, this%nc_fname)
245  case ('DOUBLE1D')
246  call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath)
247  call this%export_layer_2d(export_pkg, idt, ilayer_read, ialayer, &
248  dbl1d, nc_varname, input_attr)
249  case ('DOUBLE2D')
250  call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath)
251  nvals = this%disv%ncpl
252  !
253  do n = 1, size(dbl2d, dim=1) !naux
254  dbl1d_ptr(1:nvals) => dbl2d(n, :)
255  if (all(dbl1d_ptr == dzero)) then
256  else
257  call this%export_layer_2d(export_pkg, idt, ilayer_read, ialayer, &
258  dbl1d_ptr, nc_varname, input_attr, n)
259  end if
260  end do
261  case default
262  !
263  errmsg = 'EXPORT ilayer unsupported datatype='//trim(idt%datatype)
264  call store_error(errmsg, .true.)
265  end select
266  end do
267  !
268  ! -- synchronize file
269  call nf_verify(nf90_sync(this%ncid), this%nc_fname)
270  !
271  ! -- return
272  return
273  end subroutine package_step_ilayer
274 
275  !> @brief netcdf export package dynamic input
276  !<
277  subroutine package_step(this, export_pkg)
279  class(mesh2ddisvexporttype), intent(inout) :: this
280  class(exportpackagetype), pointer, intent(in) :: export_pkg
281  errmsg = 'NetCDF period export not supported for model='// &
282  trim(this%modelname)//', package='// &
283  trim(export_pkg%mf6_input%subcomponent_name)
284  call store_error(errmsg, .true.)
285  !
286  ! -- synchronize file
287  call nf_verify(nf90_sync(this%ncid), this%nc_fname)
288  end subroutine package_step
289 
290  !> @brief export layer variable as full grid
291  !<
292  subroutine export_layer_2d(this, export_pkg, idt, ilayer_read, ialayer, &
293  dbl1d, nc_varname, input_attr, iaux)
294  use constantsmodule, only: dnodata, dzero
296  class(mesh2ddisvexporttype), intent(inout) :: this
297  class(exportpackagetype), pointer, intent(in) :: export_pkg
298  type(inputparamdefinitiontype), pointer, intent(in) :: idt
299  logical(LGP), intent(in) :: ilayer_read
300  integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ialayer
301  real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d
302  character(len=*), intent(in) :: nc_varname
303  character(len=*), intent(in) :: input_attr
304  integer(I4B), optional, intent(in) :: iaux
305  ! -- local
306  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
307  integer(I4B) :: n, j, k, idxaux
308  !
309  ! -- initialize
310  idxaux = 0
311  if (present(iaux)) then
312  idxaux = iaux
313  end if
314 
315  allocate (dbl2d(export_pkg%mshape(2), export_pkg%mshape(1)))
316  !
317  if (ilayer_read) then
318  do k = 1, size(dbl2d, dim=2)
319  n = 0
320  do j = 1, size(dbl2d, dim=1)
321  n = n + 1
322  if (ialayer(n) == k) then
323  dbl2d(j, k) = dbl1d(n)
324  else
325  dbl2d(j, k) = dnodata
326  end if
327  end do
328  end do
329  else
330  dbl2d = dnodata
331  dbl2d(:, 1) = dbl1d(:)
332  end if
333  !
334  call nc_export_dbl2d(this%ncid, this%dim_ids, this%var_ids, this%disv, &
335  dbl2d, nc_varname, &
336  export_pkg%mf6_input%subcomponent_name, idt%tagname, &
337  this%gridmap_name, idt%shape, idt%longname, input_attr, &
338  this%deflate, this%shuffle, this%chunk_face, &
339  export_pkg%iper, idxaux, this%nc_fname)
340  !
341  deallocate (dbl2d)
342  end subroutine export_layer_2d
343 
344  !> @brief netcdf export an input array
345  !<
346  subroutine export_input_array(this, pkgtype, pkgname, mempath, idt)
347  class(mesh2ddisvexporttype), intent(inout) :: this
348  character(len=*), intent(in) :: pkgtype
349  character(len=*), intent(in) :: pkgname
350  character(len=*), intent(in) :: mempath
351  type(inputparamdefinitiontype), pointer, intent(in) :: idt
352  integer(I4B), dimension(:), pointer, contiguous :: int1d
353  integer(I4B), dimension(:, :), pointer, contiguous :: int2d
354  real(DP), dimension(:), pointer, contiguous :: dbl1d
355  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
356  character(len=LINELENGTH) :: nc_varname, input_attr
357  integer(I4B) :: iper, iaux
358  !
359  iper = 0
360  iaux = 0
361  !
362  ! -- set package base name
363  nc_varname = trim(pkgname)//'_'//trim(idt%mf6varname)
364  ! -- put input attributes
365  input_attr = this%input_attribute(pkgname, idt)
366  !
367  select case (idt%datatype)
368  case ('INTEGER1D')
369  call mem_setptr(int1d, idt%mf6varname, mempath)
370  call nc_export_int1d(this%ncid, this%dim_ids, this%var_ids, this%disv, &
371  int1d, nc_varname, pkgname, idt%tagname, &
372  this%gridmap_name, idt%shape, idt%longname, &
373  input_attr, this%deflate, this%shuffle, &
374  this%chunk_face, iper, this%nc_fname)
375  case ('INTEGER2D')
376  call mem_setptr(int2d, idt%mf6varname, mempath)
377  call nc_export_int2d(this%ncid, this%dim_ids, this%var_ids, this%disv, &
378  int2d, nc_varname, pkgname, idt%tagname, &
379  this%gridmap_name, idt%shape, idt%longname, &
380  input_attr, this%deflate, this%shuffle, &
381  this%chunk_face, this%nc_fname)
382  case ('DOUBLE1D')
383  call mem_setptr(dbl1d, idt%mf6varname, mempath)
384  call nc_export_dbl1d(this%ncid, this%dim_ids, this%var_ids, this%disv, &
385  dbl1d, nc_varname, pkgname, idt%tagname, &
386  this%gridmap_name, idt%shape, idt%longname, &
387  input_attr, this%deflate, this%shuffle, &
388  this%chunk_face, this%nc_fname)
389  case ('DOUBLE2D')
390  call mem_setptr(dbl2d, idt%mf6varname, mempath)
391  call nc_export_dbl2d(this%ncid, this%dim_ids, this%var_ids, this%disv, &
392  dbl2d, nc_varname, pkgname, idt%tagname, &
393  this%gridmap_name, idt%shape, idt%longname, &
394  input_attr, this%deflate, this%shuffle, &
395  this%chunk_face, iper, iaux, this%nc_fname)
396  case default
397  ! -- no-op, no other datatypes exported
398  end select
399  end subroutine export_input_array
400 
401  !> @brief netcdf export define dimensions
402  !<
403  subroutine define_dim(this)
404  use constantsmodule, only: mvalidate
405  use simvariablesmodule, only: isim_mode
406  class(mesh2ddisvexporttype), intent(inout) :: this
407  integer(I4B), dimension(:), contiguous, pointer :: ncvert
408  !
409  ! -- set pointers to input context
410  call mem_setptr(ncvert, 'NCVERT', this%dis_mempath)
411  !
412  ! -- time
413  if (isim_mode /= mvalidate) then
414  call nf_verify(nf90_def_dim(this%ncid, 'time', this%totnstp, &
415  this%dim_ids%time), this%nc_fname)
416  call nf_verify(nf90_def_var(this%ncid, 'time', nf90_double, &
417  this%dim_ids%time, this%var_ids%time), &
418  this%nc_fname)
419  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'calendar', &
420  'standard'), this%nc_fname)
421  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'units', &
422  this%datetime), this%nc_fname)
423  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'axis', 'T'), &
424  this%nc_fname)
425  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'standard_name', &
426  'time'), this%nc_fname)
427  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'long_name', &
428  'time'), this%nc_fname)
429  end if
430  !
431  ! -- mesh
432  call nf_verify(nf90_def_dim(this%ncid, 'nmesh_node', this%disv%nvert, &
433  this%dim_ids%nmesh_node), this%nc_fname)
434  call nf_verify(nf90_def_dim(this%ncid, 'nmesh_face', this%disv%ncpl, &
435  this%dim_ids%nmesh_face), this%nc_fname)
436  call nf_verify(nf90_def_dim(this%ncid, 'max_nmesh_face_nodes', &
437  maxval(ncvert), &
438  this%dim_ids%max_nmesh_face_nodes), &
439  this%nc_fname)
440  !
441  ! -- ncpl, nlay
442  call nf_verify(nf90_def_dim(this%ncid, 'nlay', this%disv%nlay, &
443  this%dim_ids%nlay), this%nc_fname)
444  end subroutine define_dim
445 
446  !> @brief netcdf export add mesh information
447  !<
448  subroutine add_mesh_data(this)
449  class(mesh2ddisvexporttype), intent(inout) :: this
450  integer(I4B), dimension(:), contiguous, pointer :: icell2d => null()
451  integer(I4B), dimension(:), contiguous, pointer :: ncvert => null()
452  integer(I4B), dimension(:), contiguous, pointer :: icvert => null()
453  real(DP), dimension(:), contiguous, pointer :: cell_x => null()
454  real(DP), dimension(:), contiguous, pointer :: cell_y => null()
455  real(DP), dimension(:), contiguous, pointer :: vert_x => null()
456  real(DP), dimension(:), contiguous, pointer :: vert_y => null()
457  integer(I4B) :: n, m, idx, cnt, iv, maxvert
458  integer(I4B), dimension(:), allocatable :: verts
459  real(DP), dimension(:), allocatable :: bnds
460  integer(I4B) :: istop
461  !
462  ! -- set pointers to input context
463  call mem_setptr(icell2d, 'ICELL2D', this%dis_mempath)
464  call mem_setptr(ncvert, 'NCVERT', this%dis_mempath)
465  call mem_setptr(icvert, 'ICVERT', this%dis_mempath)
466  call mem_setptr(cell_x, 'XC', this%dis_mempath)
467  call mem_setptr(cell_y, 'YC', this%dis_mempath)
468  call mem_setptr(vert_x, 'XV', this%dis_mempath)
469  call mem_setptr(vert_y, 'YV', this%dis_mempath)
470  !
471  ! -- initialize max vertices required to define cell
472  maxvert = maxval(ncvert)
473  !
474  ! -- set mesh container variable value to 1
475  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh, 1), &
476  this%nc_fname)
477  !
478  ! -- allocate temporary arrays
479  allocate (verts(maxvert))
480  allocate (bnds(maxvert))
481  !
482  ! -- write node_x and node_y arrays to netcdf file
483  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_node_x, &
484  vert_x + this%disv%xorigin), this%nc_fname)
485  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_node_y, &
486  vert_y + this%disv%yorigin), this%nc_fname)
487  !
488  ! -- write face_x and face_y arrays to netcdf file
489  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_x, &
490  cell_x + this%disv%xorigin), this%nc_fname)
491  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_y, &
492  cell_y + this%disv%yorigin), this%nc_fname)
493  !
494  ! -- set face nodes array
495  cnt = 0
496  do n = 1, size(ncvert)
497  verts = nf90_fill_int
498  idx = cnt + ncvert(n)
499  iv = 0
500  istop = cnt + 1
501  do m = idx, istop, -1
502  cnt = cnt + 1
503  iv = iv + 1
504  verts(iv) = icvert(m)
505  end do
506  !
507  ! -- write face nodes array to netcdf file
508  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_nodes, &
509  verts, start=(/1, n/), &
510  count=(/maxvert, 1/)), &
511  this%nc_fname)
512  !
513  ! -- set face y bounds array
514  bnds = nf90_fill_double
515  do m = 1, size(bnds)
516  if (verts(m) /= nf90_fill_int) then
517  bnds(m) = vert_y(verts(m))
518  end if
519  ! -- write face y bounds array to netcdf file
520  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_ybnds, &
521  bnds, start=(/1, n/), &
522  count=(/maxvert, 1/)), &
523  this%nc_fname)
524  end do
525  !
526  ! -- set face x bounds array
527  bnds = nf90_fill_double
528  do m = 1, size(bnds)
529  if (verts(m) /= nf90_fill_int) then
530  bnds(m) = vert_x(verts(m))
531  end if
532  ! -- write face x bounds array to netcdf file
533  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_xbnds, &
534  bnds, start=(/1, n/), &
535  count=(/maxvert, 1/)), &
536  this%nc_fname)
537  end do
538  end do
539  !
540  ! -- cleanup
541  deallocate (bnds)
542  deallocate (verts)
543  end subroutine add_mesh_data
544 
545  !> @brief netcdf export 1D integer array
546  !<
547  subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, &
548  pkgname, tagname, gridmap_name, shapestr, longname, &
549  nc_tag, deflate, shuffle, chunk_face, iper, nc_fname)
550  integer(I4B), intent(in) :: ncid
551  type(meshncdimidtype), intent(inout) :: dim_ids
552  type(meshncvaridtype), intent(inout) :: var_ids
553  type(disvtype), pointer, intent(in) :: dis
554  integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem
555  character(len=*), intent(in) :: nc_varname
556  character(len=*), intent(in) :: pkgname
557  character(len=*), intent(in) :: tagname
558  character(len=*), intent(in) :: gridmap_name
559  character(len=*), intent(in) :: shapestr
560  character(len=*), intent(in) :: longname
561  character(len=*), intent(in) :: nc_tag
562  integer(I4B), intent(in) :: deflate
563  integer(I4B), intent(in) :: shuffle
564  integer(I4B), intent(in) :: chunk_face
565  integer(I4B), intent(in) :: iper
566  character(len=*), intent(in) :: nc_fname
567  ! -- local
568  integer(I4B), dimension(2) :: dis_shape
569  integer(I4B), dimension(:, :), pointer, contiguous :: int2d
570  integer(I4B) :: axis_sz, nvals, k
571  integer(I4B), dimension(:), allocatable :: var_id
572  character(len=LINELENGTH) :: longname_l, varname_l
573  !
574  if (shapestr == 'NCPL') then
575  !
576  ! -- set names
577  varname_l = export_varname(nc_varname)
578  longname_l = export_longname(longname, pkgname, tagname, layer=0, iper=iper)
579  !
580  allocate (var_id(1))
581  axis_sz = dim_ids%nmesh_face
582  !
583  ! -- reenter define mode and create variable
584  call nf_verify(nf90_redef(ncid), nc_fname)
585  call nf_verify(nf90_def_var(ncid, varname_l, nf90_int, &
586  (/axis_sz/), var_id(1)), &
587  nc_fname)
588  !
589  ! -- apply chunking parameters
590  call ncvar_chunk(ncid, var_id(1), chunk_face, nc_fname)
591  ! -- deflate and shuffle
592  call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname)
593  !
594  ! -- put attr
595  call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', &
596  (/nf90_fill_int/)), nc_fname)
597  call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', &
598  longname_l), nc_fname)
599  !
600  ! -- add grid mapping and mf6 attr
601  call ncvar_gridmap(ncid, var_id(1), gridmap_name, nc_fname)
602  call ncvar_mf6attr(ncid, var_id(1), 0, iper, 0, nc_tag, nc_fname)
603  !
604  ! -- exit define mode and write data
605  call nf_verify(nf90_enddef(ncid), nc_fname)
606  call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), &
607  nc_fname)
608 
609  else
610  allocate (var_id(dis%nlay))
611  !
612  ! -- reenter define mode and create variable
613  call nf_verify(nf90_redef(ncid), nc_fname)
614  do k = 1, dis%nlay
615  !
616  ! -- set names
617  varname_l = export_varname(nc_varname, layer=k, iper=iper)
618  longname_l = export_longname(longname, pkgname, tagname, layer=k, &
619  iper=iper)
620  !
621  call nf_verify(nf90_def_var(ncid, varname_l, nf90_int, &
622  (/dim_ids%nmesh_face/), var_id(k)), &
623  nc_fname)
624  !
625  ! -- apply chunking parameters
626  call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname)
627  ! -- defalte and shuffle
628  call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname)
629  !
630  ! -- put attr
631  call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', &
632  (/nf90_fill_int/)), nc_fname)
633  call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', &
634  longname_l), nc_fname)
635  !
636  ! -- add grid mapping and mf6 attr
637  call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname)
638  call ncvar_mf6attr(ncid, var_id(k), k, iper, 0, nc_tag, nc_fname)
639  end do
640  !
641  ! -- reshape input
642  dis_shape(1) = dis%ncpl
643  dis_shape(2) = dis%nlay
644  nvals = product(dis_shape)
645  int2d(1:dis_shape(1), 1:dis_shape(2)) => p_mem(1:nvals)
646  !
647  ! -- exit define mode and write data
648  call nf_verify(nf90_enddef(ncid), nc_fname)
649  do k = 1, dis%nlay
650  call nf_verify(nf90_put_var(ncid, var_id(k), int2d(:, k)), nc_fname)
651  end do
652  !
653  ! -- cleanup
654  deallocate (var_id)
655  end if
656  end subroutine nc_export_int1d
657 
658  !> @brief netcdf export 2D integer array
659  !<
660  subroutine nc_export_int2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, &
661  pkgname, tagname, gridmap_name, shapestr, longname, &
662  nc_tag, deflate, shuffle, chunk_face, nc_fname)
663  integer(I4B), intent(in) :: ncid
664  type(meshncdimidtype), intent(inout) :: dim_ids
665  type(meshncvaridtype), intent(inout) :: var_ids
666  type(disvtype), pointer, intent(in) :: disv
667  integer(I4B), dimension(:, :), pointer, contiguous, intent(in) :: p_mem
668  character(len=*), intent(in) :: nc_varname
669  character(len=*), intent(in) :: pkgname
670  character(len=*), intent(in) :: tagname
671  character(len=*), intent(in) :: gridmap_name
672  character(len=*), intent(in) :: shapestr
673  character(len=*), intent(in) :: longname
674  character(len=*), intent(in) :: nc_tag
675  integer(I4B), intent(in) :: deflate
676  integer(I4B), intent(in) :: shuffle
677  integer(I4B), intent(in) :: chunk_face
678  character(len=*), intent(in) :: nc_fname
679  ! -- local
680  integer(I4B), dimension(:), allocatable :: var_id
681  character(len=LINELENGTH) :: longname_l, varname_l
682  integer(I4B) :: k
683  !
684  allocate (var_id(disv%nlay))
685  !
686  ! -- reenter define mode and create variable
687  call nf_verify(nf90_redef(ncid), nc_fname)
688  do k = 1, disv%nlay
689  !
690  ! -- set names
691  varname_l = export_varname(nc_varname, layer=k)
692  longname_l = export_longname(longname, pkgname, tagname, k)
693  !
694  call nf_verify(nf90_def_var(ncid, varname_l, nf90_int, &
695  (/dim_ids%nmesh_face/), var_id(k)), &
696  nc_fname)
697  !
698  ! -- apply chunking parameters
699  call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname)
700  ! -- deflate and shuffle
701  call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname)
702  !
703  ! -- put attr
704  call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', &
705  (/nf90_fill_int/)), nc_fname)
706  call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', &
707  longname_l), nc_fname)
708  !
709  ! -- add grid mapping and mf6 attr
710  call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname)
711  call ncvar_mf6attr(ncid, var_id(k), k, 0, 0, nc_tag, nc_fname)
712  end do
713  !
714  ! -- exit define mode and write data
715  call nf_verify(nf90_enddef(ncid), nc_fname)
716  do k = 1, disv%nlay
717  call nf_verify(nf90_put_var(ncid, var_id(k), p_mem(:, k)), nc_fname)
718  end do
719  !
720  deallocate (var_id)
721  end subroutine nc_export_int2d
722 
723  !> @brief netcdf export 1D double array
724  !<
725  subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, &
726  pkgname, tagname, gridmap_name, shapestr, longname, &
727  nc_tag, deflate, shuffle, chunk_face, nc_fname)
728  integer(I4B), intent(in) :: ncid
729  type(meshncdimidtype), intent(inout) :: dim_ids
730  type(meshncvaridtype), intent(inout) :: var_ids
731  type(disvtype), pointer, intent(in) :: dis
732  real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem
733  character(len=*), intent(in) :: nc_varname
734  character(len=*), intent(in) :: pkgname
735  character(len=*), intent(in) :: tagname
736  character(len=*), intent(in) :: gridmap_name
737  character(len=*), intent(in) :: shapestr
738  character(len=*), intent(in) :: longname
739  character(len=*), intent(in) :: nc_tag
740  integer(I4B), intent(in) :: deflate
741  integer(I4B), intent(in) :: shuffle
742  integer(I4B), intent(in) :: chunk_face
743  character(len=*), intent(in) :: nc_fname
744  ! -- local
745  integer(I4B), dimension(2) :: dis_shape
746  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
747  integer(I4B) :: axis_sz, nvals, k
748  integer(I4B), dimension(:), allocatable :: var_id
749  character(len=LINELENGTH) :: longname_l, varname_l
750  !
751  if (shapestr == 'NCPL') then
752  !
753  ! -- set names
754  varname_l = export_varname(nc_varname)
755  longname_l = export_longname(longname, pkgname, tagname, 0)
756  !
757  allocate (var_id(1))
758  axis_sz = dim_ids%nmesh_face
759  !
760  ! -- reenter define mode and create variable
761  call nf_verify(nf90_redef(ncid), nc_fname)
762  call nf_verify(nf90_def_var(ncid, varname_l, nf90_double, &
763  (/axis_sz/), var_id(1)), &
764  nc_fname)
765  !
766  ! -- apply chunking parameters
767  call ncvar_chunk(ncid, var_id(1), chunk_face, nc_fname)
768  ! -- deflate and shuffle
769  call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname)
770  !
771  ! -- put attr
772  call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', &
773  (/nf90_fill_double/)), nc_fname)
774  call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', &
775  longname_l), nc_fname)
776  !
777  ! -- add grid mapping and mf6 attr
778  call ncvar_gridmap(ncid, var_id(1), gridmap_name, nc_fname)
779  call ncvar_mf6attr(ncid, var_id(1), 0, 0, 0, nc_tag, nc_fname)
780  !
781  ! -- exit define mode and write data
782  call nf_verify(nf90_enddef(ncid), nc_fname)
783  call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), &
784  nc_fname)
785 
786  else
787  allocate (var_id(dis%nlay))
788  !
789  ! -- reenter define mode and create variable
790  call nf_verify(nf90_redef(ncid), nc_fname)
791  do k = 1, dis%nlay
792  !
793  ! -- set names
794  varname_l = export_varname(nc_varname, layer=k)
795  longname_l = export_longname(longname, pkgname, tagname, k)
796  !
797  call nf_verify(nf90_def_var(ncid, varname_l, nf90_double, &
798  (/dim_ids%nmesh_face/), var_id(k)), &
799  nc_fname)
800  !
801  ! -- apply chunking parameters
802  call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname)
803  ! -- deflate and shuffle
804  call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname)
805  !
806  ! -- put attr
807  call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', &
808  (/nf90_fill_double/)), nc_fname)
809  call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', &
810  longname_l), nc_fname)
811  !
812  ! -- add grid mapping and mf6 attr
813  call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname)
814  call ncvar_mf6attr(ncid, var_id(k), k, 0, 0, nc_tag, nc_fname)
815  end do
816  !
817  ! -- reshape input
818  dis_shape(1) = dis%ncpl
819  dis_shape(2) = dis%nlay
820  nvals = product(dis_shape)
821  dbl2d(1:dis_shape(1), 1:dis_shape(2)) => p_mem(1:nvals)
822  !
823  ! -- exit define mode and write data
824  call nf_verify(nf90_enddef(ncid), nc_fname)
825  do k = 1, dis%nlay
826  call nf_verify(nf90_put_var(ncid, var_id(k), dbl2d(:, k)), nc_fname)
827  end do
828  !
829  ! -- cleanup
830  deallocate (var_id)
831  end if
832  end subroutine nc_export_dbl1d
833 
834  !> @brief netcdf export 2D double array
835  !<
836  subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, &
837  pkgname, tagname, gridmap_name, shapestr, longname, &
838  nc_tag, deflate, shuffle, chunk_face, iper, iaux, &
839  nc_fname)
840  use constantsmodule, only: dnodata
841  integer(I4B), intent(in) :: ncid
842  type(meshncdimidtype), intent(inout) :: dim_ids
843  type(meshncvaridtype), intent(inout) :: var_ids
844  type(disvtype), pointer, intent(in) :: disv
845  real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem
846  character(len=*), intent(in) :: nc_varname
847  character(len=*), intent(in) :: pkgname
848  character(len=*), intent(in) :: tagname
849  character(len=*), intent(in) :: gridmap_name
850  character(len=*), intent(in) :: shapestr
851  character(len=*), intent(in) :: longname
852  character(len=*), intent(in) :: nc_tag
853  integer(I4B), intent(in) :: deflate
854  integer(I4B), intent(in) :: shuffle
855  integer(I4B), intent(in) :: chunk_face
856  integer(I4B), intent(in) :: iper
857  integer(I4B), intent(in) :: iaux
858  character(len=*), intent(in) :: nc_fname
859  ! -- local
860  integer(I4B), dimension(:), allocatable :: var_id
861  character(len=LINELENGTH) :: longname_l, varname_l
862  integer(I4B) :: k
863  real(DP) :: fill_value
864  !
865  if (iper > 0) then
866  fill_value = dnodata
867  else
868  fill_value = nf90_fill_double
869  end if
870  !
871  allocate (var_id(disv%nlay))
872  !
873  ! -- reenter define mode and create variable
874  call nf_verify(nf90_redef(ncid), nc_fname)
875  do k = 1, disv%nlay
876  !
877  ! -- set names
878  varname_l = export_varname(nc_varname, layer=k, iper=iper, iaux=iaux)
879  longname_l = export_longname(longname, pkgname, tagname, layer=k, iper=iper)
880  !
881  call nf_verify(nf90_def_var(ncid, varname_l, nf90_double, &
882  (/dim_ids%nmesh_face/), var_id(k)), &
883  nc_fname)
884  !
885  ! -- apply chunking parameters
886  call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname)
887  ! -- deflate and shuffle
888  call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname)
889  !
890  ! -- put attr
891  call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', &
892  (/fill_value/)), nc_fname)
893  call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', &
894  longname_l), nc_fname)
895  !
896  ! -- add grid mapping and mf6 attr
897  call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname)
898  call ncvar_mf6attr(ncid, var_id(k), k, iper, iaux, nc_tag, nc_fname)
899  end do
900  !
901  ! -- exit define mode and write data
902  call nf_verify(nf90_enddef(ncid), nc_fname)
903  do k = 1, disv%nlay
904  call nf_verify(nf90_put_var(ncid, var_id(k), p_mem(:, k)), nc_fname)
905  end do
906  !
907  deallocate (var_id)
908  end subroutine nc_export_dbl2d
909 
910 end module meshdisvmodelmodule
subroutine init()
Definition: GridSorting.f90:24
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
integer(i4b), parameter lencomponentname
maximum length of a component name
Definition: Constants.f90:18
@ mvalidate
validation mode - do not run time steps
Definition: Constants.f90:205
real(dp), parameter dnodata
real no data constant
Definition: Constants.f90:95
integer(i4b), parameter lenbigline
maximum length of a big line
Definition: Constants.f90:15
real(dp), parameter dhnoflo
real no flow constant
Definition: Constants.f90:93
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
This module contains the DefinitionSelectModule.
type(inputparamdefinitiontype) function, pointer, public get_param_definition_type(input_definition_types, component_type, subcomponent_type, blockname, tagname, filename)
Return parameter definition.
This module contains the InputDefinitionModule.
This module defines variable data types.
Definition: kind.f90:8
This module contains the MeshDisvModelModule.
Definition: DisvNCMesh.f90:8
subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer)
netcdf export package dynamic input with ilayer index variable
Definition: DisvNCMesh.f90:184
subroutine export_layer_2d(this, export_pkg, idt, ilayer_read, ialayer, dbl1d, nc_varname, input_attr, iaux)
export layer variable as full grid
Definition: DisvNCMesh.f90:294
subroutine add_mesh_data(this)
netcdf export add mesh information
Definition: DisvNCMesh.f90:449
subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, pkgname, tagname, gridmap_name, shapestr, longname, nc_tag, deflate, shuffle, chunk_face, nc_fname)
netcdf export 1D double array
Definition: DisvNCMesh.f90:728
subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, pkgname, tagname, gridmap_name, shapestr, longname, nc_tag, deflate, shuffle, chunk_face, iper, iaux, nc_fname)
netcdf export 2D double array
Definition: DisvNCMesh.f90:840
subroutine nc_export_int2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, pkgname, tagname, gridmap_name, shapestr, longname, nc_tag, deflate, shuffle, chunk_face, nc_fname)
netcdf export 2D integer array
Definition: DisvNCMesh.f90:663
subroutine package_step(this, export_pkg)
netcdf export package dynamic input
Definition: DisvNCMesh.f90:278
subroutine disv_export_init(this, modelname, modeltype, modelfname, disenum, nctype, iout)
netcdf export disv init
Definition: DisvNCMesh.f90:52
subroutine define_dim(this)
netcdf export define dimensions
Definition: DisvNCMesh.f90:404
subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, pkgname, tagname, gridmap_name, shapestr, longname, nc_tag, deflate, shuffle, chunk_face, iper, nc_fname)
netcdf export 1D integer array
Definition: DisvNCMesh.f90:550
subroutine df(this)
netcdf export define
Definition: DisvNCMesh.f90:86
subroutine step(this)
netcdf export step
Definition: DisvNCMesh.f90:114
subroutine disv_export_destroy(this)
netcdf export disv destroy
Definition: DisvNCMesh.f90:74
subroutine export_input_array(this, pkgtype, pkgname, mempath, idt)
netcdf export an input array
Definition: DisvNCMesh.f90:347
This module contains the MeshModelModule.
Definition: MeshNCModel.f90:7
character(len=linelength) function, public export_varname(varname, layer, iper, iaux)
build netcdf variable name
subroutine, public ncvar_gridmap(ncid, varid, gridmap_name, nc_fname)
put variable gridmap attributes
subroutine, public ncvar_chunk(ncid, varid, chunk_face, nc_fname)
define variable chunking
subroutine, public ncvar_deflate(ncid, varid, deflate, shuffle, nc_fname)
define variable compression
subroutine, public ncvar_mf6attr(ncid, varid, layer, iper, iaux, nc_tag, nc_fname)
put variable internal attributes
This module contains the NCModelExportModule.
Definition: NCModel.f90:8
character(len=linelength) function, public export_longname(longname, pkgname, tagname, layer, iper)
build netcdf variable longname
Definition: NCModel.f90:420
This module contains the NetCDFCommonModule.
Definition: NetCDFCommon.f90:6
subroutine, public nf_verify(res, nc_fname)
error check a netcdf-fortran interface call
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
Definition: Sim.f90:203
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
integer(i4b) isim_mode
simulation mode
real(dp), pointer, public totim
time relative to start of simulation
Definition: tdis.f90:32
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
Vertex grid discretization.
Definition: Disv.f90:24
type for storing model export dimension ids
Definition: MeshNCModel.f90:33
type for storing model export variable ids
Definition: MeshNCModel.f90:44