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