MODFLOW 6  version 6.7.0.dev2
USGS Modular Hydrologic Model
NCArrayReader.f90
Go to the documentation of this file.
1 !> @brief This module contains the NCArrayReaderModule
2 !!
3 !! This module defines the netcdf_array_load interface
4 !! which can read layered (UGRID) and non-layered (STRUCTURED)
5 !! netcdf arrays stored in modflow6 designated input variables.
6 !!
7 !<
9 
10  use kindmodule, only: dp, i4b, lgp
11  use constantsmodule, only: linelength
12  use simvariablesmodule, only: errmsg
18  use netcdfcommonmodule, only: nf_verify
19  use netcdf
20 
21  implicit none
22  private
23  public :: netcdf_array_load
24 
26  module procedure nc_array_load_int1d, nc_array_load_int2d, &
29  end interface netcdf_array_load
30 
31 contains
32 
33  !> @brief does the grid support per layer variables
34  !<
35  function is_layered(grid) result(layered)
36  character(len=*), intent(in) :: grid
37  logical(LGP) :: layered
38  select case (grid)
39  case ('LAYERED MESH')
40  layered = .true.
41  case ('STRUCTURED')
42  layered = .false.
43  case default
44  layered = .false.
45  end select
46  end function is_layered
47 
48  !> @brief Load NetCDF integer 1D array
49  !<
50  subroutine nc_array_load_int1d(int1d, mshape, idt, mf6_input, nc_vars, &
51  input_fname, iout, kper)
52  integer(I4B), dimension(:), pointer, contiguous, intent(in) :: int1d
53  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
54  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
55  type(modflowinputtype), intent(in) :: mf6_input
56  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
57  character(len=*), intent(in) :: input_fname
58  integer(I4B), intent(in) :: iout
59  integer(I4B), optional, intent(in) :: kper !< flag if set > 0 indicates ts
60  integer(I4B) :: varid, iper
61  logical(LGP) :: layered
62 
63  iper = 0
64  layered = (idt%layered .and. is_layered(nc_vars%grid))
65 
66  if (present(kper)) then
67  iper = kper
68  end if
69 
70  if (layered) then
71  if (iper > 0) then
72  call load_integer1d_layered_spd(int1d, mf6_input, mshape, idt, nc_vars, &
73  iper, input_fname)
74  else
75  call load_integer1d_layered(int1d, mf6_input, mshape, idt, nc_vars, &
76  input_fname)
77  end if
78  else
79  if (iper > 0) then
80  call load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, &
81  iper, input_fname)
82  else
83  varid = nc_vars%varid(idt%tagname)
84  call load_integer1d_type(int1d, mf6_input, mshape, idt, nc_vars, &
85  varid, input_fname)
86  end if
87  end if
88  end subroutine nc_array_load_int1d
89 
90  !> @brief Load NetCDF integer 2D array
91  !<
92  subroutine nc_array_load_int2d(int2d, mshape, idt, mf6_input, nc_vars, &
93  input_fname, iout)
94  integer(I4B), dimension(:, :), pointer, contiguous, intent(in) :: int2d
95  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
96  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
97  type(modflowinputtype), intent(in) :: mf6_input
98  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
99  character(len=*), intent(in) :: input_fname
100  integer(I4B), intent(in) :: iout
101  integer(I4B) :: varid
102  logical(LGP) :: layered
103 
104  layered = (idt%layered .and. is_layered(nc_vars%grid))
105 
106  if (layered) then
107  call load_integer2d_layered(int2d, mf6_input, mshape, idt, nc_vars, &
108  input_fname)
109  else
110  varid = nc_vars%varid(idt%tagname)
111  call load_integer2d_type(int2d, mf6_input, mshape, idt, nc_vars, &
112  varid, input_fname)
113  end if
114  end subroutine nc_array_load_int2d
115 
116  !> @brief Load NetCDF integer 3D array
117  !<
118  subroutine nc_array_load_int3d(int3d, mshape, idt, mf6_input, nc_vars, &
119  input_fname, iout)
120  integer(I4B), dimension(:, :, :), pointer, contiguous, intent(in) :: int3d
121  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
122  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
123  type(modflowinputtype), intent(in) :: mf6_input
124  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
125  character(len=*), intent(in) :: input_fname
126  integer(I4B), intent(in) :: iout
127  integer(I4B) :: varid
128  logical(LGP) :: layered
129 
130  layered = (idt%layered .and. is_layered(nc_vars%grid))
131 
132  if (layered) then
133  call load_integer3d_layered(int3d, mf6_input, mshape, idt, nc_vars, &
134  input_fname)
135  else
136  varid = nc_vars%varid(idt%tagname)
137  call load_integer3d_type(int3d, mf6_input, mshape, idt, nc_vars, &
138  varid, input_fname)
139  end if
140  end subroutine nc_array_load_int3d
141 
142  !> @brief Load NetCDF double 1D array
143  !<
144  subroutine nc_array_load_dbl1d(dbl1d, mshape, idt, mf6_input, nc_vars, &
145  input_fname, iout, kper, iaux)
146  real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d
147  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
148  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
149  type(modflowinputtype), intent(in) :: mf6_input
150  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
151  character(len=*), intent(in) :: input_fname
152  integer(I4B), intent(in) :: iout
153  integer(I4B), optional, intent(in) :: kper !< flag if set > 0 indicates ts
154  integer(I4B), optional, intent(in) :: iaux
155  integer(I4B) :: varid, iper
156  logical(LGP) :: layered
157 
158  iper = 0
159  layered = (idt%layered .and. is_layered(nc_vars%grid))
160 
161  if (present(kper)) then
162  iper = kper
163  end if
164 
165  if (layered) then
166  if (iper > 0) then
167  call load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, &
168  iper, input_fname, iaux)
169  else
170  call load_double1d_layered(dbl1d, mf6_input, mshape, idt, nc_vars, &
171  input_fname)
172  end if
173  else
174  if (iper > 0) then
175  call load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, &
176  iper, input_fname, iaux)
177  else
178  varid = nc_vars%varid(idt%tagname)
179  call load_double1d_type(dbl1d, mf6_input, mshape, idt, nc_vars, &
180  varid, input_fname)
181  end if
182  end if
183  end subroutine nc_array_load_dbl1d
184 
185  !> @brief Load NetCDF double 2D array
186  !<
187  subroutine nc_array_load_dbl2d(dbl2d, mshape, idt, mf6_input, nc_vars, &
188  input_fname, iout)
189  real(DP), dimension(:, :), pointer, contiguous, intent(in) :: dbl2d
190  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
191  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
192  type(modflowinputtype), intent(in) :: mf6_input
193  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
194  character(len=*), intent(in) :: input_fname
195  integer(I4B), intent(in) :: iout
196  integer(I4B) :: varid
197  logical(LGP) :: layered
198 
199  layered = (idt%layered .and. is_layered(nc_vars%grid))
200 
201  if (layered) then
202  call load_double2d_layered(dbl2d, mf6_input, mshape, idt, nc_vars, &
203  input_fname)
204  else
205  varid = nc_vars%varid(idt%tagname)
206  call load_double2d_type(dbl2d, mf6_input, mshape, idt, nc_vars, &
207  varid, input_fname)
208  end if
209  end subroutine nc_array_load_dbl2d
210 
211  !> @brief Load NetCDF double 3D array
212  !<
213  subroutine nc_array_load_dbl3d(dbl3d, mshape, idt, mf6_input, nc_vars, &
214  input_fname, iout)
215  real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: dbl3d
216  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
217  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
218  type(modflowinputtype), intent(in) :: mf6_input
219  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
220  character(len=*), intent(in) :: input_fname
221  integer(I4B), intent(in) :: iout
222  integer(I4B) :: varid
223  logical(LGP) :: layered
224 
225  layered = (idt%layered .and. is_layered(nc_vars%grid))
226 
227  if (layered) then
228  call load_double3d_layered(dbl3d, mf6_input, mshape, idt, nc_vars, &
229  input_fname)
230  else
231  varid = nc_vars%varid(idt%tagname)
232  call load_double3d_type(dbl3d, mf6_input, mshape, idt, nc_vars, &
233  varid, input_fname)
234  end if
235  end subroutine nc_array_load_dbl3d
236 
237  !> @brief load type 1d integer
238  !<
239  subroutine load_integer1d_type(int1d, mf6_input, mshape, idt, nc_vars, &
240  varid, input_fname)
241  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: int1d
242  type(modflowinputtype), intent(in) :: mf6_input
243  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
244  type(inputparamdefinitiontype), intent(in) :: idt
245  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
246  integer(I4B), intent(in) :: varid
247  character(len=*), intent(in) :: input_fname
248  integer(I4B), dimension(:), allocatable :: array_shape
249  integer(I4B), dimension(:, :, :), contiguous, pointer :: int3d_ptr
250  integer(I4B), dimension(:, :), contiguous, pointer :: int2d_ptr
251  integer(I4B) :: nvals
252 
253  ! initialize
254  nvals = 0
255 
256  if (idt%shape == 'NODES') then
257  ! set number of values
258  nvals = product(mshape)
259  if (size(mshape) == 3) then
260  int3d_ptr(1:mshape(3), 1:mshape(2), 1:mshape(1)) => int1d(1:nvals)
261  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int3d_ptr), &
262  nc_vars%nc_fname)
263  else if (size(mshape) == 2) then
264  int2d_ptr(1:mshape(2), 1:mshape(1)) => int1d(1:nvals)
265  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int2d_ptr), &
266  nc_vars%nc_fname)
267  else if (size(mshape) == 1) then
268  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d), nc_vars%nc_fname)
269  end if
270  else
271  ! interpret shape
272  call get_shape_from_string(idt%shape, array_shape, mf6_input%mempath)
273  ! set nvals
274  nvals = array_shape(1)
275  ! read and set data
276  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d), nc_vars%nc_fname)
277  end if
278  end subroutine load_integer1d_type
279 
280  !> @brief load type 1d double
281  !<
282  subroutine load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, &
283  iper, input_fname)
284  use constantsmodule, only: dnodata
285  use netcdfcommonmodule, only: ixstp
286  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: int1d
287  type(modflowinputtype), intent(in) :: mf6_input
288  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
289  type(inputparamdefinitiontype), intent(in) :: idt
290  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
291  integer(I4B), intent(in) :: iper
292  character(len=*), intent(in) :: input_fname
293  integer(I4B), dimension(:), allocatable :: layer_shape
294  integer(I4B) :: varid, nlay, ncpl, istp
295 
296  istp = ixstp()
297 
298  ! set varid
299  varid = nc_vars%varid(idt%tagname)
300 
301  call get_layered_shape(mshape, nlay, layer_shape)
302  ncpl = product(layer_shape)
303 
304  if (size(mshape) == 3) then
305  select case (idt%shape)
306  case ('NCPL', 'NAUX NCPL')
307  if (nc_vars%grid == 'STRUCTURED') then
308  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d, &
309  start=(/1, 1, istp/), &
310  count=(/mshape(3), mshape(2), 1/)), &
311  nc_vars%nc_fname)
312  else if (nc_vars%grid == 'LAYERED MESH') then
313  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d, &
314  start=(/1, istp/), count=(/ncpl, 1/)), &
315  nc_vars%nc_fname)
316  end if
317  case ('NODES', 'NAUX NODES')
318  write (errmsg, '(a,a,a)') &
319  'Timeseries netcdf input read not supported for DIS full grid int1d &
320  &type ('//trim(idt%tagname)//').'
321  call store_error(errmsg)
322  call store_error_filename(input_fname)
323  case default
324  end select
325  end if
326  end subroutine load_integer1d_spd
327 
328  !> @brief load type 1d integer layered
329  !<
330  subroutine load_integer1d_layered(int1d, mf6_input, mshape, idt, nc_vars, &
331  input_fname)
332  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: int1d
333  type(modflowinputtype), intent(in) :: mf6_input
334  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
335  type(inputparamdefinitiontype), intent(in) :: idt
336  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
337  character(len=*), intent(in) :: input_fname
338  integer(I4B), dimension(:), allocatable :: layer_shape
339  integer(I4B) :: nlay, varid
340  integer(I4B) :: k, ncpl
341  integer(I4B) :: index_start, index_stop
342  integer(I4B), dimension(:), contiguous, pointer :: int1d_ptr
343 
344  nullify (int1d_ptr)
345 
346  call get_layered_shape(mshape, nlay, layer_shape)
347 
348  ncpl = product(layer_shape)
349  index_start = 1
350  do k = 1, nlay
351  varid = nc_vars%varid(idt%tagname, layer=k)
352  index_stop = index_start + ncpl - 1
353  int1d_ptr(1:ncpl) => int1d(index_start:index_stop)
354  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d_ptr), &
355  nc_vars%nc_fname)
356  index_start = index_stop + 1
357  end do
358  end subroutine load_integer1d_layered
359 
360  !> @brief load type 1d integer layered
361  !<
362  subroutine load_integer1d_layered_spd(int1d, mf6_input, mshape, idt, nc_vars, &
363  iper, input_fname)
364  use constantsmodule, only: dnodata
365  use netcdfcommonmodule, only: ixstp
366  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: int1d
367  type(modflowinputtype), intent(in) :: mf6_input
368  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
369  type(inputparamdefinitiontype), intent(in) :: idt
370  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
371  integer(I4B), intent(in) :: iper
372  character(len=*), intent(in) :: input_fname
373  integer(I4B), dimension(:), allocatable :: layer_shape
374  integer(I4B) :: nlay, varid
375  integer(I4B) :: ncpl, nvals, istp
376 
377  istp = ixstp()
378 
379  call get_layered_shape(mshape, nlay, layer_shape)
380  nvals = product(mshape)
381  ncpl = product(layer_shape)
382 
383  varid = nc_vars%varid(idt%tagname)
384  select case (idt%shape)
385  case ('NCPL', 'NAUX NCPL')
386  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d, &
387  start=(/1, istp/), count=(/ncpl, 1/)), &
388  nc_vars%nc_fname)
389  case ('NODES', 'NAUX NODES')
390  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d, &
391  start=(/1, istp/), count=(/nvals, 1/)), &
392  nc_vars%nc_fname)
393  case default
394  end select
395  end subroutine load_integer1d_layered_spd
396 
397  !> @brief load type 2d integer
398  !<
399  subroutine load_integer2d_type(int2d, mf6_input, mshape, idt, nc_vars, varid, &
400  input_fname)
401  integer(I4B), dimension(:, :), contiguous, pointer, intent(in) :: int2d
402  type(modflowinputtype), intent(in) :: mf6_input
403  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
404  type(inputparamdefinitiontype), intent(in) :: idt
405  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
406  integer(I4B), intent(in) :: varid
407  character(len=*), intent(in) :: input_fname
408  integer(I4B), dimension(:), contiguous, pointer :: int1d_ptr
409  integer(I4B), dimension(:), allocatable :: array_shape
410  integer(I4B) :: ncpl, nlay
411 
412  nullify (int1d_ptr)
413 
414  if (nc_vars%grid == 'STRUCTURED') then
415  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int2d), nc_vars%nc_fname)
416  else if (nc_vars%grid == 'LAYERED MESH') then
417  call get_layered_shape(mshape, nlay, array_shape)
418  ncpl = product(array_shape)
419  int1d_ptr(1:ncpl) => int2d(:, :)
420  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d_ptr), &
421  nc_vars%nc_fname)
422  end if
423  end subroutine load_integer2d_type
424 
425  !> @brief load type 2d integer layered
426  !<
427  subroutine load_integer2d_layered(int2d, mf6_input, mshape, idt, nc_vars, &
428  input_fname)
429  integer(I4B), dimension(:, :), contiguous, pointer, intent(in) :: int2d
430  type(modflowinputtype), intent(in) :: mf6_input
431  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
432  type(inputparamdefinitiontype), intent(in) :: idt
433  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
434  character(len=*), intent(in) :: input_fname
435  integer(I4B), dimension(:), allocatable :: layer_shape
436  integer(I4B) :: k
437  integer(I4B) :: ncpl, nlay, varid
438  integer(I4B), dimension(:), contiguous, pointer :: int1d_ptr
439 
440  nullify (int1d_ptr)
441 
442  if (size(mshape) == 3) then
443  write (errmsg, '(a,a,a)') &
444  'Layered netcdf read not supported for DIS int2d type ('// &
445  trim(idt%tagname)//').'
446  call store_error(errmsg)
447  call store_error_filename(input_fname)
448  else if (size(mshape) == 2) then
449  call get_layered_shape(mshape, nlay, layer_shape)
450  ncpl = layer_shape(1)
451  do k = 1, nlay
452  varid = nc_vars%varid(idt%tagname, layer=k)
453  int1d_ptr(1:ncpl) => int2d(1:ncpl, k)
454  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d_ptr), &
455  nc_vars%nc_fname)
456  end do
457  end if
458  end subroutine load_integer2d_layered
459 
460  !> @brief load type 3d integer
461  !<
462  subroutine load_integer3d_type(int3d, mf6_input, mshape, idt, nc_vars, varid, &
463  input_fname)
464  integer(I4B), dimension(:, :, :), contiguous, pointer, intent(in) :: int3d
465  type(modflowinputtype), intent(in) :: mf6_input
466  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
467  type(inputparamdefinitiontype), intent(in) :: idt
468  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
469  integer(I4B), intent(in) :: varid
470  character(len=*), intent(in) :: input_fname
471  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int3d), nc_vars%nc_fname)
472  end subroutine load_integer3d_type
473 
474  !> @brief load type 3d integer layered
475  !<
476  subroutine load_integer3d_layered(int3d, mf6_input, mshape, idt, nc_vars, &
477  input_fname)
478  integer(I4B), dimension(:, :, :), contiguous, pointer, intent(in) :: int3d
479  type(modflowinputtype), intent(in) :: mf6_input
480  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
481  type(inputparamdefinitiontype), intent(in) :: idt
482  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
483  character(len=*), intent(in) :: input_fname
484  integer(I4B), dimension(:), allocatable :: layer_shape
485  integer(I4B) :: k !, i, j
486  integer(I4B) :: ncpl, nlay, varid
487  integer(I4B) :: index_start, index_stop
488  integer(I4B), dimension(:), contiguous, pointer :: int1d_ptr
489 
490  nullify (int1d_ptr)
491  index_start = 1
492  call get_layered_shape(mshape, nlay, layer_shape)
493  ncpl = product(layer_shape)
494 
495  do k = 1, nlay
496  varid = nc_vars%varid(idt%tagname, layer=k)
497  index_stop = index_start + ncpl - 1
498  int1d_ptr(1:ncpl) => int3d(:, :, k:k)
499  call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d_ptr), &
500  nc_vars%nc_fname)
501  index_start = index_stop + 1
502  end do
503  end subroutine load_integer3d_layered
504 
505  !> @brief load type 1d double
506  !<
507  subroutine load_double1d_type(dbl1d, mf6_input, mshape, idt, nc_vars, &
508  varid, input_fname)
509  real(DP), dimension(:), contiguous, pointer, intent(in) :: dbl1d
510  type(modflowinputtype), intent(in) :: mf6_input
511  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
512  type(inputparamdefinitiontype), intent(in) :: idt
513  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
514  integer(I4B), intent(in) :: varid
515  character(len=*), intent(in) :: input_fname
516  integer(I4B), dimension(:), allocatable :: array_shape
517  real(DP), dimension(:, :, :), contiguous, pointer :: dbl3d_ptr
518  real(DP), dimension(:, :), contiguous, pointer :: dbl2d_ptr
519  integer(I4B) :: nvals
520 
521  ! initialize
522  nvals = 0
523 
524  if (idt%shape == 'NODES') then
525  ! set number of values
526  nvals = product(mshape)
527  if (size(mshape) == 3) then
528  dbl3d_ptr(1:mshape(3), 1:mshape(2), 1:mshape(1)) => dbl1d(1:nvals)
529  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl3d_ptr), &
530  nc_vars%nc_fname)
531  else if (size(mshape) == 2) then
532  dbl2d_ptr(1:mshape(2), 1:mshape(1)) => dbl1d(1:nvals)
533  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl2d_ptr), &
534  nc_vars%nc_fname)
535  else if (size(mshape) == 1) then
536  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d), nc_vars%nc_fname)
537  end if
538  else
539  ! interpret shape
540  call get_shape_from_string(idt%shape, array_shape, mf6_input%mempath)
541  ! set nvals
542  nvals = array_shape(1)
543  ! read and set data
544  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d), nc_vars%nc_fname)
545  end if
546  end subroutine load_double1d_type
547 
548  !> @brief load type 1d double
549  !<
550  subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, &
551  iper, input_fname, iaux)
552  use constantsmodule, only: dnodata
553  use netcdfcommonmodule, only: ixstp
554  real(DP), dimension(:), contiguous, pointer, intent(in) :: dbl1d
555  type(modflowinputtype), intent(in) :: mf6_input
556  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
557  type(inputparamdefinitiontype), intent(in) :: idt
558  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
559  integer(I4B), intent(in) :: iper
560  character(len=*), intent(in) :: input_fname
561  integer(I4B), optional, intent(in) :: iaux
562  integer(I4B), dimension(:), allocatable :: layer_shape
563  real(DP), dimension(:, :, :), contiguous, pointer :: dbl3d
564  integer(I4B) :: varid, nlay, ncpl, nvals
565  integer(I4B) :: n, istp
566 
567  ! initialize
568  n = 0
569  istp = ixstp()
570 
571  ! set varid
572  if (present(iaux)) then
573  varid = nc_vars%varid(idt%tagname, iaux=iaux)
574  else
575  varid = nc_vars%varid(idt%tagname)
576  end if
577 
578  call get_layered_shape(mshape, nlay, layer_shape)
579  ncpl = product(layer_shape)
580  nvals = product(mshape)
581 
582  if (size(mshape) == 3) then
583  select case (idt%shape)
584  case ('NCPL', 'NAUX NCPL')
585  if (nc_vars%grid == 'STRUCTURED') then
586  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d, &
587  start=(/1, 1, istp/), &
588  count=(/mshape(3), mshape(2), 1/)), &
589  nc_vars%nc_fname)
590  else if (nc_vars%grid == 'LAYERED MESH') then
591  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d, &
592  start=(/1, istp/), count=(/ncpl, 1/)), &
593  nc_vars%nc_fname)
594  end if
595  case ('NODES', 'NAUX NODES')
596  if (nc_vars%grid == 'STRUCTURED') then
597  dbl3d(1:mshape(3), 1:mshape(2), 1:mshape(1)) => dbl1d(1:nvals)
598  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl3d, &
599  start=(/1, 1, 1, istp/), &
600  count=(/mshape(3), mshape(2), mshape(1), &
601  1/)), nc_vars%nc_fname)
602  else if (nc_vars%grid == 'LAYERED MESH') then
603  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d, &
604  start=(/1, istp/), count=(/nvals, 1/)), &
605  nc_vars%nc_fname)
606  end if
607  case default
608  end select
609  end if
610  end subroutine load_double1d_spd
611 
612  !> @brief load type 1d double layered
613  !<
614  subroutine load_double1d_layered(dbl1d, mf6_input, mshape, idt, nc_vars, &
615  input_fname)
616  real(DP), dimension(:), contiguous, pointer, intent(in) :: dbl1d
617  type(modflowinputtype), intent(in) :: mf6_input
618  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
619  type(inputparamdefinitiontype), intent(in) :: idt
620  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
621  character(len=*), intent(in) :: input_fname
622  integer(I4B), dimension(:), allocatable :: layer_shape
623  integer(I4B) :: nlay, varid
624  integer(I4B) :: k, ncpl
625  integer(I4B) :: index_start, index_stop
626  real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr
627 
628  nullify (dbl1d_ptr)
629  index_start = 1
630  call get_layered_shape(mshape, nlay, layer_shape)
631  ncpl = product(layer_shape)
632 
633  do k = 1, nlay
634  varid = nc_vars%varid(idt%tagname, layer=k)
635  index_stop = index_start + ncpl - 1
636  dbl1d_ptr(1:ncpl) => dbl1d(index_start:index_stop)
637  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr), &
638  nc_vars%nc_fname)
639  index_start = index_stop + 1
640  end do
641  end subroutine load_double1d_layered
642 
643  !> @brief load type 1d double layered
644  !<
645  subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, &
646  iper, input_fname, iaux)
647  use constantsmodule, only: dnodata
648  use netcdfcommonmodule, only: ixstp
649  real(DP), dimension(:), contiguous, pointer, intent(in) :: dbl1d
650  type(modflowinputtype), intent(in) :: mf6_input
651  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
652  type(inputparamdefinitiontype), intent(in) :: idt
653  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
654  integer(I4B), intent(in) :: iper
655  character(len=*), intent(in) :: input_fname
656  integer(I4B), optional, intent(in) :: iaux
657  integer(I4B), dimension(:), allocatable :: layer_shape
658  integer(I4B) :: nlay, varid
659  integer(I4B) :: k, n, ncpl, idx, istp
660  real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr
661 
662  istp = ixstp()
663 
664  call get_layered_shape(mshape, nlay, layer_shape)
665  ncpl = product(layer_shape)
666  allocate (dbl1d_ptr(ncpl))
667 
668  do k = 1, nlay
669  if (present(iaux)) then
670  varid = nc_vars%varid(idt%tagname, layer=k, iaux=iaux)
671  else
672  varid = nc_vars%varid(idt%tagname, layer=k)
673  end if
674  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr, &
675  start=(/1, istp/), count=(/ncpl, 1/)), &
676  nc_vars%nc_fname)
677  if (idt%shape == 'NODES' .or. idt%shape == 'NAUX NODES') then
678  do n = 1, ncpl
679  idx = (k - 1) * ncpl + n
680  dbl1d(idx) = dbl1d_ptr(n)
681  end do
682  else if (idt%shape == 'NCPL' .or. idt%shape == 'NAUX NCPL') then
683  do n = 1, ncpl
684  dbl1d(n) = dbl1d_ptr(n)
685  end do
686  end if
687  end do
688 
689  ! cleanup
690  deallocate (dbl1d_ptr)
691  end subroutine load_double1d_layered_spd
692 
693  !> @brief load type 2d double
694  !<
695  subroutine load_double2d_type(dbl2d, mf6_input, mshape, idt, nc_vars, varid, &
696  input_fname)
697  real(DP), dimension(:, :), contiguous, pointer, intent(in) :: dbl2d
698  type(modflowinputtype), intent(in) :: mf6_input
699  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
700  type(inputparamdefinitiontype), intent(in) :: idt
701  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
702  integer(I4B), intent(in) :: varid
703  character(len=*), intent(in) :: input_fname
704  real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr
705  integer(I4B), dimension(:), allocatable :: array_shape
706  integer(I4B) :: ncpl, nlay
707 
708  nullify (dbl1d_ptr)
709 
710  if (nc_vars%grid == 'STRUCTURED') then
711  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl2d), nc_vars%nc_fname)
712  else if (nc_vars%grid == 'LAYERED MESH') then
713  call get_layered_shape(mshape, nlay, array_shape)
714  ncpl = product(array_shape)
715  dbl1d_ptr(1:ncpl) => dbl2d(:, :)
716  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr), &
717  nc_vars%nc_fname)
718  end if
719  end subroutine load_double2d_type
720 
721  !> @brief load type 2d double layered
722  !<
723  subroutine load_double2d_layered(dbl2d, mf6_input, mshape, idt, nc_vars, &
724  input_fname)
725  real(DP), dimension(:, :), contiguous, pointer, intent(in) :: dbl2d
726  type(modflowinputtype), intent(in) :: mf6_input
727  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
728  type(inputparamdefinitiontype), intent(in) :: idt
729  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
730  character(len=*), intent(in) :: input_fname
731  integer(I4B), dimension(:), allocatable :: layer_shape
732  integer(I4B) :: k
733  integer(I4B) :: ncpl, nlay, varid
734  real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr
735 
736  nullify (dbl1d_ptr)
737 
738  if (size(mshape) == 3) then
739  write (errmsg, '(a,a,a)') &
740  'Layered netcdf read not supported for DIS dbl2d type ('// &
741  trim(idt%tagname)//').'
742  call store_error(errmsg)
743  call store_error_filename(input_fname)
744  else if (size(mshape) == 2) then
745  call get_layered_shape(mshape, nlay, layer_shape)
746  ncpl = layer_shape(1)
747  do k = 1, nlay
748  varid = nc_vars%varid(idt%tagname, layer=k)
749  dbl1d_ptr(1:ncpl) => dbl2d(1:ncpl, k)
750  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr), &
751  nc_vars%nc_fname)
752  end do
753  end if
754  end subroutine load_double2d_layered
755 
756  !> @brief load type 3d double
757  !<
758  subroutine load_double3d_type(dbl3d, mf6_input, mshape, idt, nc_vars, varid, &
759  input_fname)
760  real(DP), dimension(:, :, :), contiguous, pointer, intent(in) :: dbl3d
761  type(modflowinputtype), intent(in) :: mf6_input
762  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
763  type(inputparamdefinitiontype), intent(in) :: idt
764  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
765  integer(I4B), intent(in) :: varid
766  character(len=*), intent(in) :: input_fname
767  !
768  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl3d), nc_vars%nc_fname)
769  end subroutine load_double3d_type
770 
771  !> @brief load type 3d double layered
772  !<
773  subroutine load_double3d_layered(dbl3d, mf6_input, mshape, idt, nc_vars, &
774  input_fname)
775  real(DP), dimension(:, :, :), contiguous, pointer, intent(in) :: dbl3d
776  type(modflowinputtype), intent(in) :: mf6_input
777  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape
778  type(inputparamdefinitiontype), intent(in) :: idt
779  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
780  character(len=*), intent(in) :: input_fname
781  integer(I4B), dimension(:), allocatable :: layer_shape
782  integer(I4B) :: k !, i, j
783  integer(I4B) :: ncpl, nlay, varid
784  integer(I4B) :: index_start, index_stop
785  real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr
786 
787  nullify (dbl1d_ptr)
788 
789  call get_layered_shape(mshape, nlay, layer_shape)
790 
791  ncpl = product(layer_shape)
792  index_start = 1
793  do k = 1, nlay
794  varid = nc_vars%varid(idt%tagname, layer=k)
795  index_stop = index_start + ncpl - 1
796  dbl1d_ptr(1:ncpl) => dbl3d(:, :, k:k)
797  call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr), &
798  nc_vars%nc_fname)
799  index_start = index_stop + 1
800  end do
801  end subroutine load_double3d_layered
802 
803 end module ncarrayreadermodule
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
real(dp), parameter dnodata
real no data constant
Definition: Constants.f90:95
This module contains the InputDefinitionModule.
This module defines variable data types.
Definition: kind.f90:8
This module contains the ModflowInputModule.
Definition: ModflowInput.f90:9
This module contains the NCArrayReaderModule.
subroutine load_double1d_layered(dbl1d, mf6_input, mshape, idt, nc_vars, input_fname)
load type 1d double layered
subroutine nc_array_load_int2d(int2d, mshape, idt, mf6_input, nc_vars, input_fname, iout)
Load NetCDF integer 2D array.
subroutine load_integer1d_layered_spd(int1d, mf6_input, mshape, idt, nc_vars, iper, input_fname)
load type 1d integer layered
subroutine load_double3d_layered(dbl3d, mf6_input, mshape, idt, nc_vars, input_fname)
load type 3d double layered
subroutine nc_array_load_dbl2d(dbl2d, mshape, idt, mf6_input, nc_vars, input_fname, iout)
Load NetCDF double 2D array.
subroutine load_integer3d_layered(int3d, mf6_input, mshape, idt, nc_vars, input_fname)
load type 3d integer layered
subroutine load_integer1d_type(int1d, mf6_input, mshape, idt, nc_vars, varid, input_fname)
load type 1d integer
subroutine load_double3d_type(dbl3d, mf6_input, mshape, idt, nc_vars, varid, input_fname)
load type 3d double
logical(lgp) function is_layered(grid)
does the grid support per layer variables
subroutine nc_array_load_int3d(int3d, mshape, idt, mf6_input, nc_vars, input_fname, iout)
Load NetCDF integer 3D array.
subroutine load_double2d_type(dbl2d, mf6_input, mshape, idt, nc_vars, varid, input_fname)
load type 2d double
subroutine load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, iper, input_fname)
load type 1d double
subroutine load_integer3d_type(int3d, mf6_input, mshape, idt, nc_vars, varid, input_fname)
load type 3d integer
subroutine load_integer2d_layered(int2d, mf6_input, mshape, idt, nc_vars, input_fname)
load type 2d integer layered
subroutine load_integer2d_type(int2d, mf6_input, mshape, idt, nc_vars, varid, input_fname)
load type 2d integer
subroutine nc_array_load_int1d(int1d, mshape, idt, mf6_input, nc_vars, input_fname, iout, kper)
Load NetCDF integer 1D array.
subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, iper, input_fname, iaux)
load type 1d double layered
subroutine load_integer1d_layered(int1d, mf6_input, mshape, idt, nc_vars, input_fname)
load type 1d integer layered
subroutine load_double1d_type(dbl1d, mf6_input, mshape, idt, nc_vars, varid, input_fname)
load type 1d double
subroutine load_double2d_layered(dbl2d, mf6_input, mshape, idt, nc_vars, input_fname)
load type 2d double layered
subroutine nc_array_load_dbl3d(dbl3d, mshape, idt, mf6_input, nc_vars, input_fname, iout)
Load NetCDF double 3D array.
subroutine nc_array_load_dbl1d(dbl1d, mshape, idt, mf6_input, nc_vars, input_fname, iout, kper, iaux)
Load NetCDF double 1D array.
subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, iper, input_fname, iaux)
load type 1d double
This module contains the NCFileVarsModule.
Definition: NCFileVars.f90:7
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
This module contains the SourceCommonModule.
Definition: SourceCommon.f90:7
subroutine, public get_layered_shape(mshape, nlay, layer_shape)
subroutine, public get_shape_from_string(shape_string, array_shape, memoryPath)
derived type for storing input definition for a file
Type describing input variables for a package in NetCDF file.
Definition: NCFileVars.f90:22