MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
DisNCMesh.f90
Go to the documentation of this file.
1 !> @brief This module contains the MeshDisModelModule
2 !!
3 !! This module defines UGRID layered mesh compliant netcdf
4 !! export type for DIS 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 dismodule, only: distype
23  use netcdfcommonmodule, only: nf_verify
24  use netcdf
25 
26  implicit none
27  private
28  public :: mesh2ddisexporttype
29 
30  ! UGRID layered mesh (ULM) DIS
32  type(distype), pointer :: dis => null() !< pointer to model dis package
33  integer(I4B) :: x_dim !< ncol dimension id
34  integer(I4B) :: y_dim !< nrow dimension id
35  contains
36  procedure :: init => dis_export_init
37  procedure :: destroy => dis_export_destroy
38  procedure :: df
39  procedure :: step
40  procedure :: export_input_array
41  procedure :: package_step
42  procedure :: define_dim
43  procedure :: add_mesh_data
44  end type mesh2ddisexporttype
45 
46 contains
47 
48  !> @brief netcdf export dis init
49  !<
50  subroutine dis_export_init(this, modelname, modeltype, modelfname, nc_fname, &
51  disenum, nctype, iout)
53  class(mesh2ddisexporttype), intent(inout) :: this
54  character(len=*), intent(in) :: modelname
55  character(len=*), intent(in) :: modeltype
56  character(len=*), intent(in) :: modelfname
57  character(len=*), intent(in) :: nc_fname
58  integer(I4B), intent(in) :: disenum
59  integer(I4B), intent(in) :: nctype
60  integer(I4B), intent(in) :: iout
61 
62  ! set nlay
63  this%nlay = this%dis%nlay
64 
65  ! allocate var_id arrays
66  allocate (this%var_ids%dependent(this%nlay))
67  allocate (this%var_ids%export(this%nlay))
68 
69  ! initialize base class
70  call this%mesh_init(modelname, modeltype, modelfname, nc_fname, disenum, &
71  nctype, this%dis%lenuni, iout)
72  end subroutine dis_export_init
73 
74  !> @brief netcdf export dis destroy
75  !<
76  subroutine dis_export_destroy(this)
77  class(mesh2ddisexporttype), intent(inout) :: this
78  deallocate (this%var_ids%dependent)
79  ! destroy base class
80  call this%mesh_destroy()
81  call this%NCModelExportType%destroy()
82  end subroutine dis_export_destroy
83 
84  !> @brief netcdf export define
85  !<
86  subroutine df(this)
87  use constantsmodule, only: mvalidate
88  use simvariablesmodule, only: isim_mode
89  class(mesh2ddisexporttype), intent(inout) :: this
90  ! put root group file scope attributes
91  call this%add_global_att()
92  ! define root group dimensions and coordinate variables
93  call this%define_dim()
94  ! define mesh variables
95  call this%create_mesh()
96  if (isim_mode /= mvalidate) then
97  ! define the dependent variable
98  call this%define_dependent()
99  end if
100  ! define period input arrays
101  call this%df_export()
102  ! exit define mode
103  call nf_verify(nf90_enddef(this%ncid), this%nc_fname)
104  ! create mesh
105  call this%add_mesh_data()
106  ! define and set package input griddata
107  call this%add_pkg_data()
108  ! define and set gridmap variable
109  call this%define_gridmap()
110  ! synchronize file
111  call nf_verify(nf90_sync(this%ncid), this%nc_fname)
112  end subroutine df
113 
114  !> @brief netcdf export step
115  !<
116  subroutine step(this)
117  use constantsmodule, only: dhnoflo
118  use tdismodule, only: totim
119  use netcdfcommonmodule, only: ixstp
120  class(mesh2ddisexporttype), intent(inout) :: this
121  real(DP), dimension(:), pointer, contiguous :: dbl1d
122  integer(I4B) :: n, k, nvals, istp
123  integer(I4B), dimension(2) :: dis_shape
124  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
125 
126  ! initialize
127  nullify (dbl1d)
128  nullify (dbl2d)
129 
130  ! set global step index
131  istp = ixstp()
132 
133  dis_shape(1) = this%dis%ncol * this%dis%nrow
134  dis_shape(2) = this%dis%nlay
135 
136  nvals = product(dis_shape)
137 
138  ! add data to dependent variable
139  if (size(this%dis%nodeuser) < &
140  size(this%dis%nodereduced)) then
141  ! allocate nodereduced size 1d array
142  allocate (dbl1d(size(this%dis%nodereduced)))
143 
144  ! initialize DHNOFLO for non-active cells
145  dbl1d = dhnoflo
146 
147  ! update active cells
148  do n = 1, size(this%dis%nodereduced)
149  if (this%dis%nodereduced(n) > 0) then
150  dbl1d(n) = this%x(this%dis%nodereduced(n))
151  end if
152  end do
153 
154  dbl2d(1:dis_shape(1), 1:dis_shape(2)) => dbl1d(1:nvals)
155  else
156  dbl2d(1:dis_shape(1), 1:dis_shape(2)) => this%x(1:nvals)
157  end if
158 
159  do k = 1, this%dis%nlay
160  ! extend array with step data
161  call nf_verify(nf90_put_var(this%ncid, &
162  this%var_ids%dependent(k), dbl2d(:, k), &
163  start=(/1, istp/), &
164  count=(/(this%dis%ncol * this%dis%nrow), 1/)), &
165  this%nc_fname)
166  end do
167 
168  ! write to time coordinate variable
169  call nf_verify(nf90_put_var(this%ncid, this%var_ids%time, &
170  totim, start=(/istp/)), &
171  this%nc_fname)
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
182  !<
183  subroutine package_step(this, export_pkg)
184  use tdismodule, only: kper
187  class(mesh2ddisexporttype), intent(inout) :: this
188  class(exportpackagetype), pointer, intent(in) :: export_pkg
189  type(inputparamdefinitiontype), pointer :: idt
190  integer(I4B), dimension(:), pointer, contiguous :: int1d
191  real(DP), dimension(:), pointer, contiguous :: dbl1d, nodes
192  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
193  character(len=LINELENGTH) :: nc_tag
194  integer(I4B) :: iaux, iparam, nvals
195  integer(I4B) :: k, n
196  integer(I4B), pointer :: nbound
197 
198  ! initialize
199  iaux = 0
200 
201  ! export defined period input
202  do iparam = 1, export_pkg%nparam
203  ! check if variable was read this period
204  if (export_pkg%param_reads(iparam)%invar < 1) cycle
205 
206  ! set input definition
207  idt => &
208  get_param_definition_type(export_pkg%mf6_input%param_dfns, &
209  export_pkg%mf6_input%component_type, &
210  export_pkg%mf6_input%subcomponent_type, &
211  'PERIOD', export_pkg%param_names(iparam), '')
212 
213  ! set variable input tag
214  nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, &
215  idt)
216 
217  ! export arrays
218  select case (idt%datatype)
219  case ('INTEGER1D')
220  call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath)
221  this%var_ids%export(1) = export_pkg%varids_param(iparam, 1)
222  call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%x_dim, &
223  this%y_dim, this%var_ids, this%dis, idt, &
224  export_pkg%mf6_input%mempath, nc_tag, &
225  export_pkg%mf6_input%subcomponent_name, &
226  this%gridmap_name, this%deflate, this%shuffle, &
227  this%chunk_face, kper, this%nc_fname)
228  case ('DOUBLE1D')
229  call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath)
230  select case (idt%shape)
231  case ('NCPL')
232  this%var_ids%export(1) = export_pkg%varids_param(iparam, 1)
233  call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, &
234  this%y_dim, this%var_ids, this%dis, idt, &
235  export_pkg%mf6_input%mempath, nc_tag, &
236  export_pkg%mf6_input%subcomponent_name, &
237  this%gridmap_name, this%deflate, this%shuffle, &
238  this%chunk_face, kper, iaux, this%nc_fname)
239  case ('NODES')
240  nvals = this%dis%nodesuser
241  allocate (nodes(nvals))
242  nodes = dnodata
243  do k = 1, this%dis%nlay
244  this%var_ids%export(k) = export_pkg%varids_param(iparam, k)
245  end do
246  call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath)
247  call mem_setptr(int1d, 'NODEULIST', export_pkg%mf6_input%mempath)
248  call mem_setptr(nbound, 'NBOUND', export_pkg%mf6_input%mempath)
249  do n = 1, nbound
250  nodes(int1d(n)) = dbl1d(n)
251  end do
252  call nc_export_dbl1d(nodes, this%ncid, this%dim_ids, this%x_dim, &
253  this%y_dim, this%var_ids, this%dis, idt, &
254  export_pkg%mf6_input%mempath, nc_tag, &
255  export_pkg%mf6_input%subcomponent_name, &
256  this%gridmap_name, this%deflate, this%shuffle, &
257  this%chunk_face, kper, iaux, this%nc_fname)
258  deallocate (nodes)
259  case default
260  end select
261  case ('DOUBLE2D')
262  call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath)
263  select case (idt%shape)
264  case ('NAUX NCPL')
265  nvals = this%dis%nrow * this%dis%ncol
266  allocate (nodes(nvals))
267  do iaux = 1, size(dbl2d, dim=1) !naux
268  this%var_ids%export(1) = export_pkg%varids_aux(iaux, 1)
269  do n = 1, nvals
270  nodes(n) = dbl2d(iaux, n)
271  end do
272  call nc_export_dbl1d(nodes, this%ncid, this%dim_ids, this%x_dim, &
273  this%y_dim, this%var_ids, this%dis, idt, &
274  export_pkg%mf6_input%mempath, nc_tag, &
275  export_pkg%mf6_input%subcomponent_name, &
276  this%gridmap_name, this%deflate, this%shuffle, &
277  this%chunk_face, kper, iaux, this%nc_fname)
278  end do
279  deallocate (nodes)
280  case ('NAUX NODES')
281  nvals = this%dis%nodesuser
282  allocate (nodes(nvals))
283  call mem_setptr(int1d, 'NODEULIST', export_pkg%mf6_input%mempath)
284  call mem_setptr(nbound, 'NBOUND', export_pkg%mf6_input%mempath)
285  do iaux = 1, size(dbl2d, dim=1) ! naux
286  nodes = dnodata
287  do k = 1, this%dis%nlay
288  this%var_ids%export(k) = export_pkg%varids_aux(iaux, k)
289  end do
290  do n = 1, nbound
291  nodes(int1d(n)) = dbl2d(iaux, n)
292  end do
293  call nc_export_dbl1d(nodes, this%ncid, this%dim_ids, this%x_dim, &
294  this%y_dim, this%var_ids, this%dis, idt, &
295  export_pkg%mf6_input%mempath, nc_tag, &
296  export_pkg%mf6_input%subcomponent_name, &
297  this%gridmap_name, this%deflate, this%shuffle, &
298  this%chunk_face, kper, iaux, this%nc_fname)
299 
300  end do
301  deallocate (nodes)
302  case default
303  end select
304  case default
305  ! no-op, no other datatypes exported
306  end select
307  end do
308 
309  ! synchronize file
310  call nf_verify(nf90_sync(this%ncid), this%nc_fname)
311  end subroutine package_step
312 
313  !> @brief netcdf export an input array
314  !<
315  subroutine export_input_array(this, pkgtype, pkgname, mempath, idt)
316  class(mesh2ddisexporttype), intent(inout) :: this
317  character(len=*), intent(in) :: pkgtype
318  character(len=*), intent(in) :: pkgname
319  character(len=*), intent(in) :: mempath
320  type(inputparamdefinitiontype), pointer, intent(in) :: idt
321  integer(I4B), dimension(:), pointer, contiguous :: int1d
322  integer(I4B), dimension(:, :), pointer, contiguous :: int2d
323  integer(I4B), dimension(:, :, :), pointer, contiguous :: int3d
324  real(DP), dimension(:), pointer, contiguous :: dbl1d
325  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
326  real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d
327  character(len=LINELENGTH) :: nc_tag
328  integer(I4B) :: iper, iaux
329 
330  iper = 0
331  iaux = 0
332 
333  ! set package input tag
334  nc_tag = this%input_attribute(pkgname, idt)
335 
336  select case (idt%datatype)
337  case ('INTEGER1D')
338  call mem_setptr(int1d, idt%mf6varname, mempath)
339  call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%x_dim, &
340  this%y_dim, this%var_ids, this%dis, idt, mempath, &
341  nc_tag, pkgname, this%gridmap_name, this%deflate, &
342  this%shuffle, this%chunk_face, iper, this%nc_fname)
343  case ('INTEGER2D')
344  call mem_setptr(int2d, idt%mf6varname, mempath)
345  call nc_export_int2d(int2d, this%ncid, this%dim_ids, this%var_ids, &
346  this%dis, idt, mempath, nc_tag, pkgname, &
347  this%gridmap_name, this%deflate, this%shuffle, &
348  this%chunk_face, this%nc_fname)
349  case ('INTEGER3D')
350  call mem_setptr(int3d, idt%mf6varname, mempath)
351  call nc_export_int3d(int3d, this%ncid, this%dim_ids, this%var_ids, &
352  this%dis, idt, mempath, nc_tag, pkgname, &
353  this%gridmap_name, this%deflate, this%shuffle, &
354  this%chunk_face, this%nc_fname)
355  case ('DOUBLE1D')
356  call mem_setptr(dbl1d, idt%mf6varname, mempath)
357  call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, &
358  this%y_dim, this%var_ids, this%dis, idt, mempath, &
359  nc_tag, pkgname, this%gridmap_name, this%deflate, &
360  this%shuffle, this%chunk_face, iper, iaux, &
361  this%nc_fname)
362  case ('DOUBLE2D')
363  call mem_setptr(dbl2d, idt%mf6varname, mempath)
364  call nc_export_dbl2d(dbl2d, this%ncid, this%dim_ids, this%var_ids, &
365  this%dis, idt, mempath, nc_tag, pkgname, &
366  this%gridmap_name, this%deflate, this%shuffle, &
367  this%chunk_face, this%nc_fname)
368  case ('DOUBLE3D')
369  call mem_setptr(dbl3d, idt%mf6varname, mempath)
370  call nc_export_dbl3d(dbl3d, this%ncid, this%dim_ids, this%var_ids, &
371  this%dis, idt, mempath, nc_tag, pkgname, &
372  this%gridmap_name, this%deflate, this%shuffle, &
373  this%chunk_face, this%nc_fname)
374  case default
375  ! no-op, no other datatypes exported
376  end select
377  end subroutine export_input_array
378 
379  !> @brief netcdf export define dimensions
380  !<
381  subroutine define_dim(this)
382  class(mesh2ddisexporttype), intent(inout) :: this
383 
384  ! time
385  call nf_verify(nf90_def_dim(this%ncid, 'time', this%totnstp, &
386  this%dim_ids%time), this%nc_fname)
387  call nf_verify(nf90_def_var(this%ncid, 'time', nf90_double, &
388  this%dim_ids%time, this%var_ids%time), &
389  this%nc_fname)
390  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'calendar', &
391  'standard'), this%nc_fname)
392  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'units', &
393  this%datetime), this%nc_fname)
394  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'axis', 'T'), &
395  this%nc_fname)
396  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'standard_name', &
397  'time'), this%nc_fname)
398  call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'long_name', &
399  'time'), this%nc_fname)
400 
401  ! mesh
402  call nf_verify(nf90_def_dim(this%ncid, 'nmesh_node', &
403  ((this%dis%ncol + 1) * (this%dis%nrow + 1)), &
404  this%dim_ids%nmesh_node), this%nc_fname)
405  call nf_verify(nf90_def_dim(this%ncid, 'nmesh_face', &
406  (this%dis%ncol * this%dis%nrow), &
407  this%dim_ids%nmesh_face), this%nc_fname)
408  call nf_verify(nf90_def_dim(this%ncid, 'max_nmesh_face_nodes', 4, &
409  this%dim_ids%max_nmesh_face_nodes), &
410  this%nc_fname)
411 
412  ! x, y
413  call nf_verify(nf90_def_dim(this%ncid, 'x', this%dis%ncol, &
414  this%x_dim), this%nc_fname)
415  call nf_verify(nf90_def_dim(this%ncid, 'y', this%dis%nrow, &
416  this%y_dim), this%nc_fname)
417  end subroutine define_dim
418 
419  !> @brief netcdf export add mesh information
420  !<
421  subroutine add_mesh_data(this)
423  class(mesh2ddisexporttype), intent(inout) :: this
424  integer(I4B) :: cnt, maxvert, m
425  integer(I4B), dimension(:), allocatable :: verts
426  real(DP), dimension(:), allocatable :: bnds
427  integer(I4B) :: i, j
428  real(DP) :: x, y, x_transform, y_transform
429  real(DP), dimension(:), allocatable :: node_x, node_y
430  real(DP), dimension(:), allocatable :: cell_x, cell_y
431 
432  ! initialize max vertices required to define cell
433  maxvert = 4
434 
435  ! set mesh container variable value to 1
436  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh, 1), &
437  this%nc_fname)
438 
439  ! allocate temporary arrays
440  allocate (verts(maxvert))
441  allocate (bnds(maxvert))
442  allocate (node_x(((this%dis%ncol + 1) * (this%dis%nrow + 1))))
443  allocate (node_y(((this%dis%ncol + 1) * (this%dis%nrow + 1))))
444  allocate (cell_x((this%dis%ncol * this%dis%nrow)))
445  allocate (cell_y((this%dis%ncol * this%dis%nrow)))
446 
447  ! set node_x and node_y arrays
448  cnt = 0
449  node_x = nf90_fill_double
450  node_y = nf90_fill_double
451  y = sum(this%dis%delc)
452  do j = this%dis%nrow, 0, -1
453  x = 0
454  do i = this%dis%ncol, 0, -1
455  cnt = cnt + 1
456  call dis_transform_xy(x, y, &
457  this%dis%xorigin, &
458  this%dis%yorigin, &
459  this%dis%angrot, &
460  x_transform, y_transform)
461  node_x(cnt) = x_transform
462  node_y(cnt) = y_transform
463  if (i > 0) x = x + this%dis%delr(i)
464  end do
465  if (j > 0) y = y - this%dis%delc(j)
466  end do
467 
468  ! write node_x and node_y arrays to netcdf file
469  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_node_x, node_x), &
470  this%nc_fname)
471  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_node_y, node_y), &
472  this%nc_fname)
473 
474  ! set cell_x and cell_y arrays
475  cnt = 1
476  cell_x = nf90_fill_double
477  cell_y = nf90_fill_double
478  do j = 1, this%dis%nrow
479  y = this%dis%celly(j)
480  do i = 1, this%dis%ncol
481  x = this%dis%cellx(i)
482  call dis_transform_xy(x, y, &
483  this%dis%xorigin, &
484  this%dis%yorigin, &
485  this%dis%angrot, &
486  x_transform, y_transform)
487  cell_x(cnt) = x_transform
488  cell_y(cnt) = y_transform
489  cnt = cnt + 1
490  end do
491  end do
492 
493  ! write face_x and face_y arrays to netcdf file
494  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_x, cell_x), &
495  this%nc_fname)
496  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_y, cell_y), &
497  this%nc_fname)
498 
499  ! set face nodes array
500  cnt = 0
501  do i = 1, this%dis%nrow
502  do j = 1, this%dis%ncol
503  cnt = cnt + 1
504  verts = nf90_fill_int
505  verts(1) = cnt + this%dis%ncol + i
506  verts(2) = cnt + this%dis%ncol + i + 1
507  if (i > 1) then
508  verts(3) = cnt + i
509  verts(4) = cnt + i - 1
510  else
511  verts(3) = cnt + 1
512  verts(4) = cnt
513  end if
514 
515  ! write face nodes array to netcdf file
516  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_nodes, &
517  verts, start=(/1, cnt/), &
518  count=(/maxvert, 1/)), &
519  this%nc_fname)
520 
521  ! set face y bounds array
522  bnds = nf90_fill_double
523  do m = 1, size(bnds)
524  if (verts(m) /= nf90_fill_int) then
525  bnds(m) = node_y(verts(m))
526  end if
527  ! write face y bounds array to netcdf file
528  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_ybnds, &
529  bnds, start=(/1, cnt/), &
530  count=(/maxvert, 1/)), &
531  this%nc_fname)
532  end do
533 
534  ! set face x bounds array
535  bnds = nf90_fill_double
536  do m = 1, size(bnds)
537  if (verts(m) /= nf90_fill_int) then
538  bnds(m) = node_x(verts(m))
539  end if
540  ! write face x bounds array to netcdf file
541  call nf_verify(nf90_put_var(this%ncid, this%var_ids%mesh_face_xbnds, &
542  bnds, start=(/1, cnt/), &
543  count=(/maxvert, 1/)), &
544  this%nc_fname)
545  end do
546  end do
547  end do
548 
549  ! cleanup
550  deallocate (bnds)
551  deallocate (verts)
552  deallocate (node_x)
553  deallocate (node_y)
554  deallocate (cell_x)
555  deallocate (cell_y)
556  end subroutine add_mesh_data
557 
558  !> @brief netcdf export 1D integer
559  !<
560  subroutine nc_export_int1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, &
561  idt, mempath, nc_tag, pkgname, gridmap_name, &
562  deflate, shuffle, chunk_face, iper, nc_fname)
563  use netcdfcommonmodule, only: ixstp
564  integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem
565  integer(I4B), intent(in) :: ncid
566  type(meshncdimidtype), intent(inout) :: dim_ids
567  integer(I4B), intent(in) :: x_dim
568  integer(I4B), intent(in) :: y_dim
569  type(meshncvaridtype), intent(inout) :: var_ids
570  type(distype), pointer, intent(in) :: dis
571  type(inputparamdefinitiontype), pointer :: idt
572  character(len=*), intent(in) :: mempath
573  character(len=*), intent(in) :: nc_tag
574  character(len=*), intent(in) :: pkgname
575  character(len=*), intent(in) :: gridmap_name
576  integer(I4B), intent(in) :: deflate
577  integer(I4B), intent(in) :: shuffle
578  integer(I4B), intent(in) :: chunk_face
579  integer(I4B), intent(in) :: iper
580  character(len=*), intent(in) :: nc_fname
581  integer(I4B), dimension(:, :, :), pointer, contiguous :: int3d
582  integer(I4B), dimension(:), pointer, contiguous :: int1d
583  integer(I4B) :: axis_dim, nvals, k, istp
584  integer(I4B), dimension(:), allocatable :: var_id
585  character(len=LINELENGTH) :: longname, varname
586 
587  if (idt%shape == 'NROW' .or. &
588  idt%shape == 'NCOL' .or. &
589  idt%shape == 'NCPL' .or. &
590  idt%shape == 'NAUX NCPL') then
591 
592  if (iper == 0) then
593 
594  select case (idt%shape)
595  case ('NROW')
596  axis_dim = y_dim
597  case ('NCOL')
598  axis_dim = x_dim
599  case ('NCPL', 'NAUX NCPL')
600  axis_dim = dim_ids%nmesh_face
601  end select
602 
603  ! set names
604  varname = export_varname(pkgname, idt%tagname, mempath)
605  longname = export_longname(idt%longname, pkgname, idt%tagname, mempath)
606 
607  allocate (var_id(1))
608 
609  ! reenter define mode and create variable
610  call nf_verify(nf90_redef(ncid), nc_fname)
611  call nf_verify(nf90_def_var(ncid, varname, nf90_int, &
612  (/axis_dim/), var_id(1)), &
613  nc_fname)
614 
615  ! NROW/NCOL shapes use default chunking
616  call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname)
617 
618  ! put attr
619  call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', &
620  (/nf90_fill_int/)), nc_fname)
621  call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', &
622  longname), nc_fname)
623 
624  ! add mf6 attr
625  call ncvar_mf6attr(ncid, var_id(1), 0, 0, nc_tag, nc_fname)
626 
627  ! exit define mode and write data
628  call nf_verify(nf90_enddef(ncid), nc_fname)
629  call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), &
630  nc_fname)
631  else
632  istp = ixstp()
633  nvals = dis%nrow * dis%ncol
634  call nf_verify(nf90_put_var(ncid, &
635  var_ids%export(1), p_mem, &
636  start=(/1, istp/), &
637  count=(/nvals, 1/)), nc_fname)
638  end if
639 
640  else
641  ! reshape input
642  int3d(1:dis%ncol, 1:dis%nrow, 1:dis%nlay) => p_mem(1:dis%nodesuser)
643 
644  ! set nvals as ncpl
645  nvals = dis%nrow * dis%ncol
646 
647  if (iper == 0) then
648  ! not a timeseries, create variables and write griddata
649  allocate (var_id(dis%nlay))
650 
651  ! reenter define mode and create variable
652  call nf_verify(nf90_redef(ncid), nc_fname)
653  do k = 1, dis%nlay
654  ! set names
655  varname = export_varname(pkgname, idt%tagname, mempath, &
656  layer=k)
657  longname = export_longname(idt%longname, pkgname, idt%tagname, &
658  mempath, layer=k)
659 
660  call nf_verify(nf90_def_var(ncid, varname, nf90_int, &
661  (/dim_ids%nmesh_face/), var_id(k)), &
662  nc_fname)
663 
664  ! apply chunking parameters
665  call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname)
666  ! deflate and shuffle
667  call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname)
668 
669  ! put attr
670  call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', &
671  (/nf90_fill_int/)), nc_fname)
672  call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', &
673  longname), nc_fname)
674 
675  ! add grid mapping and mf6 attr
676  call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname)
677  call ncvar_mf6attr(ncid, var_id(k), k, 0, nc_tag, nc_fname)
678  end do
679 
680  ! exit define mode and write data
681  call nf_verify(nf90_enddef(ncid), nc_fname)
682  do k = 1, dis%nlay
683  int1d(1:nvals) => int3d(:, :, k)
684  call nf_verify(nf90_put_var(ncid, var_id(k), int1d), nc_fname)
685  end do
686 
687  ! cleanup
688  deallocate (var_id)
689  else
690  ! timeseries, add period data
691  istp = ixstp()
692  do k = 1, dis%nlay
693  int1d(1:nvals) => int3d(:, :, k)
694  call nf_verify(nf90_put_var(ncid, &
695  var_ids%export(k), int1d, &
696  start=(/1, istp/), &
697  count=(/nvals, 1/)), nc_fname)
698  end do
699  end if
700  end if
701  end subroutine nc_export_int1d
702 
703  !> @brief netcdf export 2D integer
704  !<
705  subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, &
706  nc_tag, pkgname, gridmap_name, deflate, shuffle, &
707  chunk_face, nc_fname)
708  integer(I4B), dimension(:, :), pointer, contiguous, intent(in) :: p_mem
709  integer(I4B), intent(in) :: ncid
710  type(meshncdimidtype), intent(inout) :: dim_ids
711  type(meshncvaridtype), intent(inout) :: var_ids
712  type(distype), pointer, intent(in) :: dis
713  type(inputparamdefinitiontype), pointer :: idt
714  character(len=*), intent(in) :: mempath
715  character(len=*), intent(in) :: nc_tag
716  character(len=*), intent(in) :: pkgname
717  character(len=*), intent(in) :: gridmap_name
718  integer(I4B), intent(in) :: deflate
719  integer(I4B), intent(in) :: shuffle
720  integer(I4B), intent(in) :: chunk_face
721  character(len=*), intent(in) :: nc_fname
722  integer(I4B) :: var_id, nvals
723  integer(I4B), dimension(:), pointer, contiguous :: int1d
724  character(len=LINELENGTH) :: longname, varname
725 
726  ! set names
727  varname = export_varname(pkgname, idt%tagname, mempath)
728  longname = export_longname(idt%longname, pkgname, idt%tagname, mempath)
729 
730  ! reenter define mode and create variable
731  call nf_verify(nf90_redef(ncid), nc_fname)
732  call nf_verify(nf90_def_var(ncid, varname, nf90_int, &
733  (/dim_ids%nmesh_face/), var_id), &
734  nc_fname)
735 
736  ! apply chunking parameters
737  call ncvar_chunk(ncid, var_id, chunk_face, nc_fname)
738  ! deflate and shuffle
739  call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname)
740 
741  ! put attr
742  call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', &
743  (/nf90_fill_int/)), nc_fname)
744  call nf_verify(nf90_put_att(ncid, var_id, 'long_name', &
745  longname), nc_fname)
746 
747  ! add grid mapping and mf6 attr
748  call ncvar_gridmap(ncid, var_id, gridmap_name, nc_fname)
749  call ncvar_mf6attr(ncid, var_id, 0, 0, nc_tag, nc_fname)
750 
751  ! exit define mode and write data
752  call nf_verify(nf90_enddef(ncid), nc_fname)
753  nvals = dis%nrow * dis%ncol
754  int1d(1:nvals) => p_mem
755  call nf_verify(nf90_put_var(ncid, var_id, int1d), nc_fname)
756  end subroutine nc_export_int2d
757 
758  !> @brief netcdf export 3D integer
759  !<
760  subroutine nc_export_int3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, &
761  nc_tag, pkgname, gridmap_name, deflate, shuffle, &
762  chunk_face, nc_fname)
763  integer(I4B), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem
764  integer(I4B), intent(in) :: ncid
765  type(meshncdimidtype), intent(inout) :: dim_ids
766  type(meshncvaridtype), intent(inout) :: var_ids
767  type(distype), pointer, intent(in) :: dis
768  type(inputparamdefinitiontype), pointer :: idt
769  character(len=*), intent(in) :: mempath
770  character(len=*), intent(in) :: nc_tag
771  character(len=*), intent(in) :: pkgname
772  character(len=*), intent(in) :: gridmap_name
773  integer(I4B), intent(in) :: deflate
774  integer(I4B), intent(in) :: shuffle
775  integer(I4B), intent(in) :: chunk_face
776  character(len=*), intent(in) :: nc_fname
777  integer(I4B), dimension(:), allocatable :: var_id
778  integer(I4B), dimension(:), pointer, contiguous :: int1d
779  character(len=LINELENGTH) :: longname, varname
780  integer(I4B) :: k, nvals
781 
782  allocate (var_id(dis%nlay))
783 
784  ! reenter define mode and create variable
785  call nf_verify(nf90_redef(ncid), nc_fname)
786  do k = 1, dis%nlay
787  ! set names
788  varname = export_varname(pkgname, idt%tagname, mempath, layer=k)
789  longname = export_longname(idt%longname, pkgname, idt%tagname, &
790  mempath, layer=k)
791 
792  call nf_verify(nf90_def_var(ncid, varname, nf90_int, &
793  (/dim_ids%nmesh_face/), var_id(k)), &
794  nc_fname)
795 
796  ! apply chunking parameters
797  call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname)
798  ! deflate and shuffle
799  call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname)
800 
801  ! put attr
802  call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', &
803  (/nf90_fill_int/)), nc_fname)
804  call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', &
805  longname), nc_fname)
806 
807  ! add grid mapping and mf6 attr
808  call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname)
809  call ncvar_mf6attr(ncid, var_id(k), k, 0, nc_tag, nc_fname)
810  end do
811 
812  ! exit define mode and write data
813  call nf_verify(nf90_enddef(ncid), nc_fname)
814  nvals = dis%nrow * dis%ncol
815  do k = 1, dis%nlay
816  int1d(1:nvals) => p_mem(:, :, k)
817  call nf_verify(nf90_put_var(ncid, var_id(k), int1d), nc_fname)
818  end do
819 
820  ! cleanup
821  deallocate (var_id)
822  end subroutine nc_export_int3d
823 
824  !> @brief netcdf export 1D double
825  !<
826  subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, &
827  idt, mempath, nc_tag, pkgname, gridmap_name, &
828  deflate, shuffle, chunk_face, iper, iaux, nc_fname)
829  use netcdfcommonmodule, only: ixstp
830  real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem
831  integer(I4B), intent(in) :: ncid
832  type(meshncdimidtype), intent(inout) :: dim_ids
833  integer(I4B), intent(in) :: x_dim
834  integer(I4B), intent(in) :: y_dim
835  type(meshncvaridtype), intent(in) :: var_ids
836  type(distype), pointer, intent(in) :: dis
837  type(inputparamdefinitiontype), pointer :: idt
838  character(len=*), intent(in) :: mempath
839  character(len=*), intent(in) :: nc_tag
840  character(len=*), intent(in) :: pkgname
841  character(len=*), intent(in) :: gridmap_name
842  integer(I4B), intent(in) :: deflate
843  integer(I4B), intent(in) :: shuffle
844  integer(I4B), intent(in) :: chunk_face
845  integer(I4B), intent(in) :: iper
846  integer(I4B), intent(in) :: iaux
847  character(len=*), intent(in) :: nc_fname
848  real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d
849  real(DP), dimension(:), pointer, contiguous :: dbl1d
850  integer(I4B) :: axis_dim, nvals, k, istp
851  integer(NF90_INT), dimension(:), allocatable :: var_id
852  character(len=LINELENGTH) :: longname, varname
853 
854  if (idt%shape == 'NROW' .or. &
855  idt%shape == 'NCOL' .or. &
856  idt%shape == 'NCPL' .or. &
857  idt%shape == 'NAUX NCPL') then
858 
859  if (iper == 0) then
860 
861  select case (idt%shape)
862  case ('NROW')
863  axis_dim = y_dim
864  case ('NCOL')
865  axis_dim = x_dim
866  case ('NCPL', 'NAUX NCPL')
867  axis_dim = dim_ids%nmesh_face
868  end select
869 
870  ! set names
871  varname = export_varname(pkgname, idt%tagname, mempath, iaux=iaux)
872  longname = export_longname(idt%longname, pkgname, idt%tagname, &
873  mempath, iaux=iaux)
874 
875  allocate (var_id(1))
876 
877  ! reenter define mode and create variable
878  call nf_verify(nf90_redef(ncid), nc_fname)
879  call nf_verify(nf90_def_var(ncid, varname, nf90_double, &
880  (/axis_dim/), var_id(1)), &
881  nc_fname)
882 
883  ! NROW/NCOL shapes use default chunking
884  call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname)
885 
886  ! put attr
887  call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', &
888  (/nf90_fill_double/)), nc_fname)
889  call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', &
890  longname), nc_fname)
891 
892  ! add mf6 attr
893  call ncvar_mf6attr(ncid, var_id(1), 0, iaux, nc_tag, nc_fname)
894 
895  ! exit define mode and write data
896  call nf_verify(nf90_enddef(ncid), nc_fname)
897  call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), &
898  nc_fname)
899  else
900  istp = ixstp()
901  nvals = dis%nrow * dis%ncol
902  call nf_verify(nf90_put_var(ncid, &
903  var_ids%export(1), p_mem, &
904  start=(/1, istp/), &
905  count=(/nvals, 1/)), nc_fname)
906  end if
907 
908  else
909  ! reshape input
910  dbl3d(1:dis%ncol, 1:dis%nrow, 1:dis%nlay) => p_mem(1:dis%nodesuser)
911 
912  ! set nvals as ncpl
913  nvals = dis%nrow * dis%ncol
914 
915  if (iper == 0) then
916  ! not a timeseries, create variables and write griddata
917 
918  ! allocate local variable id storage
919  allocate (var_id(dis%nlay))
920 
921  ! reenter define mode and create layer variables
922  call nf_verify(nf90_redef(ncid), nc_fname)
923  do k = 1, dis%nlay
924  ! set names
925  varname = export_varname(pkgname, idt%tagname, mempath, layer=k, &
926  iaux=iaux)
927  longname = export_longname(idt%longname, pkgname, idt%tagname, &
928  mempath, layer=k, iaux=iaux)
929 
930  ! create layer variable
931  call nf_verify(nf90_def_var(ncid, varname, nf90_double, &
932  (/dim_ids%nmesh_face/), var_id(k)), &
933  nc_fname)
934 
935  ! apply chunking parameters
936  call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname)
937  ! deflate and shuffle
938  call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname)
939 
940  ! put attr
941  call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', &
942  (/nf90_fill_double/)), nc_fname)
943  call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', &
944  longname), nc_fname)
945 
946  ! add grid mapping and mf6 attr
947  call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname)
948  call ncvar_mf6attr(ncid, var_id(k), k, iaux, nc_tag, nc_fname)
949  end do
950 
951  ! exit define mode
952  call nf_verify(nf90_enddef(ncid), nc_fname)
953 
954  ! write layer data
955  do k = 1, dis%nlay
956  dbl1d(1:nvals) => dbl3d(:, :, k)
957  call nf_verify(nf90_put_var(ncid, var_id(k), dbl1d), nc_fname)
958  end do
959 
960  ! cleanup
961  deallocate (var_id)
962  else
963  ! timeseries, add period data
964  istp = ixstp()
965  do k = 1, dis%nlay
966  dbl1d(1:nvals) => dbl3d(:, :, k)
967  call nf_verify(nf90_put_var(ncid, &
968  var_ids%export(k), dbl1d, &
969  start=(/1, istp/), &
970  count=(/nvals, 1/)), nc_fname)
971  end do
972  end if
973  end if
974  end subroutine nc_export_dbl1d
975 
976  !> @brief netcdf export 2D double
977  !<
978  subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, &
979  nc_tag, pkgname, gridmap_name, deflate, shuffle, &
980  chunk_face, nc_fname)
981  real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem
982  integer(I4B), intent(in) :: ncid
983  type(meshncdimidtype), intent(inout) :: dim_ids
984  type(meshncvaridtype), intent(inout) :: var_ids
985  type(distype), pointer, intent(in) :: dis
986  type(inputparamdefinitiontype), pointer :: idt
987  character(len=*), intent(in) :: mempath
988  character(len=*), intent(in) :: nc_tag
989  character(len=*), intent(in) :: pkgname
990  character(len=*), intent(in) :: gridmap_name
991  integer(I4B), intent(in) :: deflate
992  integer(I4B), intent(in) :: shuffle
993  integer(I4B), intent(in) :: chunk_face
994  character(len=*), intent(in) :: nc_fname
995  integer(I4B) :: var_id, nvals
996  character(len=LINELENGTH) :: longname, varname
997  real(DP), dimension(:), pointer, contiguous :: dbl1d
998 
999  ! set names
1000  varname = export_varname(pkgname, idt%tagname, mempath)
1001  longname = export_longname(idt%longname, pkgname, idt%tagname, mempath)
1002 
1003  ! reenter define mode and create variable
1004  call nf_verify(nf90_redef(ncid), nc_fname)
1005  call nf_verify(nf90_def_var(ncid, varname, nf90_double, &
1006  (/dim_ids%nmesh_face/), var_id), &
1007  nc_fname)
1008 
1009  ! apply chunking parameters
1010  call ncvar_chunk(ncid, var_id, chunk_face, nc_fname)
1011  ! deflate and shuffle
1012  call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname)
1013 
1014  ! put attr
1015  call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', &
1016  (/nf90_fill_double/)), nc_fname)
1017  call nf_verify(nf90_put_att(ncid, var_id, 'long_name', &
1018  longname), nc_fname)
1019 
1020  ! add grid mapping and mf6 attr
1021  call ncvar_gridmap(ncid, var_id, gridmap_name, nc_fname)
1022  call ncvar_mf6attr(ncid, var_id, 0, 0, nc_tag, nc_fname)
1023 
1024  ! exit define mode and write data
1025  call nf_verify(nf90_enddef(ncid), nc_fname)
1026  nvals = dis%nrow * dis%ncol
1027  dbl1d(1:nvals) => p_mem
1028  call nf_verify(nf90_put_var(ncid, var_id, dbl1d), nc_fname)
1029  end subroutine nc_export_dbl2d
1030 
1031  !> @brief netcdf export 3D double
1032  !<
1033  subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, &
1034  nc_tag, pkgname, gridmap_name, deflate, shuffle, &
1035  chunk_face, nc_fname)
1036  real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem
1037  integer(I4B), intent(in) :: ncid
1038  type(meshncdimidtype), intent(inout) :: dim_ids
1039  type(meshncvaridtype), intent(inout) :: var_ids
1040  type(distype), pointer, intent(in) :: dis
1041  type(inputparamdefinitiontype), pointer :: idt
1042  character(len=*), intent(in) :: mempath
1043  character(len=*), intent(in) :: nc_tag
1044  character(len=*), intent(in) :: pkgname
1045  character(len=*), intent(in) :: gridmap_name
1046  integer(I4B), intent(in) :: deflate
1047  integer(I4B), intent(in) :: shuffle
1048  integer(I4B), intent(in) :: chunk_face
1049  character(len=*), intent(in) :: nc_fname
1050  integer(I4B), dimension(:), allocatable :: var_id
1051  real(DP), dimension(:), pointer, contiguous :: dbl1d
1052  character(len=LINELENGTH) :: longname, varname
1053  integer(I4B) :: k, nvals
1054 
1055  ! set nvals as ncpl
1056  nvals = dis%nrow * dis%ncol
1057 
1058  allocate (var_id(dis%nlay))
1059 
1060  ! reenter define mode and create variable
1061  call nf_verify(nf90_redef(ncid), nc_fname)
1062  do k = 1, dis%nlay
1063  ! set names
1064  varname = export_varname(pkgname, idt%tagname, mempath, layer=k)
1065  longname = export_longname(idt%longname, pkgname, idt%tagname, &
1066  mempath, layer=k)
1067 
1068  call nf_verify(nf90_def_var(ncid, varname, nf90_double, &
1069  (/dim_ids%nmesh_face/), var_id(k)), &
1070  nc_fname)
1071 
1072  ! apply chunking parameters
1073  call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname)
1074  ! deflate and shuffle
1075  call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname)
1076 
1077  ! put attr
1078  call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', &
1079  (/nf90_fill_double/)), nc_fname)
1080  call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', &
1081  longname), nc_fname)
1082 
1083  ! add grid mapping and mf6 attr
1084  call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname)
1085  call ncvar_mf6attr(ncid, var_id(k), k, 0, nc_tag, nc_fname)
1086  end do
1087 
1088  ! exit define mode and write data
1089  call nf_verify(nf90_enddef(ncid), nc_fname)
1090  do k = 1, dis%nlay
1091  dbl1d(1:nvals) => p_mem(:, :, k)
1092  call nf_verify(nf90_put_var(ncid, var_id(k), dbl1d), nc_fname)
1093  end do
1094 
1095  ! cleanup
1096  deallocate (var_id)
1097  end subroutine nc_export_dbl3d
1098 
1099 end module meshdismodelmodule
subroutine init()
Definition: GridSorting.f90:24
subroutine, public dis_transform_xy(x, y, xorigin, yorigin, angrot, xglo, yglo)
Get global (x, y) coordinates from cell-local coordinates.
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.
Definition: Dis.f90:1
This module contains the InputDefinitionModule.
This module defines variable data types.
Definition: kind.f90:8
This module contains the MeshDisModelModule.
Definition: DisNCMesh.f90:8
subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, nc_tag, pkgname, gridmap_name, deflate, shuffle, chunk_face, nc_fname)
netcdf export 2D double
Definition: DisNCMesh.f90:981
subroutine nc_export_int1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, idt, mempath, nc_tag, pkgname, gridmap_name, deflate, shuffle, chunk_face, iper, nc_fname)
netcdf export 1D integer
Definition: DisNCMesh.f90:563
subroutine define_dim(this)
netcdf export define dimensions
Definition: DisNCMesh.f90:382
subroutine add_mesh_data(this)
netcdf export add mesh information
Definition: DisNCMesh.f90:422
subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, nc_tag, pkgname, gridmap_name, deflate, shuffle, chunk_face, nc_fname)
netcdf export 3D double
Definition: DisNCMesh.f90:1036
subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, nc_tag, pkgname, gridmap_name, deflate, shuffle, chunk_face, nc_fname)
netcdf export 2D integer
Definition: DisNCMesh.f90:708
subroutine dis_export_init(this, modelname, modeltype, modelfname, nc_fname, disenum, nctype, iout)
netcdf export dis init
Definition: DisNCMesh.f90:52
subroutine step(this)
netcdf export step
Definition: DisNCMesh.f90:117
subroutine package_step(this, export_pkg)
netcdf export package dynamic input
Definition: DisNCMesh.f90:184
subroutine dis_export_destroy(this)
netcdf export dis destroy
Definition: DisNCMesh.f90:77
subroutine nc_export_int3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, nc_tag, pkgname, gridmap_name, deflate, shuffle, chunk_face, nc_fname)
netcdf export 3D integer
Definition: DisNCMesh.f90:763
subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, idt, mempath, nc_tag, pkgname, gridmap_name, deflate, shuffle, chunk_face, iper, iaux, nc_fname)
netcdf export 1D double
Definition: DisNCMesh.f90:829
subroutine export_input_array(this, pkgtype, pkgname, mempath, idt)
netcdf export an input array
Definition: DisNCMesh.f90:316
subroutine df(this)
netcdf export define
Definition: DisNCMesh.f90:87
This module contains the MeshModelModule.
Definition: MeshNCModel.f90:7
subroutine, public ncvar_mf6attr(ncid, varid, layer, iaux, nc_tag, nc_fname)
put variable internal attributes
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
This module contains the NCModelExportModule.
Definition: NCModel.f90:8
character(len=linelength) function, public export_varname(pkgname, tagname, mempath, layer, iaux)
build netcdf variable name
Definition: NCModel.f90:435
character(len=linelength) function, public export_longname(longname, pkgname, tagname, mempath, layer, iaux)
build netcdf variable longname
Definition: NCModel.f90:476
This module contains the NetCDFCommonModule.
Definition: NetCDFCommon.f90:6
integer(i4b) function, public ixstp()
step index for timeseries data
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
Structured grid discretization.
Definition: Dis.f90:23
type for storing model export dimension ids
Definition: MeshNCModel.f90:33
type for storing model export variable ids
Definition: MeshNCModel.f90:43