MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
MeshNCModel.f90
Go to the documentation of this file.
1 !> @brief This module contains the MeshModelModule
2 !!
3 !! This module defines a base class for UGRID based
4 !! (mesh) model netcdf exports. It is dependent on
5 !! external netcdf libraries.
6 !<
8 
9  use kindmodule, only: dp, i4b, lgp
19  use netcdfcommonmodule, only: nf_verify
20  use netcdf
21 
22  implicit none
23  private
25  public :: mesh2dmodeltype
26  public :: ncvar_chunk
27  public :: ncvar_deflate
28  public :: ncvar_gridmap
29  public :: ncvar_mf6attr
30 
31  !> @brief type for storing model export dimension ids
32  !<
34  integer(I4B) :: nmesh_node !< number of nodes in mesh
35  integer(I4B) :: nmesh_face !< number of faces in mesh
36  integer(I4B) :: max_nmesh_face_nodes !< max number of nodes in a single face
37  integer(I4B) :: time !< number of steps
38  contains
39  end type meshncdimidtype
40 
41  !> @brief type for storing model export variable ids
42  !<
44  integer(I4B) :: mesh !< mesh container variable
45  integer(I4B) :: mesh_node_x !< mesh nodes x array
46  integer(I4B) :: mesh_node_y !< mesh nodes y array
47  integer(I4B) :: mesh_face_x !< mesh faces x location array
48  integer(I4B) :: mesh_face_y !< mesh faces y location array
49  integer(I4B) :: mesh_face_xbnds !< mesh faces 2D x bounds array
50  integer(I4B) :: mesh_face_ybnds !< mesh faces 2D y bounds array
51  integer(I4B) :: mesh_face_nodes !< mesh faces 2D nodes array
52  integer(I4B) :: time !< time coordinate variable
53  integer(I4B), dimension(:), allocatable :: export !< in scope layer export
54  integer(I4B), dimension(:), allocatable :: dependent !< layered dependent variables array
55  contains
56  end type meshncvaridtype
57 
58  !> @brief base ugrid netcdf export type
59  !<
60  type, abstract, extends(ncbasemodelexporttype) :: meshmodeltype
61  type(meshncdimidtype) :: dim_ids !< dimension ids
62  type(meshncvaridtype) :: var_ids !< variable ids
63  integer(I4B) :: nlay !< number of layers
64  integer(I4B), pointer :: chunk_face !< chunking parameter for face dimension
65  contains
66  procedure :: mesh_init
67  procedure :: mesh_destroy
68  procedure :: df_export
69  procedure :: export_df
70  procedure :: create_timeseries
71  procedure :: add_global_att
72  procedure(nc_array_export_if), deferred :: export_input_array
73  procedure :: export_input_arrays
74  procedure :: add_pkg_data
75  procedure :: define_dependent
76  procedure :: define_gridmap
77  end type meshmodeltype
78 
79  !> @brief abstract interfaces for derived ugrid netcd export types
80  !<
81  abstract interface
82  subroutine nc_array_export_if(this, pkgtype, pkgname, mempath, idt)
84  class(meshmodeltype), intent(inout) :: this
85  character(len=*), intent(in) :: pkgtype
86  character(len=*), intent(in) :: pkgname
87  character(len=*), intent(in) :: mempath
88  type(inputparamdefinitiontype), pointer, intent(in) :: idt
89  end subroutine
90  end interface
91 
92  type, abstract, extends(meshmodeltype) :: mesh2dmodeltype
93  contains
94  procedure :: create_mesh
95  end type mesh2dmodeltype
96 
97 contains
98 
99  !> @brief initialize
100  !<
101  subroutine mesh_init(this, modelname, modeltype, modelfname, nc_fname, &
102  disenum, nctype, lenuni, iout)
104  class(meshmodeltype), intent(inout) :: this
105  character(len=*), intent(in) :: modelname
106  character(len=*), intent(in) :: modeltype
107  character(len=*), intent(in) :: modelfname
108  character(len=*), intent(in) :: nc_fname
109  integer(I4B), intent(in) :: disenum
110  integer(I4B), intent(in) :: nctype
111  integer(I4B), intent(in) :: lenuni
112  integer(I4B), intent(in) :: iout
113  logical(LGP) :: found
114 
115  ! initialize base class
116  call this%NCModelExportType%init(modelname, modeltype, modelfname, nc_fname, &
117  disenum, nctype, iout)
118 
119  ! allocate and initialize
120  allocate (this%chunk_face)
121  this%chunk_face = -1
122 
123  ! update values from input context
124  if (this%ncf_mempath /= '') then
125  call mem_set_value(this%chunk_face, 'CHUNK_FACE', this%ncf_mempath, found)
126  end if
127 
128  if (this%chunk_time > 0 .and. this%chunk_face > 0) then
129  this%chunking_active = .true.
130  else if (this%chunk_time > 0 .or. this%chunk_face > 0) then
131  this%chunk_face = -1
132  this%chunk_time = -1
133  write (warnmsg, '(a)') 'Ignoring user provided NetCDF chunking parameter. &
134  &Define chunk_time and chunk_face input parameters to see an effect in &
135  &file "'//trim(nc_fname)//'".'
136  call store_warning(warnmsg)
137  end if
138 
139  if (lenuni == 1) then
140  this%lenunits = 'ft'
141  else
142  this%lenunits = 'm'
143  end if
144 
145  ! create the netcdf file
146  call nf_verify(nf90_create(this%nc_fname, &
147  ior(nf90_clobber, nf90_netcdf4), this%ncid), &
148  this%nc_fname)
149  end subroutine mesh_init
150 
151  !> @brief initialize
152  !<
153  subroutine mesh_destroy(this)
155  class(meshmodeltype), intent(inout) :: this
156  call nf_verify(nf90_close(this%ncid), this%nc_fname)
157  deallocate (this%chunk_face)
158  nullify (this%chunk_face)
159  end subroutine mesh_destroy
160 
161  !> @brief define timeseries input variables
162  !<
163  subroutine df_export(this)
165  class(meshmodeltype), intent(inout) :: this
166  class(exportpackagetype), pointer :: export_pkg
167  integer(I4B) :: idx
168  do idx = 1, this%pkglist%Count()
169  export_pkg => this%get(idx)
170  call this%export_df(export_pkg)
171  end do
172  end subroutine df_export
173 
174  !> @brief define export package
175  !<
176  subroutine export_df(this, export_pkg)
179  class(meshmodeltype), intent(inout) :: this
180  class(exportpackagetype), pointer, intent(in) :: export_pkg
181  type(inputparamdefinitiontype), pointer :: idt
182  integer(I4B) :: iparam, iaux, layer
183 
184  ! export defined period input
185  do iparam = 1, export_pkg%nparam
186  ! initialize
187  iaux = 0
188  layer = 0
189  ! set input definition
190  idt => &
191  get_param_definition_type(export_pkg%mf6_input%param_dfns, &
192  export_pkg%mf6_input%component_type, &
193  export_pkg%mf6_input%subcomponent_type, &
194  'PERIOD', export_pkg%param_names(iparam), '')
195 
196  select case (idt%shape)
197  case ('NCPL')
198  call this%create_timeseries(idt, iparam, iaux, layer, export_pkg)
199  case ('NODES')
200  do layer = 1, this%nlay
201  call this%create_timeseries(idt, iparam, iaux, layer, export_pkg)
202  end do
203  case ('NAUX NCPL')
204  do iaux = 1, export_pkg%naux
205  call this%create_timeseries(idt, iparam, iaux, layer, export_pkg)
206  end do
207  case ('NAUX NODES')
208  do iaux = 1, export_pkg%naux
209  do layer = 1, this%nlay
210  call this%create_timeseries(idt, iparam, iaux, layer, export_pkg)
211  end do
212  end do
213  case default
214  end select
215  end do
216  end subroutine export_df
217 
218  !> @brief create timeseries export variable
219  !<
220  subroutine create_timeseries(this, idt, iparam, iaux, layer, export_pkg)
221  use constantsmodule, only: dnodata
223  class(meshmodeltype), intent(inout) :: this
224  type(inputparamdefinitiontype), pointer, intent(in) :: idt
225  integer(I4B), intent(in) :: iparam
226  integer(I4B), intent(in) :: iaux
227  integer(I4B), intent(in) :: layer
228  class(exportpackagetype), pointer, intent(in) :: export_pkg
229  character(len=LINELENGTH) :: varname, longname, nc_tag
230  integer(I4B) :: varid
231 
232  ! set variable input tag
233  nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, &
234  idt)
235 
236  ! set names
237  varname = export_varname(export_pkg%mf6_input%subcomponent_name, &
238  idt%tagname, export_pkg%mf6_input%mempath, &
239  layer=layer, iaux=iaux)
240  longname = export_longname(idt%longname, &
241  export_pkg%mf6_input%subcomponent_name, &
242  idt%tagname, export_pkg%mf6_input%mempath, &
243  layer=layer, iaux=iaux)
244 
245  ! create the netcdf dependent layer variable
246  select case (idt%datatype)
247  case ('DOUBLE1D', 'DOUBLE2D')
248  call nf_verify(nf90_def_var(this%ncid, varname, nf90_double, &
249  (/this%dim_ids%nmesh_face, &
250  this%dim_ids%time/), &
251  varid), &
252  this%nc_fname)
253  call nf_verify(nf90_put_att(this%ncid, varid, &
254  '_FillValue', (/dnodata/)), &
255  this%nc_fname)
256  case ('INTEGER1D')
257  call nf_verify(nf90_def_var(this%ncid, varname, nf90_int, &
258  (/this%dim_ids%nmesh_face, &
259  this%dim_ids%time/), &
260  varid), &
261  this%nc_fname)
262  call nf_verify(nf90_put_att(this%ncid, varid, &
263  '_FillValue', (/nf90_fill_int/)), &
264  this%nc_fname)
265  end select
266 
267  ! apply chunking parameters
268  if (this%chunking_active) then
269  call nf_verify(nf90_def_var_chunking(this%ncid, &
270  varid, &
271  nf90_chunked, &
272  (/this%chunk_face, &
273  this%chunk_time/)), &
274  this%nc_fname)
275  end if
276 
277  ! deflate and shuffle
278  call ncvar_deflate(this%ncid, varid, this%deflate, &
279  this%shuffle, this%nc_fname)
280 
281  ! assign variable attributes
282  call nf_verify(nf90_put_att(this%ncid, varid, &
283  'units', this%lenunits), this%nc_fname)
284  call nf_verify(nf90_put_att(this%ncid, varid, &
285  'long_name', longname), this%nc_fname)
286  call nf_verify(nf90_put_att(this%ncid, varid, &
287  'mesh', this%mesh_name), this%nc_fname)
288  call nf_verify(nf90_put_att(this%ncid, varid, &
289  'location', 'face'), this%nc_fname)
290 
291  ! add grid mapping and mf6 attr
292  call ncvar_gridmap(this%ncid, varid, &
293  this%gridmap_name, this%nc_fname)
294  call ncvar_mf6attr(this%ncid, varid, layer, iaux, nc_tag, this%nc_fname)
295 
296  ! store variable id
297  if (idt%tagname == 'AUX') then
298  if (layer > 0) then
299  export_pkg%varids_aux(iaux, layer) = varid
300  else
301  export_pkg%varids_aux(iaux, 1) = varid
302  end if
303  else
304  if (layer > 0) then
305  export_pkg%varids_param(iparam, layer) = varid
306  else
307  export_pkg%varids_param(iparam, 1) = varid
308  end if
309  end if
310  end subroutine create_timeseries
311 
312  !> @brief create file (group) attributes
313  !<
314  subroutine add_global_att(this)
315  class(meshmodeltype), intent(inout) :: this
316  ! file scoped title
317  call nf_verify(nf90_put_att(this%ncid, nf90_global, 'title', &
318  this%annotation%title), this%nc_fname)
319  ! source (MODFLOW 6)
320  call nf_verify(nf90_put_att(this%ncid, nf90_global, 'source', &
321  this%annotation%source), this%nc_fname)
322  ! grid type (MODFLOW 6)
323  call nf_verify(nf90_put_att(this%ncid, nf90_global, 'modflow_grid', &
324  this%annotation%grid), this%nc_fname)
325  ! mesh type (MODFLOW 6)
326  if (this%annotation%mesh /= '') then
327  call nf_verify(nf90_put_att(this%ncid, nf90_global, 'mesh', &
328  this%annotation%mesh), this%nc_fname)
329 
330  end if
331  ! MODFLOW 6 model type
332  call nf_verify(nf90_put_att(this%ncid, nf90_global, 'modflow_model', &
333  this%annotation%model), this%nc_fname)
334  ! generation datetime
335  call nf_verify(nf90_put_att(this%ncid, nf90_global, 'history', &
336  this%annotation%history), this%nc_fname)
337  ! supported conventions
338  call nf_verify(nf90_put_att(this%ncid, nf90_global, 'Conventions', &
339  this%annotation%conventions), &
340  this%nc_fname)
341  end subroutine add_global_att
342 
343  !> @brief write package gridded input data
344  !<
345  subroutine export_input_arrays(this, pkgtype, pkgname, mempath, param_dfns)
346  use memorymanagermodule, only: get_isize
347  class(meshmodeltype), intent(inout) :: this
348  character(len=*), intent(in) :: pkgtype
349  character(len=*), intent(in) :: pkgname
350  character(len=*), intent(in) :: mempath
351  type(inputparamdefinitiontype), dimension(:), pointer, &
352  intent(in) :: param_dfns
353  type(inputparamdefinitiontype), pointer :: idt
354  integer(I4B) :: iparam, isize
355  ! export griddata block parameters
356  do iparam = 1, size(param_dfns)
357  ! assign param definition pointer
358  idt => param_dfns(iparam)
359  ! for now only griddata is exported
360  if (idt%blockname == 'GRIDDATA') then
361  ! veriy variable is allocated
362  call get_isize(idt%mf6varname, mempath, isize)
363  if (isize > 0) then
364  call this%export_input_array(pkgtype, pkgname, mempath, idt)
365  end if
366  end if
367  end do
368  end subroutine export_input_arrays
369 
370  !> @brief determine packages to write gridded input
371  !<
372  subroutine add_pkg_data(this)
379  class(meshmodeltype), intent(inout) :: this
380  character(LENCOMPONENTNAME) :: ptype, pname, pkgtype
381  character(len=LENMEMPATH) :: input_mempath
382  type(characterstringtype), dimension(:), contiguous, &
383  pointer :: pkgtypes => null()
384  type(characterstringtype), dimension(:), contiguous, &
385  pointer :: pkgnames => null()
386  type(characterstringtype), dimension(:), contiguous, &
387  pointer :: mempaths => null()
388  type(inputparamdefinitiontype), dimension(:), pointer :: param_dfns
389  character(len=LENMEMPATH) :: mempath
390  integer(I4B) :: n
391  integer(I4B), pointer :: export_arrays
392  logical(LGP) :: found
393 
394  input_mempath = create_mem_path(component=this%modelname, context=idm_context)
395 
396  ! set pointers to model path package info
397  call mem_setptr(pkgtypes, 'PKGTYPES', input_mempath)
398  call mem_setptr(pkgnames, 'PKGNAMES', input_mempath)
399  call mem_setptr(mempaths, 'MEMPATHS', input_mempath)
400 
401  allocate (export_arrays)
402 
403  do n = 1, size(mempaths)
404  ! initialize export_arrays
405  export_arrays = 0
406 
407  ! set package attributes
408  mempath = mempaths(n)
409  pname = pkgnames(n)
410  ptype = pkgtypes(n)
411 
412  ! export input arrays
413  if (mempath /= '') then
414  ! update export
415  call mem_set_value(export_arrays, 'EXPORT_NC', mempath, found)
416  if (export_arrays > 0) then
417  pkgtype = idm_subcomponent_type(this%modeltype, ptype)
418  param_dfns => param_definitions(this%modeltype, pkgtype)
419  call this%export_input_arrays(ptype, pname, mempath, param_dfns)
420  end if
421  end if
422  end do
423 
424  ! cleanup
425  deallocate (export_arrays)
426  end subroutine add_pkg_data
427 
428  !> @brief create the model layer dependent variables
429  !<
430  subroutine define_dependent(this)
431  class(meshmodeltype), intent(inout) :: this
432  character(len=LINELENGTH) :: varname, longname
433  integer(I4B) :: k
434 
435  ! create a dependent variable for each layer
436  do k = 1, this%nlay
437  ! initialize names
438  varname = ''
439  longname = ''
440 
441  ! set layer variable and longnames
442  write (varname, '(a,i0)') trim(this%xname)//'_l', k
443  write (longname, '(a,i0,a)') trim(this%annotation%longname)// &
444  ' (layer ', k, ')'
445 
446  ! create the netcdf dependent layer variable
447  call nf_verify(nf90_def_var(this%ncid, varname, nf90_double, &
448  (/this%dim_ids%nmesh_face, &
449  this%dim_ids%time/), &
450  this%var_ids%dependent(k)), &
451  this%nc_fname)
452 
453  ! apply chunking parameters
454  if (this%chunking_active) then
455  call nf_verify(nf90_def_var_chunking(this%ncid, &
456  this%var_ids%dependent(k), &
457  nf90_chunked, &
458  (/this%chunk_face, &
459  this%chunk_time/)), &
460  this%nc_fname)
461  end if
462 
463  ! deflate and shuffle
464  call ncvar_deflate(this%ncid, this%var_ids%dependent(k), this%deflate, &
465  this%shuffle, this%nc_fname)
466 
467  ! assign variable attributes
468  call nf_verify(nf90_put_att(this%ncid, this%var_ids%dependent(k), &
469  'units', this%lenunits), this%nc_fname)
470  call nf_verify(nf90_put_att(this%ncid, this%var_ids%dependent(k), &
471  'standard_name', this%annotation%stdname), &
472  this%nc_fname)
473  call nf_verify(nf90_put_att(this%ncid, this%var_ids%dependent(k), &
474  'long_name', longname), this%nc_fname)
475  call nf_verify(nf90_put_att(this%ncid, this%var_ids%dependent(k), &
476  '_FillValue', (/dhnoflo/)), &
477  this%nc_fname)
478  call nf_verify(nf90_put_att(this%ncid, this%var_ids%dependent(k), &
479  'mesh', this%mesh_name), this%nc_fname)
480  call nf_verify(nf90_put_att(this%ncid, this%var_ids%dependent(k), &
481  'location', 'face'), this%nc_fname)
482 
483  ! add grid mapping
484  call ncvar_gridmap(this%ncid, this%var_ids%dependent(k), &
485  this%gridmap_name, this%nc_fname)
486  end do
487  end subroutine define_dependent
488 
489  !> @brief create the file grid mapping container variable
490  !<
491  subroutine define_gridmap(this)
492  class(meshmodeltype), intent(inout) :: this
493  integer(I4B) :: var_id
494 
495  ! was projection info provided
496  if (this%wkt /= '') then
497  ! create projection variable
498  call nf_verify(nf90_redef(this%ncid), this%nc_fname)
499  call nf_verify(nf90_def_var(this%ncid, this%gridmap_name, nf90_int, &
500  var_id), this%nc_fname)
501  ! cf-conventions prefers 'crs_wkt'
502  !call nf_verify(nf90_put_att(this%ncid, var_id, 'crs_wkt', this%wkt), &
503  ! this%nc_fname)
504  ! QGIS recognizes 'wkt'
505  call nf_verify(nf90_put_att(this%ncid, var_id, 'wkt', this%wkt), &
506  this%nc_fname)
507  call nf_verify(nf90_enddef(this%ncid), this%nc_fname)
508  call nf_verify(nf90_put_var(this%ncid, var_id, 1), &
509  this%nc_fname)
510  end if
511  end subroutine define_gridmap
512 
513  !> @brief create the file mesh container variable
514  !<
515  subroutine create_mesh(this)
516  class(mesh2dmodeltype), intent(inout) :: this
517 
518  ! create mesh container variable
519  call nf_verify(nf90_def_var(this%ncid, this%mesh_name, nf90_int, &
520  this%var_ids%mesh), this%nc_fname)
521 
522  ! assign container variable attributes
523  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh, 'cf_role', &
524  'mesh_topology'), this%nc_fname)
525  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh, 'long_name', &
526  '2D mesh topology'), this%nc_fname)
527  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh, &
528  'topology_dimension', 2), this%nc_fname)
529  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh, 'face_dimension', &
530  'nmesh_face'), this%nc_fname)
531  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh, &
532  'node_coordinates', 'mesh_node_x mesh_node_y'), &
533  this%nc_fname)
534  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh, &
535  'face_coordinates', 'mesh_face_x mesh_face_y'), &
536  this%nc_fname)
537  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh, &
538  'face_node_connectivity', 'mesh_face_nodes'), &
539  this%nc_fname)
540 
541  ! create mesh x node (mesh vertex) variable
542  call nf_verify(nf90_def_var(this%ncid, 'mesh_node_x', nf90_double, &
543  (/this%dim_ids%nmesh_node/), &
544  this%var_ids%mesh_node_x), this%nc_fname)
545 
546  ! assign mesh x node variable attributes
547  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_node_x, &
548  'units', this%lenunits), this%nc_fname)
549  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_node_x, &
550  'standard_name', 'projection_x_coordinate'), &
551  this%nc_fname)
552  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_node_x, &
553  'long_name', 'Easting'), this%nc_fname)
554 
555  if (this%wkt /= '') then
556  ! associate with projection
557  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_node_x, &
558  'grid_mapping', this%gridmap_name), &
559  this%nc_fname)
560  end if
561 
562  ! create mesh y node (mesh vertex) variable
563  call nf_verify(nf90_def_var(this%ncid, 'mesh_node_y', nf90_double, &
564  (/this%dim_ids%nmesh_node/), &
565  this%var_ids%mesh_node_y), this%nc_fname)
566 
567  ! assign mesh y variable attributes
568  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_node_y, &
569  'units', this%lenunits), this%nc_fname)
570  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_node_y, &
571  'standard_name', 'projection_y_coordinate'), &
572  this%nc_fname)
573  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_node_y, &
574  'long_name', 'Northing'), this%nc_fname)
575 
576  if (this%wkt /= '') then
577  ! associate with projection
578  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_node_y, &
579  'grid_mapping', this%gridmap_name), &
580  this%nc_fname)
581  end if
582 
583  ! create mesh x face (cell vertex) variable
584  call nf_verify(nf90_def_var(this%ncid, 'mesh_face_x', nf90_double, &
585  (/this%dim_ids%nmesh_face/), &
586  this%var_ids%mesh_face_x), this%nc_fname)
587 
588  ! assign mesh x face variable attributes
589  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_x, &
590  'units', this%lenunits), this%nc_fname)
591  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_x, &
592  'standard_name', 'projection_x_coordinate'), &
593  this%nc_fname)
594  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_x, &
595  'long_name', 'Easting'), this%nc_fname)
596  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_x, 'bounds', &
597  'mesh_face_xbnds'), this%nc_fname)
598  if (this%wkt /= '') then
599  ! associate with projection
600  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_x, &
601  'grid_mapping', this%gridmap_name), &
602  this%nc_fname)
603  end if
604 
605  ! create mesh x cell bounds variable
606  call nf_verify(nf90_def_var(this%ncid, 'mesh_face_xbnds', nf90_double, &
607  (/this%dim_ids%max_nmesh_face_nodes, &
608  this%dim_ids%nmesh_face/), &
609  this%var_ids%mesh_face_xbnds), &
610  this%nc_fname)
611 
612  ! create mesh y face (cell vertex) variable
613  call nf_verify(nf90_def_var(this%ncid, 'mesh_face_y', nf90_double, &
614  (/this%dim_ids%nmesh_face/), &
615  this%var_ids%mesh_face_y), this%nc_fname)
616 
617  ! assign mesh y face variable attributes
618  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_y, &
619  'units', this%lenunits), this%nc_fname)
620  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_y, &
621  'standard_name', 'projection_y_coordinate'), &
622  this%nc_fname)
623  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_y, &
624  'long_name', 'Northing'), this%nc_fname)
625  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_y, 'bounds', &
626  'mesh_face_ybnds'), this%nc_fname)
627 
628  if (this%wkt /= '') then
629  ! associate with projection
630  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_y, &
631  'grid_mapping', this%gridmap_name), &
632  this%nc_fname)
633  end if
634 
635  ! create mesh y cell bounds variable
636  call nf_verify(nf90_def_var(this%ncid, 'mesh_face_ybnds', nf90_double, &
637  (/this%dim_ids%max_nmesh_face_nodes, &
638  this%dim_ids%nmesh_face/), &
639  this%var_ids%mesh_face_ybnds), &
640  this%nc_fname)
641 
642  ! create mesh face nodes variable
643  call nf_verify(nf90_def_var(this%ncid, 'mesh_face_nodes', nf90_int, &
644  (/this%dim_ids%max_nmesh_face_nodes, &
645  this%dim_ids%nmesh_face/), &
646  this%var_ids%mesh_face_nodes), &
647  this%nc_fname)
648 
649  ! assign variable attributes
650  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_nodes, &
651  'cf_role', 'face_node_connectivity'), &
652  this%nc_fname)
653  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_nodes, &
654  'long_name', &
655  'Vertices bounding cell (counterclockwise)'), &
656  this%nc_fname)
657  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_nodes, &
658  '_FillValue', (/nf90_fill_int/)), &
659  this%nc_fname)
660  call nf_verify(nf90_put_att(this%ncid, this%var_ids%mesh_face_nodes, &
661  'start_index', 1), this%nc_fname)
662  end subroutine create_mesh
663 
664  !> @brief define variable chunking
665  !<
666  subroutine ncvar_chunk(ncid, varid, chunk_face, nc_fname)
667  integer(I4B), intent(in) :: ncid
668  integer(I4B), intent(in) :: varid
669  integer(I4B), intent(in) :: chunk_face
670  character(len=*), intent(in) :: nc_fname
671  if (chunk_face > 0) then
672  call nf_verify(nf90_def_var_chunking(ncid, varid, nf90_chunked, &
673  (/chunk_face/)), nc_fname)
674  end if
675  end subroutine ncvar_chunk
676 
677  !> @brief define variable compression
678  !<
679  subroutine ncvar_deflate(ncid, varid, deflate, shuffle, nc_fname)
680  integer(I4B), intent(in) :: ncid
681  integer(I4B), intent(in) :: varid
682  integer(I4B), intent(in) :: deflate
683  integer(I4B), intent(in) :: shuffle
684  character(len=*), intent(in) :: nc_fname
685  if (deflate >= 0) then
686  call nf_verify(nf90_def_var_deflate(ncid, varid, shuffle=shuffle, &
687  deflate=1, deflate_level=deflate), &
688  nc_fname)
689  end if
690  end subroutine ncvar_deflate
691 
692  !> @brief put variable gridmap attributes
693  !<
694  subroutine ncvar_gridmap(ncid, varid, gridmap_name, nc_fname)
695  integer(I4B), intent(in) :: ncid
696  integer(I4B), intent(in) :: varid
697  character(len=*), intent(in) :: gridmap_name
698  character(len=*), intent(in) :: nc_fname
699  if (gridmap_name /= '') then
700  call nf_verify(nf90_put_att(ncid, varid, 'coordinates', &
701  'mesh_face_x mesh_face_y'), nc_fname)
702  call nf_verify(nf90_put_att(ncid, varid, 'grid_mapping', &
703  gridmap_name), nc_fname)
704  end if
705  end subroutine ncvar_gridmap
706 
707  !> @brief put variable internal attributes
708  !<
709  subroutine ncvar_mf6attr(ncid, varid, layer, iaux, nc_tag, nc_fname)
710  integer(I4B), intent(in) :: ncid
711  integer(I4B), intent(in) :: varid
712  integer(I4B), intent(in) :: layer
713  integer(I4B), intent(in) :: iaux
714  character(len=*), intent(in) :: nc_tag
715  character(len=*), intent(in) :: nc_fname
716  if (nc_tag /= '') then
717  call nf_verify(nf90_put_att(ncid, varid, 'modflow_input', &
718  nc_tag), nc_fname)
719  if (layer > 0) then
720  call nf_verify(nf90_put_att(ncid, varid, 'layer', &
721  layer), nc_fname)
722  end if
723  if (iaux > 0) then
724  call nf_verify(nf90_put_att(ncid, varid, 'modflow_iaux', &
725  iaux), nc_fname)
726  end if
727  end if
728  end subroutine ncvar_mf6attr
729 
730 end module meshmodelmodule
abstract interfaces for derived ugrid netcd export types
Definition: MeshNCModel.f90:82
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
real(dp), parameter dnodata
real no data constant
Definition: Constants.f90:95
real(dp), parameter dhnoflo
real no flow constant
Definition: Constants.f90:93
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.
type(inputparamdefinitiontype) function, dimension(:), pointer, public param_definitions(component, subcomponent)
logical function, public idm_multi_package(component, subcomponent)
This module contains the InputDefinitionModule.
This module defines variable data types.
Definition: kind.f90:8
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
subroutine, public get_isize(name, mem_path, isize)
@ brief Get the number of elements for this variable
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 define_gridmap(this)
create the file grid mapping container variable
subroutine create_timeseries(this, idt, iparam, iaux, layer, export_pkg)
create timeseries export variable
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 mesh_init(this, modelname, modeltype, modelfname, nc_fname, disenum, nctype, lenuni, iout)
initialize
subroutine mesh_destroy(this)
initialize
subroutine add_global_att(this)
create file (group) attributes
subroutine add_pkg_data(this)
determine packages to write gridded input
subroutine df_export(this)
define timeseries input variables
subroutine export_df(this, export_pkg)
define export package
subroutine export_input_arrays(this, pkgtype, pkgname, mempath, param_dfns)
write package gridded input data
subroutine define_dependent(this)
create the model layer dependent variables
subroutine, public ncvar_deflate(ncid, varid, deflate, shuffle, nc_fname)
define variable compression
subroutine create_mesh(this)
create the file mesh container variable
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
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_warning(msg, substring)
Store warning message.
Definition: Sim.f90:236
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
character(len=linelength) idm_context
character(len=maxcharlen) warnmsg
warning message string
This module contains the SourceCommonModule.
Definition: SourceCommon.f90:7
character(len=lencomponentname) function, public idm_subcomponent_type(component, subcomponent)
component from package or model type
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
base ugrid netcdf export type
Definition: MeshNCModel.f90:60
type for storing model export dimension ids
Definition: MeshNCModel.f90:33
type for storing model export variable ids
Definition: MeshNCModel.f90:43
abstract type for model netcdf export type
Definition: NCModel.f90:105