MODFLOW 6  version 6.7.0.dev2
USGS Modular Hydrologic Model
NCModel.f90
Go to the documentation of this file.
1 !> @brief This module contains the NCModelExportModule
2 !!
3 !! This module defines a model export and base type for
4 !! supported netcdf files and is not dependent on
5 !! netcdf libraries.
6 !!
7 !<
9 
10  use kindmodule, only: dp, i4b, lgp
13  dis, disu, disv
19  use listmodule, only: listtype
20 
21  implicit none
22  private
24  public :: ncexportannotation
25  public :: exportpackagetype
28 
29  !> @brief netcdf export types enumerator
30  !<
31  ENUM, BIND(C)
32  ENUMERATOR :: netcdf_undef = 0 !< undefined netcdf export type
33  ENUMERATOR :: netcdf_structured = 1 !< netcdf structrured export
34  ENUMERATOR :: netcdf_mesh2d = 2 !< netcdf ugrid layered mesh export
35  END ENUM
36 
38  type(modflowinputtype) :: mf6_input !< description of modflow6 input
39  character(len=LINELENGTH), dimension(:), allocatable :: param_names !< dynamic param tagnames
40  type(readstatevartype), dimension(:), allocatable :: param_reads !< param read states
41  integer(I4B), dimension(:, :), allocatable :: varids_param
42  integer(I4B), dimension(:, :), allocatable :: varids_aux
43  integer(I4B), dimension(:), pointer, contiguous :: mshape => null() !< model shape
44  integer(I4B), pointer :: iper !< most recent package rp load
45  integer(I4B) :: iper_export !< most recent period of netcdf package export
46  integer(I4B) :: nparam !< number of in scope params
47  integer(I4B) :: naux !< number of auxiliary variables
48  contains
49  procedure :: init => epkg_init
50  procedure :: destroy => epkg_destroy
51  end type exportpackagetype
52 
53  !> @brief netcdf export attribute annotations
54  !<
56  character(len=LINELENGTH) :: title !< file scoped title attribute
57  character(len=LINELENGTH) :: model !< file scoped model attribute
58  character(len=LINELENGTH) :: mesh !< mesh type
59  character(len=LINELENGTH) :: grid !< grid type
60  character(len=LINELENGTH) :: history !< file scoped history attribute
61  character(len=LINELENGTH) :: source !< file scoped source attribute
62  character(len=LINELENGTH) :: conventions !< file scoped conventions attribute
63  character(len=LINELENGTH) :: stdname !< dependent variable standard name
64  character(len=LINELENGTH) :: longname !< dependent variable long name
65  contains
66  procedure :: set
67  end type ncexportannotation
68 
69  !> @brief base class for an export model
70  !<
72  type(listtype) :: pkglist
73  character(len=LENMODELNAME) :: modelname !< name of model
74  character(len=LENCOMPONENTNAME) :: modeltype !< type of model
75  character(len=LINELENGTH) :: modelfname !< name of model input file
76  character(len=LINELENGTH) :: nc_fname !< name of netcdf export file
77  character(len=LINELENGTH) :: gridmap_name !< name of grid mapping variable
78  character(len=LINELENGTH) :: mesh_name = 'mesh' !< name of mesh container variable
79  character(len=LENMEMPATH) :: dis_mempath !< discretization input mempath
80  character(len=LENMEMPATH) :: ncf_mempath !< netcdf utility package input mempath
81  character(len=LENBIGLINE) :: wkt !< wkt user string
82  character(len=LINELENGTH) :: datetime !< export file creation time
83  character(len=LINELENGTH) :: xname !< dependent variable name
84  character(len=LINELENGTH) :: lenunits !< unidata udunits length units
85  type(ncexportannotation) :: annotation !< export file annotation
86  real(dp), dimension(:), pointer, contiguous :: x !< dependent variable pointer
87  integer(I4B) :: disenum !< type of discretization
88  integer(I4B) :: ncid !< netcdf file descriptor
89  integer(I4B) :: totnstp !< simulation total number of steps
90  integer(I4B), pointer :: deflate !< variable deflate level
91  integer(I4B), pointer :: shuffle !< variable shuffle filter
92  integer(I4B), pointer :: input_attr !< assign variable input attr
93  integer(I4B), pointer :: chunk_time !< chunking parameter for time dimension
94  integer(I4B) :: iout !< lst file descriptor
95  logical(LGP) :: chunking_active !< have chunking parameters been provided
96  contains
97  procedure :: init => export_init
98  procedure :: get => export_get
99  procedure :: input_attribute
100  procedure :: destroy => export_destroy
101  end type ncmodelexporttype
102 
103  !> @brief abstract type for model netcdf export type
104  !<
105  type, abstract, extends(ncmodelexporttype) :: ncbasemodelexporttype
106  contains
107  procedure :: export_input
108  procedure(model_define), deferred :: df
109  procedure(package_export), deferred :: export_df
110  procedure(model_step), deferred :: step
111  procedure(package_export), deferred :: package_step
112  end type ncbasemodelexporttype
113 
114  !> @brief abstract interfaces for model netcdf export type
115  !<
116  abstract interface
117  subroutine model_define(this)
118  import ncbasemodelexporttype
119  class(ncbasemodelexporttype), intent(inout) :: this
120  end subroutine
121  subroutine model_step(this)
122  import ncbasemodelexporttype
123  class(ncbasemodelexporttype), intent(inout) :: this
124  end subroutine
125  subroutine package_export(this, export_pkg)
127  class(ncbasemodelexporttype), intent(inout) :: this
128  class(exportpackagetype), pointer, intent(in) :: export_pkg
129  end subroutine
130  subroutine package_export_ilayer(this, export_pkg, ilayer_varname, &
131  ilayer)
133  class(ncbasemodelexporttype), intent(inout) :: this
134  class(exportpackagetype), pointer, intent(in) :: export_pkg
135  character(len=*), intent(in) :: ilayer_varname
136  integer(I4B), intent(in) :: ilayer
137  end subroutine
138  end interface
139 
140 contains
141 
142  !> @brief initialize dynamic package export object
143  !<
144  subroutine epkg_init(this, mf6_input, mshape, naux, param_names, &
145  nparam)
150  class(exportpackagetype), intent(inout) :: this
151  type(modflowinputtype), intent(in) :: mf6_input
152  integer(I4B), dimension(:), pointer, contiguous, intent(in) :: mshape !< model shape
153  integer(I4B), intent(in) :: naux
154  character(len=LINELENGTH), dimension(:), allocatable, &
155  intent(in) :: param_names
156  integer(I4B), intent(in) :: nparam
157  integer(I4B) :: n
158  character(len=LENVARNAME) :: rs_varname
159  character(len=LENMEMPATH) :: input_mempath
160  integer(I4B), pointer :: rsvar
161 
162  this%mf6_input = mf6_input
163  this%mshape => mshape
164  this%nparam = nparam
165  this%naux = naux
166  this%iper_export = 0
167 
168  input_mempath = create_mem_path(component=mf6_input%component_name, &
169  subcomponent=mf6_input%subcomponent_name, &
170  context=idm_context)
171 
172  ! allocate param arrays
173  allocate (this%param_names(nparam))
174  allocate (this%param_reads(nparam))
175  allocate (this%varids_param(nparam, mshape(1)))
176  allocate (this%varids_aux(naux, mshape(1)))
177 
178  ! set param arrays
179  do n = 1, nparam
180  this%param_names(n) = param_names(n)
181  rs_varname = rsv_name(param_names(n))
182  call mem_setptr(rsvar, rs_varname, mf6_input%mempath)
183  this%param_reads(n)%invar => rsvar
184  end do
185 
186  ! set pointer to loaded input period
187  call mem_setptr(this%iper, 'IPER', mf6_input%mempath)
188  end subroutine epkg_init
189 
190  !> @brief destroy dynamic package export object
191  !<
192  subroutine epkg_destroy(this)
194  class(exportpackagetype), intent(inout) :: this
195  if (allocated(this%param_names)) deallocate (this%param_names)
196  end subroutine epkg_destroy
197 
198  !> @brief set netcdf file scoped attributes
199  !<
200  subroutine set(this, modelname, modeltype, modelfname, nctype, disenum)
201  use versionmodule, only: version
202  class(ncexportannotation), intent(inout) :: this
203  character(len=*), intent(in) :: modelname
204  character(len=*), intent(in) :: modeltype
205  character(len=*), intent(in) :: modelfname
206  integer(I4B), intent(in) :: nctype
207  integer(I4B), intent(in) :: disenum
208  character(len=LINELENGTH) :: fullname
209  integer :: values(8)
210 
211  this%title = ''
212  this%model = ''
213  this%mesh = ''
214  this%grid = ''
215  this%history = ''
216  this%source = ''
217  this%conventions = ''
218  this%stdname = ''
219  this%longname = ''
220 
221  ! set file conventions
222  this%conventions = 'CF-1.11'
223  if (nctype == netcdf_mesh2d) this%conventions = &
224  trim(this%conventions)//' UGRID-1.0'
225 
226  ! set model specific attributes
227  select case (modeltype)
228  case ('GWF')
229  fullname = 'Groundwater Flow'
230  this%title = trim(modelname)//' hydraulic head'
231  this%longname = 'head'
232  case ('GWT')
233  fullname = 'Groundwater Transport'
234  this%title = trim(modelname)//' concentration'
235  this%longname = 'concentration'
236  case ('GWE')
237  fullname = 'Groundwater Energy'
238  this%title = trim(modelname)//' temperature'
239  this%longname = 'temperature'
240  case default
241  errmsg = trim(modeltype)//' models not supported for NetCDF export.'
242  call store_error(errmsg)
243  call store_error_filename(modelfname)
244  end select
245 
246  if (isim_mode == mvalidate) then
247  this%title = trim(this%title)//' array input'
248  end if
249 
250  ! set mesh type
251  if (nctype == netcdf_mesh2d) then
252  this%mesh = 'LAYERED'
253  end if
254 
255  ! set grid type
256  if (disenum == dis) then
257  this%grid = 'STRUCTURED'
258  else if (disenum == disv) then
259  this%grid = 'VERTEX'
260  end if
261 
262  ! model description string
263  this%model = trim(modelname)//': MODFLOW 6 '//trim(fullname)// &
264  ' ('//trim(modeltype)//') model'
265 
266  ! modflow6 version string
267  this%source = 'MODFLOW 6 '//trim(adjustl(version))
268 
269  ! create timestamp
270  call date_and_time(values=values)
271  write (this%history, '(a,i0,a,i0,a,i0,a,i0,a,i0,a,i0,a,i0)') &
272  'first created ', values(1), '/', values(2), '/', values(3), ' ', &
273  values(5), ':', values(6), ':', values(7), '.', values(8)
274  end subroutine set
275 
276  !> @brief initialization of model netcdf export
277  !<
278  subroutine export_init(this, modelname, modeltype, modelfname, nc_fname, &
279  disenum, nctype, iout)
280  use tdismodule, only: datetime0, nstp, inats
284  use inputoutputmodule, only: lowcase
286  class(ncmodelexporttype), intent(inout) :: this
287  character(len=*), intent(in) :: modelname
288  character(len=*), intent(in) :: modeltype
289  character(len=*), intent(in) :: modelfname
290  character(len=*), intent(in) :: nc_fname
291  integer(I4B), intent(in) :: disenum
292  integer(I4B), intent(in) :: nctype
293  integer(I4B), intent(in) :: iout
294  character(len=LENMEMPATH) :: model_mempath
295  type(utlncfparamfoundtype) :: ncf_found
296  logical(LGP) :: found_mempath
297 
298  ! allocate
299  allocate (this%deflate)
300  allocate (this%shuffle)
301  allocate (this%input_attr)
302  allocate (this%chunk_time)
303 
304  ! initialize
305  this%modelname = modelname
306  this%modeltype = modeltype
307  this%modelfname = modelfname
308  this%nc_fname = nc_fname
309  this%gridmap_name = ''
310  this%ncf_mempath = ''
311  this%wkt = ''
312  this%datetime = ''
313  this%xname = ''
314  this%lenunits = ''
315  this%disenum = disenum
316  this%ncid = 0
317  this%totnstp = 0
318  this%deflate = -1
319  this%shuffle = 0
320  this%input_attr = 1
321  this%chunk_time = -1
322  this%iout = iout
323  this%chunking_active = .false.
324 
325  ! set file scoped attributes
326  call this%annotation%set(modelname, modeltype, modelfname, nctype, disenum)
327 
328  ! set dependent variable basename
329  select case (modeltype)
330  case ('GWF')
331  this%xname = 'head'
332  case ('GWT')
333  this%xname = 'concentration'
334  case ('GWE')
335  this%xname = 'temperature'
336  case default
337  errmsg = trim(modeltype)//' models not supported for NetCDF export.'
338  call store_error(errmsg)
339  call store_error_filename(modelfname)
340  end select
341 
342  ! set discretization input mempath
343  if (disenum == dis) then
344  this%dis_mempath = create_mem_path(modelname, 'DIS', idm_context)
345  else if (disenum == disu) then
346  this%dis_mempath = create_mem_path(modelname, 'DISU', idm_context)
347  else if (disenum == disv) then
348  this%dis_mempath = create_mem_path(modelname, 'DISV', idm_context)
349  end if
350 
351  ! set dependent variable pointer
352  model_mempath = create_mem_path(component=modelname)
353  call mem_setptr(this%x, 'X', model_mempath)
354 
355  ! set ncf_mempath if provided
356  call mem_set_value(this%ncf_mempath, 'NCF6_MEMPATH', this%dis_mempath, &
357  found_mempath)
358 
359  if (found_mempath) then
360  call mem_set_value(this%wkt, 'WKT', this%ncf_mempath, &
361  ncf_found%wkt)
362  call mem_set_value(this%deflate, 'DEFLATE', this%ncf_mempath, &
363  ncf_found%deflate)
364  call mem_set_value(this%shuffle, 'SHUFFLE', this%ncf_mempath, &
365  ncf_found%shuffle)
366  call mem_set_value(this%input_attr, 'ATTR_OFF', this%ncf_mempath, &
367  ncf_found%attr_off)
368  call mem_set_value(this%chunk_time, 'CHUNK_TIME', this%ncf_mempath, &
369  ncf_found%chunk_time)
370  end if
371 
372  if (ncf_found%wkt) then
373  this%gridmap_name = 'projection'
374  end if
375 
376  ! ATTR_OFF turns off modflow 6 input attributes
377  if (ncf_found%attr_off) then
378  this%input_attr = 0
379  end if
380 
381  ! set datetime string
382  if (datetime0 /= '') then
383  this%datetime = 'days since '//trim(datetime0)
384  else
385  ! January 1, 1970 at 00:00:00 UTC
386  this%datetime = 'days since 1970-01-01T00:00:00'
387  end if
388 
389  ! Set error and exit if ATS is on
390  if (inats > 0) then
391  errmsg = 'Adaptive time stepping not currently supported &
392  &with NetCDF exports.'
393  call store_error(errmsg)
394  call store_error_filename(modelfname)
395  end if
396 
397  ! set total nstp
398  this%totnstp = sum(nstp)
399  end subroutine export_init
400 
401  !> @brief retrieve dynamic export object from package list
402  !<
403  function export_get(this, idx) result(res)
404  use listmodule, only: listtype
405  class(ncmodelexporttype), intent(inout) :: this
406  integer(I4B), intent(in) :: idx
407  class(exportpackagetype), pointer :: res
408  class(*), pointer :: obj
409  nullify (res)
410  obj => this%pkglist%GetItem(idx)
411  if (associated(obj)) then
412  select type (obj)
413  class is (exportpackagetype)
414  res => obj
415  end select
416  end if
417  end function export_get
418 
419  !> @brief build modflow_input attribute string
420  !<
421  function input_attribute(this, pkgname, idt) result(attr)
422  use inputoutputmodule, only: lowcase
425  class(ncmodelexporttype), intent(inout) :: this
426  character(len=*), intent(in) :: pkgname
427  type(inputparamdefinitiontype), pointer, intent(in) :: idt
428  character(len=LINELENGTH) :: attr
429  attr = ''
430  if (this%input_attr > 0) then
431  attr = trim(this%modelname)//mempathseparator//trim(pkgname)// &
432  mempathseparator//trim(idt%tagname)
433  end if
434  end function input_attribute
435 
436  !> @brief build netcdf variable name
437  !<
438  function export_varname(pkgname, tagname, mempath, layer, iaux) &
439  result(varname)
442  use inputoutputmodule, only: lowcase
443  character(len=*), intent(in) :: pkgname
444  character(len=*), intent(in) :: tagname
445  character(len=*), intent(in) :: mempath
446  integer(I4B), optional, intent(in) :: layer
447  integer(I4B), optional, intent(in) :: iaux
448  character(len=LINELENGTH) :: varname
449  type(characterstringtype), dimension(:), pointer, &
450  contiguous :: auxnames
451  character(len=LINELENGTH) :: pname, vname
452  vname = tagname
453  pname = pkgname
454 
455  if (present(iaux)) then
456  if (iaux > 0) then
457  if (tagname == 'AUX') then
458  ! reset vname to auxiliary variable name
459  call mem_setptr(auxnames, 'AUXILIARY', mempath)
460  vname = auxnames(iaux)
461  end if
462  end if
463  end if
464 
465  call lowcase(vname)
466  call lowcase(pname)
467  varname = trim(pname)//'_'//trim(vname)
468 
469  if (present(layer)) then
470  if (layer > 0) then
471  !write (varname, '(a,i0)') trim(varname)//'_L', layer
472  write (varname, '(a,i0)') trim(varname)//'_l', layer
473  end if
474  end if
475  end function export_varname
476 
477  !> @brief build netcdf variable longname
478  !<
479  function export_longname(longname, pkgname, tagname, mempath, layer, iaux) &
480  result(lname)
483  use inputoutputmodule, only: lowcase
484  character(len=*), intent(in) :: longname
485  character(len=*), intent(in) :: pkgname
486  character(len=*), intent(in) :: tagname
487  character(len=*), intent(in) :: mempath
488  integer(I4B), optional, intent(in) :: layer
489  integer(I4B), optional, intent(in) :: iaux
490  character(len=LINELENGTH) :: lname
491  type(characterstringtype), dimension(:), pointer, &
492  contiguous :: auxnames
493  character(len=LINELENGTH) :: pname, vname, auxname
494  pname = pkgname
495  vname = tagname
496  call lowcase(pname)
497  call lowcase(vname)
498  if (longname == '') then
499  lname = trim(pname)//' '//trim(vname)
500  else
501  lname = longname
502  end if
503 
504  if (present(iaux)) then
505  if (iaux > 0) then
506  if (tagname == 'AUX') then
507  ! reset vname to auxiliary variable name
508  call mem_setptr(auxnames, 'AUXILIARY', mempath)
509  auxname = auxnames(iaux)
510  call lowcase(auxname)
511  lname = trim(lname)//' '//trim(auxname)
512  end if
513  end if
514  end if
515 
516  if (present(layer)) then
517  if (layer > 0) then
518  write (lname, '(a,i0)') trim(lname)//' layer=', layer
519  end if
520  end if
521  end function export_longname
522 
523  !> @brief netcdf dynamic package period export
524  !<
525  subroutine export_input(this)
526  use tdismodule, only: kper
527  class(ncbasemodelexporttype), intent(inout) :: this
528  integer(I4B) :: idx
529  class(exportpackagetype), pointer :: export_pkg
530  do idx = 1, this%pkglist%Count()
531  export_pkg => this%get(idx)
532  ! last loaded data is not current period
533  if (export_pkg%iper /= kper) cycle
534  ! period input already exported
535  if (export_pkg%iper_export >= export_pkg%iper) cycle
536  ! set exported iper
537  export_pkg%iper_export = export_pkg%iper
538  ! update export package
539  call this%package_step(export_pkg)
540  end do
541  end subroutine export_input
542 
543  !> @brief destroy model netcdf export object
544  !<
545  subroutine export_destroy(this)
548  class(ncmodelexporttype), intent(inout) :: this
549  ! override in derived class
550  deallocate (this%deflate)
551  deallocate (this%shuffle)
552  deallocate (this%input_attr)
553  deallocate (this%chunk_time)
554  ! Deallocate idm memory
555  if (this%ncf_mempath /= '') then
556  call memorystore_remove(this%modelname, 'NCF', idm_context)
557  end if
558  end subroutine export_destroy
559 
560 end module ncmodelexportmodule
subroutine init()
Definition: GridSorting.f90:24
abstract interfaces for model netcdf export type
Definition: NCModel.f90:117
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
integer(i4b), parameter lenmodelname
maximum length of the model name
Definition: Constants.f90:22
integer(i4b), parameter lenbigline
maximum length of a big line
Definition: Constants.f90:15
@ disu
DISV6 discretization.
Definition: Constants.f90:157
@ dis
DIS6 discretization.
Definition: Constants.f90:155
@ disv
DISU6 discretization.
Definition: Constants.f90:156
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
This module contains the InputDefinitionModule.
This module contains the InputLoadTypeModule.
subroutine, public lowcase(word)
Convert to lower case.
This module defines variable data types.
Definition: kind.f90:8
This module contains the LoadContextModule.
Definition: LoadContext.f90:10
character(len=lenvarname) function, public rsv_name(mf6varname)
create read state variable name
character(len=lenmemseparator), parameter mempathseparator
used to build up the memory address for the stored variables
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
subroutine, public memorystore_remove(component, subcomponent, context)
This module contains the ModflowInputModule.
Definition: ModflowInput.f90:9
This module contains the NCModelExportModule.
Definition: NCModel.f90:8
class(exportpackagetype) function, pointer export_get(this, idx)
retrieve dynamic export object from package list
Definition: NCModel.f90:404
character(len=linelength) function, public export_varname(pkgname, tagname, mempath, layer, iaux)
build netcdf variable name
Definition: NCModel.f90:440
subroutine epkg_init(this, mf6_input, mshape, naux, param_names, nparam)
initialize dynamic package export object
Definition: NCModel.f90:146
@, public netcdf_structured
netcdf structrured export
Definition: NCModel.f90:33
subroutine export_destroy(this)
destroy model netcdf export object
Definition: NCModel.f90:546
character(len=linelength) function, public export_longname(longname, pkgname, tagname, mempath, layer, iaux)
build netcdf variable longname
Definition: NCModel.f90:481
subroutine export_init(this, modelname, modeltype, modelfname, nc_fname, disenum, nctype, iout)
initialization of model netcdf export
Definition: NCModel.f90:280
@, public netcdf_mesh2d
netcdf ugrid layered mesh export
Definition: NCModel.f90:34
@, public netcdf_undef
undefined netcdf export type
Definition: NCModel.f90:32
subroutine set(this, modelname, modeltype, modelfname, nctype, disenum)
set netcdf file scoped attributes
Definition: NCModel.f90:201
character(len=linelength) function input_attribute(this, pkgname, idt)
build modflow_input attribute string
Definition: NCModel.f90:422
subroutine epkg_destroy(this)
destroy dynamic package export object
Definition: NCModel.f90:193
subroutine export_input(this)
netcdf dynamic package period export
Definition: NCModel.f90:526
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
character(len=linelength) idm_context
integer(i4b) isim_mode
simulation mode
integer(i4b), dimension(:), pointer, public, contiguous nstp
number of time steps in each stress period
Definition: tdis.f90:39
character(len=lendatetime), pointer, public datetime0
starting date and time for the simulation
Definition: tdis.f90:41
integer(i4b), pointer, public inats
flag indicating ats active for simulation
Definition: tdis.f90:25
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23
This module contains version information.
Definition: version.f90:7
character(len=40), parameter version
Definition: version.f90:22
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
type for storing a dynamic package load list
A generic heterogeneous doubly-linked list.
Definition: List.f90:14
Pointer type for read state variable.
Definition: LoadContext.f90:46
derived type for storing input definition for a file
abstract type for model netcdf export type
Definition: NCModel.f90:105
netcdf export attribute annotations
Definition: NCModel.f90:55
base class for an export model
Definition: NCModel.f90:71