MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
Data Types | Functions/Subroutines
arrayreadersmodule Module Reference

Data Types

interface  readarray
 

Functions/Subroutines

subroutine read_array_int1d (iu, iarr, aname, ndim, jj, iout, k)
 
subroutine read_array_int2d (iu, iarr, aname, ndim, jj, ii, iout, k)
 
subroutine read_array_int3d (iu, iarr, aname, ndim, ncol, nrow, nlay, iout, k1, k2)
 
subroutine read_array_int3d_all (iu, iarr, aname, ndim, nvals, iout)
 
subroutine read_array_int1d_layered (iu, iarr, aname, ndim, ncol, nrow, nlay, nval, iout, k1, k2)
 
subroutine read_array_dbl1d (iu, darr, aname, ndim, jj, iout, k)
 
subroutine read_array_dbl2d (iu, darr, aname, ndim, jj, ii, iout, k)
 
subroutine read_array_dbl3d (iu, darr, aname, ndim, ncol, nrow, nlay, iout, k1, k2)
 
subroutine read_array_dbl3d_all (iu, darr, aname, ndim, nvals, iout)
 
subroutine read_array_dbl1d_layered (iu, darr, aname, ndim, ncol, nrow, nlay, nval, iout, k1, k2)
 
subroutine read_control_int (iu, iout, aname, locat, iconst, iclose, iprn)
 
subroutine read_control_dbl (iu, iout, aname, locat, cnstnt, iclose, iprn)
 
subroutine read_control_1 (iu, iout, aname, locat, iclose, line, icol, fname)
 
subroutine read_control_2 (iu, iout, fname, line, icol, locat, iclose, iprn)
 
subroutine build_format_int (iprn, prfmt, prowcolnum, ncpl, ndig)
 
subroutine build_format_dbl (iprn, prfmt, prowcolnum, ncpl, ndig)
 
subroutine print_array_int (iarr, aname, iout, jj, ii, k, prfmt, ncpl, ndig, prowcolnum)
 
subroutine print_array_dbl (darr, aname, iout, jj, ii, k, prfmt, ncpl, ndig, prowcolnum)
 
subroutine, public read_binary_header (locat, iout, arrname, nval)
 
logical(lgp) function check_binary_size (nval, nvalt, arrsize, aname, locat)
 @ brief Check the binary data size More...
 

Function/Subroutine Documentation

◆ build_format_dbl()

subroutine arrayreadersmodule::build_format_dbl ( integer(i4b), intent(inout)  iprn,
character(len=*), intent(out)  prfmt,
logical, intent(in)  prowcolnum,
integer(i4b), intent(out)  ncpl,
integer(i4b), intent(out)  ndig 
)
private

Definition at line 784 of file ArrayReaders.f90.

785  ! -- Build a print format for reals based on IPRN.
786  ! -- dummy
787  integer(I4B), intent(inout) :: iprn
788  character(len=*), intent(out) :: prfmt
789  logical, intent(in) :: prowcolnum
790  integer(I4B), intent(out) :: ncpl, ndig
791  ! -- local
792  integer(I4B) :: nwidp
793  character(len=1) :: editdesc
794  !
795  if (iprn < 0) then
796  prfmt = ''
797  return
798  end if
799  !
800  if (iprn > 21) iprn = 0
801  !
802  select case (iprn)
803  case (0)
804  ncpl = 10
805  editdesc = 'G'
806  nwidp = 11
807  ndig = 4
808  case (1)
809  ncpl = 11
810  editdesc = 'G'
811  nwidp = 10
812  ndig = 3
813  case (2)
814  ncpl = 9
815  editdesc = 'G'
816  nwidp = 13
817  ndig = 6
818  case (3)
819  ncpl = 15
820  editdesc = 'F'
821  nwidp = 7
822  ndig = 1
823  case (4)
824  ncpl = 15
825  editdesc = 'F'
826  nwidp = 7
827  ndig = 2
828  case (5)
829  ncpl = 15
830  editdesc = 'F'
831  nwidp = 7
832  ndig = 3
833  case (6)
834  ncpl = 15
835  editdesc = 'F'
836  nwidp = 7
837  ndig = 4
838  case (7)
839  ncpl = 20
840  editdesc = 'F'
841  nwidp = 5
842  ndig = 0
843  case (8)
844  ncpl = 20
845  editdesc = 'F'
846  nwidp = 5
847  ndig = 1
848  case (9)
849  ncpl = 20
850  editdesc = 'F'
851  nwidp = 5
852  ndig = 2
853  case (10)
854  ncpl = 20
855  editdesc = 'F'
856  nwidp = 5
857  ndig = 3
858  case (11)
859  ncpl = 20
860  editdesc = 'F'
861  nwidp = 5
862  ndig = 4
863  case (12)
864  ncpl = 10
865  editdesc = 'G'
866  nwidp = 11
867  ndig = 4
868  case (13)
869  ncpl = 10
870  editdesc = 'F'
871  nwidp = 6
872  ndig = 0
873  case (14)
874  ncpl = 10
875  editdesc = 'F'
876  nwidp = 6
877  ndig = 1
878  case (15)
879  ncpl = 10
880  editdesc = 'F'
881  nwidp = 6
882  ndig = 2
883  case (16)
884  ncpl = 10
885  editdesc = 'F'
886  nwidp = 6
887  ndig = 3
888  case (17)
889  ncpl = 10
890  editdesc = 'F'
891  nwidp = 6
892  ndig = 4
893  case (18)
894  ncpl = 10
895  editdesc = 'F'
896  nwidp = 6
897  ndig = 5
898  case (19)
899  ncpl = 5
900  editdesc = 'G'
901  nwidp = 12
902  ndig = 5
903  case (20)
904  ncpl = 6
905  editdesc = 'G'
906  nwidp = 11
907  ndig = 4
908  case (21)
909  ncpl = 7
910  editdesc = 'G'
911  nwidp = 9
912  ndig = 2
913  end select
914  !
915  if (editdesc == 'F') then
916  call buildfixedformat(ncpl, nwidp, ndig, prfmt, prowcolnum)
917  else
918  call buildfloatformat(ncpl, nwidp, ndig, editdesc, prfmt, prowcolnum)
919  end if
920  !
921  ndig = nwidp + 1
Here is the call graph for this function:
Here is the caller graph for this function:

◆ build_format_int()

subroutine arrayreadersmodule::build_format_int ( integer(i4b), intent(inout)  iprn,
character(len=*), intent(out)  prfmt,
logical, intent(in)  prowcolnum,
integer(i4b), intent(out)  ncpl,
integer(i4b), intent(out)  ndig 
)
private

Definition at line 730 of file ArrayReaders.f90.

731  ! -- Build a print format for integers based on IPRN.
732  ! -- dummy
733  integer(I4B), intent(inout) :: iprn
734  character(len=*), intent(out) :: prfmt
735  logical, intent(in) :: prowcolnum
736  integer(I4B), intent(out) :: ncpl, ndig
737  ! -- local
738  integer(I4B) :: nwidp
739  !
740  if (iprn < 0) then
741  prfmt = ''
742  return
743  end if
744  !
745  if (iprn > 9) iprn = 0
746  !
747  select case (iprn)
748  case (0)
749  ncpl = 10
750  nwidp = 11
751  case (1)
752  ncpl = 60
753  nwidp = 1
754  case (2)
755  ncpl = 40
756  nwidp = 2
757  case (3)
758  ncpl = 30
759  nwidp = 3
760  case (4)
761  ncpl = 25
762  nwidp = 4
763  case (5)
764  ncpl = 20
765  nwidp = 5
766  case (6)
767  ncpl = 10
768  nwidp = 11
769  case (7)
770  ncpl = 25
771  nwidp = 2
772  case (8)
773  ncpl = 15
774  nwidp = 4
775  case (9)
776  ncpl = 19
777  nwidp = 6
778  end select
779  !
780  call buildintformat(ncpl, nwidp, prfmt, prowcolnum)
781  ndig = nwidp + 1
Here is the call graph for this function:
Here is the caller graph for this function:

◆ check_binary_size()

logical(lgp) function arrayreadersmodule::check_binary_size ( integer(i4b), intent(in)  nval,
integer(i4b), intent(in)  nvalt,
integer(i4b), intent(in)  arrsize,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  locat 
)
private

Check the size of the binary data that will be read relative to the unfilled elements in the array .

Parameters
[in]nvalnumber of array
[in]nvaltcurrent data index
[in]arrsizesize of the array
[in]anamename of array
[in]locatbinary file unit

Definition at line 1062 of file ArrayReaders.f90.

1063  ! -- dummy
1064  integer(I4B), intent(in) :: nval !< number of array
1065  integer(I4B), intent(in) :: nvalt !< current data index
1066  integer(I4B), intent(in) :: arrsize !< size of the array
1067  character(len=*), intent(in) :: aname !< name of array
1068  integer(I4B), intent(in) :: locat !< binary file unit
1069  !
1070  ! -- local variables
1071  logical(LGP) :: isok
1072  !
1073  ! -- initialize isok
1074  isok = .true.
1075  !
1076  if (nvalt + nval > arrsize) then
1077  write (errmsg, '(a,i0,a,1x,a,1x,a,i0,a,1x,i0,3(1x,a))') &
1078  'The size of the data array calculated from the binary header (', &
1079  nval, ') will exceed the remainder of the', trim(adjustl(aname)), &
1080  'data array (', arrsize, ') array by', nvalt + nval - arrsize, &
1081  'elements. This is usually caused by incorrect assignment of', &
1082  '(m1,m2,m3) in the binary header. See the mf6io.pdf document', &
1083  'for information on assigning (m1,m2,m3).'
1084  call store_error(errmsg)
1085  call store_error_unit(locat)
1086  isok = .false.
1087  end if
Here is the call graph for this function:
Here is the caller graph for this function:

◆ print_array_dbl()

subroutine arrayreadersmodule::print_array_dbl ( real(dp), dimension(jj, ii), intent(in)  darr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  jj,
integer(i4b), intent(in)  ii,
integer(i4b), intent(in)  k,
character(len=*), intent(in)  prfmt,
integer(i4b), intent(in)  ncpl,
integer(i4b), intent(in)  ndig,
logical, intent(in)  prowcolnum 
)
private

Definition at line 970 of file ArrayReaders.f90.

972  ! -- dummy
973  integer(I4B), intent(in) :: iout, jj, ii, k
974  integer(I4B), intent(in) :: ncpl ! # values to print per line
975  integer(I4B), intent(in) :: ndig ! # characters in each field
976  real(DP), dimension(jj, ii), intent(in) :: darr ! Real array to be printed
977  character(len=*), intent(in) :: aname ! Array name
978  character(len=*), intent(in) :: prfmt ! Print format, no row #
979  logical, intent(in) :: prowcolnum ! Print row & column numbers
980  ! -- local
981  integer(I4B) :: i, j
982  ! -- formats
983 2 format(/, 1x, a, 1x, 'FOR LAYER ', i0)
984 3 format(/, 1x, a)
985  !
986  if (iout <= 0) return
987  !
988  ! -- Write name of array
989  if (k > 0) then
990  write (iout, 2) trim(aname), k
991  else
992  write (iout, 3) trim(aname)
993  end if
994  !
995  ! -- Write array
996  if (prowcolnum) then
997  ! -- Write column/node numbers
998  call ucolno(1, jj, 4, ncpl, ndig, iout)
999  !
1000  ! -- Write array values, including row numbers
1001  do i = 1, ii
1002  write (iout, prfmt) i, (darr(j, i), j=1, jj)
1003  end do
1004  else
1005  if (ii > 1) then
1006  errmsg = 'Program error printing array '//trim(aname)// &
1007  ': ii > 1 when prowcolnum is false.'
1008  call store_error(errmsg, terminate=.true.)
1009  end if
1010  !
1011  ! -- Write array values, without row numbers
1012  write (iout, prfmt) (darr(j, 1), j=1, jj)
1013  end if
Here is the call graph for this function:
Here is the caller graph for this function:

◆ print_array_int()

subroutine arrayreadersmodule::print_array_int ( integer(i4b), dimension(jj, ii), intent(in)  iarr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  jj,
integer(i4b), intent(in)  ii,
integer(i4b), intent(in)  k,
character(len=*), intent(in)  prfmt,
integer(i4b), intent(in)  ncpl,
integer(i4b), intent(in)  ndig,
logical, intent(in)  prowcolnum 
)
private

Definition at line 924 of file ArrayReaders.f90.

926  ! -- dummy
927  integer(I4B), intent(in) :: iout, jj, ii, k
928  integer(I4B), intent(in) :: ncpl ! # values to print per line
929  integer(I4B), intent(in) :: ndig ! # characters in each field
930  integer(I4B), dimension(jj, ii), intent(in) :: iarr ! Integer array to be printed
931  character(len=*), intent(in) :: aname ! Array name
932  character(len=*), intent(in) :: prfmt ! Print format, no row #
933  logical, intent(in) :: prowcolnum ! Print row & column numbers
934  ! -- local
935  integer(I4B) :: i, j
936  ! -- formats
937 2 format(/, 1x, a, 1x, 'FOR LAYER ', i0)
938 3 format(/, 1x, a)
939  !
940  if (iout <= 0) return
941  !
942  ! -- Write name of array
943  if (k > 0) then
944  write (iout, 2) trim(aname), k
945  else
946  write (iout, 3) trim(aname)
947  end if
948  !
949  ! -- Write array
950  if (prowcolnum) then
951  ! -- Write column/node numbers
952  call ucolno(1, jj, 4, ncpl, ndig, iout)
953  !
954  ! -- Write array values, including row numbers
955  do i = 1, ii
956  write (iout, prfmt) i, (iarr(j, i), j=1, jj)
957  end do
958  else
959  if (ii > 1) then
960  errmsg = 'Program error printing array '//trim(aname)// &
961  ': ii > 1 when prowcolnum is false.'
962  call store_error(errmsg, terminate=.true.)
963  end if
964  !
965  ! -- Write array values, without row numbers
966  write (iout, prfmt) (iarr(j, 1), j=1, jj)
967  end if
Here is the call graph for this function:
Here is the caller graph for this function:

◆ read_array_dbl1d()

subroutine arrayreadersmodule::read_array_dbl1d ( integer(i4b), intent(in)  iu,
real(dp), dimension(jj), intent(inout)  darr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  jj,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  k 
)
private

Definition at line 288 of file ArrayReaders.f90.

289  ! -- dummy
290  integer(I4B), intent(in) :: iu, iout
291  integer(I4B), intent(in) :: jj
292  real(DP), dimension(jj), intent(inout) :: darr
293  character(len=*), intent(in) :: aname
294  integer(I4B), intent(in) :: ndim ! dis%ndim
295  integer(I4B), intent(in) :: k ! layer number; 0 to not print
296  ! -- local
297  logical(LGP) :: isok
298  integer(I4B) :: j, iclose, iprn, locat, ncpl, ndig
299  real(DP) :: cnstnt
300  logical :: prowcolnum
301  character(len=100) :: prfmt
302  integer(I4B) :: istat
303  integer(I4B) :: nvalt, nval
304  character(len=30) :: arrname
305  character(len=MAXCHARLEN) :: ermsgr
306  ! -- formats
307 2 format(/, 1x, a, ' = ', g14.7, ' FOR LAYER ', i0)
308 3 format(/, 1x, a, ' = ', g14.7)
309  !
310  ! -- Read array control record.
311  call read_control_dbl(iu, iout, aname, locat, cnstnt, iclose, iprn)
312  !
313  ! -- Read or assign array data.
314  if (locat == 0) then
315  ! -- Assign constant
316  do j = 1, jj
317  darr(j) = cnstnt
318  end do
319  if (iout > 0) then
320  if (k > 0) then
321  write (iout, 2) trim(aname), cnstnt, k
322  else
323  write (iout, 3) trim(aname), cnstnt
324  end if
325  end if
326  elseif (locat > 0) then
327  ! -- Read data as text
328  read (locat, *, iostat=istat, iomsg=ermsgr) (darr(j), j=1, jj)
329  if (istat /= 0) then
330  arrname = adjustl(aname)
331  errmsg = "Error reading data for array '"// &
332  trim(adjustl(arrname))//"'. "//trim(adjustl(ermsgr))
333  call store_error(errmsg)
334  call store_error_unit(locat)
335  end if
336  do j = 1, jj
337  darr(j) = darr(j) * cnstnt
338  end do
339  if (iclose == 1) then
340  close (locat)
341  end if
342  else
343  ! -- Read data as binary
344  locat = -locat
345  nvalt = 0
346  do
347  call read_binary_header(locat, iout, aname, nval)
348  isok = check_binary_size(nval, nvalt, size(darr), aname, locat)
349  if (isok .EQV. .false.) exit
350  read (locat, iostat=istat, iomsg=ermsgr) &
351  (darr(j), j=nvalt + 1, nvalt + nval)
352  if (istat /= 0) then
353  arrname = adjustl(aname)
354  errmsg = "Error reading data for array '"// &
355  trim(adjustl(arrname))//"'. "//trim(adjustl(ermsgr))
356  call store_error(errmsg)
357  call store_error_unit(locat)
358  end if
359  nvalt = nvalt + nval
360  if (nvalt == size(darr)) exit
361  end do
362  !
363  ! -- multiply entire array by constant
364  do j = 1, jj
365  darr(j) = darr(j) * cnstnt
366  end do
367  !
368  ! -- close the file
369  if (iclose == 1) then
370  close (locat)
371  end if
372  end if
373  !
374  ! -- Print array if requested.
375  if (iprn >= 0 .and. locat /= 0) then
376  prowcolnum = (ndim == 3)
377  call build_format_dbl(iprn, prfmt, prowcolnum, ncpl, ndig)
378  call print_array_dbl(darr, aname, iout, jj, 1, k, prfmt, ncpl, ndig, &
379  prowcolnum)
380  end if
Here is the caller graph for this function:

◆ read_array_dbl1d_layered()

subroutine arrayreadersmodule::read_array_dbl1d_layered ( integer(i4b), intent(in)  iu,
real(dp), dimension(nval), intent(inout)  darr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  ncol,
integer(i4b), intent(in)  nrow,
integer(i4b), intent(in)  nlay,
integer(i4b), intent(in)  nval,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  k1,
integer(i4b), intent(in)  k2 
)
private

Definition at line 511 of file ArrayReaders.f90.

513  ! -- dummy
514  integer(I4B), intent(in) :: iu, iout
515  integer(I4B), intent(in) :: ncol, nrow, nlay, nval
516  real(DP), dimension(nval), intent(inout) :: darr
517  character(len=*), intent(in) :: aname
518  integer(I4B), intent(in) :: ndim ! dis%ndim
519  integer(I4B), intent(in) :: k1, k2
520  ! -- local
521  !
522  call read_array_dbl3d(iu, darr, aname, ndim, ncol, nrow, nlay, iout, k1, k2)

◆ read_array_dbl2d()

subroutine arrayreadersmodule::read_array_dbl2d ( integer(i4b), intent(in)  iu,
real(dp), dimension(jj, ii), intent(inout)  darr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  jj,
integer(i4b), intent(in)  ii,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  k 
)
private

Definition at line 383 of file ArrayReaders.f90.

384  ! -- dummy
385  integer(I4B), intent(in) :: iu, iout
386  integer(I4B), intent(in) :: jj, ii
387  real(DP), dimension(jj, ii), intent(inout) :: darr
388  character(len=*), intent(in) :: aname
389  integer(I4B), intent(in) :: ndim ! dis%ndim
390  integer(I4B), intent(in) :: k ! layer number; 0 to not print
391  ! -- local
392  logical(LGP) :: isok
393  integer(I4B) :: i, iclose, iprn, j, locat, ncpl, ndig
394  integer(I4B) :: nval
395  real(DP) :: cnstnt
396  logical :: prowcolnum
397  character(len=100) :: prfmt
398  integer(I4B) :: istat
399  character(len=30) :: arrname
400  character(len=MAXCHARLEN) :: ermsgr
401  ! -- formats
402 2 format(/, 1x, a, ' = ', g14.7, ' FOR LAYER ', i0)
403 3 format(/, 1x, a, ' = ', g14.7)
404  !
405  ! -- Read array control record.
406  call read_control_dbl(iu, iout, aname, locat, cnstnt, iclose, iprn)
407  !
408  ! -- Read or assign array data.
409  if (locat == 0) then
410  ! -- Assign constant
411  do i = 1, ii
412  do j = 1, jj
413  darr(j, i) = cnstnt
414  end do
415  end do
416  if (iout > 0) then
417  if (k > 0) then
418  write (iout, 2) trim(aname), cnstnt, k
419  else
420  write (iout, 3) trim(aname), cnstnt
421  end if
422  end if
423  elseif (locat > 0) then
424  ! -- Read data as text
425  do i = 1, ii
426  read (locat, *, iostat=istat, iomsg=ermsgr) (darr(j, i), j=1, jj)
427  if (istat /= 0) then
428  arrname = adjustl(aname)
429  errmsg = "Error reading data for array '"// &
430  trim(adjustl(arrname))//"'. "//trim(adjustl(ermsgr))
431  call store_error(errmsg)
432  call store_error_unit(locat)
433  end if
434  do j = 1, jj
435  darr(j, i) = darr(j, i) * cnstnt
436  end do
437  end do
438  if (iclose == 1) then
439  close (locat)
440  end if
441  else
442  ! -- Read data as binary
443  locat = -locat
444  call read_binary_header(locat, iout, aname, nval)
445  isok = check_binary_size(nval, 0, size(darr), aname, locat)
446  if (isok) then
447  do i = 1, ii
448  read (locat, iostat=istat, iomsg=ermsgr) (darr(j, i), j=1, jj)
449  if (istat /= 0) then
450  arrname = adjustl(aname)
451  errmsg = "Error reading data for array '"// &
452  trim(adjustl(arrname))//"'. "//trim(adjustl(ermsgr))
453  call store_error(errmsg)
454  call store_error_unit(locat)
455  end if
456  do j = 1, jj
457  darr(j, i) = darr(j, i) * cnstnt
458  end do
459  end do
460  end if
461  if (iclose == 1) then
462  close (locat)
463  end if
464  end if
465  !
466  ! -- Print array if requested.
467  if (iprn >= 0 .and. locat /= 0) then
468  prowcolnum = (ndim == 3)
469  call build_format_dbl(iprn, prfmt, prowcolnum, ncpl, ndig)
470  call print_array_dbl(darr, aname, iout, jj, ii, k, prfmt, ncpl, &
471  ndig, prowcolnum)
472  end if
Here is the caller graph for this function:

◆ read_array_dbl3d()

subroutine arrayreadersmodule::read_array_dbl3d ( integer(i4b), intent(in)  iu,
real(dp), dimension(ncol, nrow, nlay), intent(inout)  darr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  ncol,
integer(i4b), intent(in)  nrow,
integer(i4b), intent(in)  nlay,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  k1,
integer(i4b), intent(in)  k2 
)
private

Definition at line 475 of file ArrayReaders.f90.

477  integer(I4B), intent(in) :: iu
478  integer(I4B), intent(in) :: iout
479  integer(I4B), intent(in) :: ndim
480  integer(I4B), intent(in) :: ncol
481  integer(I4B), intent(in) :: nrow
482  integer(I4B), intent(in) :: nlay
483  integer(I4B), intent(in) :: k1, k2
484  real(DP), dimension(ncol, nrow, nlay), intent(inout) :: darr
485  character(len=*), intent(in) :: aname
486  ! -- local
487  integer(I4B) :: k, kk
488  !
489  do k = k1, k2
490  if (k <= 0) then
491  kk = 1
492  else
493  kk = k
494  end if
495  call read_array_dbl2d(iu, darr(:, :, kk), aname, ndim, ncol, nrow, iout, k)
496  end do
Here is the caller graph for this function:

◆ read_array_dbl3d_all()

subroutine arrayreadersmodule::read_array_dbl3d_all ( integer(i4b), intent(in)  iu,
real(dp), dimension(nvals, 1, 1), intent(inout)  darr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  nvals,
integer(i4b), intent(in)  iout 
)
private

Definition at line 499 of file ArrayReaders.f90.

500  integer(I4B), intent(in) :: iu
501  integer(I4B), intent(in) :: iout
502  integer(I4B), intent(in) :: ndim
503  integer(I4B), intent(in) :: nvals
504  real(DP), dimension(nvals, 1, 1), intent(inout) :: darr
505  character(len=*), intent(in) :: aname
506  ! -- local
507  !
508  call read_array_dbl1d(iu, darr, aname, ndim, nvals, iout, 0)

◆ read_array_int1d()

subroutine arrayreadersmodule::read_array_int1d ( integer(i4b), intent(in)  iu,
integer(i4b), dimension(jj), intent(inout)  iarr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  jj,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  k 
)
private

Definition at line 52 of file ArrayReaders.f90.

53  ! -- dummy
54  integer(I4B), intent(in) :: iu, iout
55  integer(I4B), intent(in) :: jj
56  integer(I4B), dimension(jj), intent(inout) :: iarr
57  character(len=*), intent(in) :: aname
58  integer(I4B), intent(in) :: ndim ! dis%ndim
59  integer(I4B), intent(in) :: k ! layer number; 0 to not print
60  ! -- local
61  logical(LGP) :: isok
62  integer(I4B) :: iclose, iconst, iprn, j, locat, ncpl, ndig
63  integer(I4B) :: nval, nvalt
64  logical :: prowcolnum
65  character(len=100) :: prfmt
66  integer(I4B) :: istat
67  character(len=30) :: arrname
68  character(len=MAXCHARLEN) :: ermsgr
69  ! -- formats
70 2 format(/, 1x, a, ' = ', i0, ' FOR LAYER ', i0)
71 3 format(/, 1x, a, ' = ', i0)
72  !
73  ! -- Read array control record.
74  call read_control_int(iu, iout, aname, locat, iconst, iclose, iprn)
75  !
76  ! -- Read or assign array data.
77  if (locat == 0) then
78  ! -- Assign constant
79  do j = 1, jj
80  iarr(j) = iconst
81  end do
82  if (iout > 0) then
83  if (k > 0) then
84  write (iout, 2) trim(aname), iconst, k
85  else
86  write (iout, 3) trim(aname), iconst
87  end if
88  end if
89  elseif (locat > 0) then
90  ! -- Read data as text
91  read (locat, *, iostat=istat, iomsg=ermsgr) (iarr(j), j=1, jj)
92  if (istat /= 0) then
93  arrname = adjustl(aname)
94  errmsg = "Error reading data for array '"//trim(arrname)// &
95  "'. "//trim(adjustl(ermsgr))
96  call store_error(errmsg)
97  call store_error_unit(locat)
98  end if
99  do j = 1, jj
100  iarr(j) = iarr(j) * iconst
101  end do
102  if (iclose == 1) then
103  close (locat)
104  end if
105  else
106  ! -- Read data as binary
107  locat = -locat
108  nvalt = 0
109  do
110  call read_binary_header(locat, iout, aname, nval)
111  isok = check_binary_size(nval, nvalt, size(iarr), aname, locat)
112  if (isok .EQV. .false.) exit
113  read (locat, iostat=istat, iomsg=ermsgr) &
114  (iarr(j), j=nvalt + 1, nvalt + nval)
115  if (istat /= 0) then
116  arrname = adjustl(aname)
117  errmsg = "Error reading data for array '"//trim(arrname)// &
118  "'. "//trim(adjustl(ermsgr))
119  call store_error(errmsg)
120  call store_error_unit(locat)
121  end if
122  nvalt = nvalt + nval
123  if (nvalt == size(iarr)) exit
124  end do
125  !
126  ! -- multiply array by constant
127  do j = 1, jj
128  iarr(j) = iarr(j) * iconst
129  end do
130  !
131  ! -- close the file
132  if (iclose == 1) then
133  close (locat)
134  end if
135  end if
136  !
137  ! -- Print array if requested.
138  if (iprn >= 0 .and. locat /= 0) then
139  prowcolnum = (ndim == 3)
140  call build_format_int(iprn, prfmt, prowcolnum, ncpl, ndig)
141  call print_array_int(iarr, aname, iout, jj, 1, k, prfmt, ncpl, ndig, &
142  prowcolnum)
143  end if
Here is the caller graph for this function:

◆ read_array_int1d_layered()

subroutine arrayreadersmodule::read_array_int1d_layered ( integer(i4b), intent(in)  iu,
integer(i4b), dimension(nval), intent(inout)  iarr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  ncol,
integer(i4b), intent(in)  nrow,
integer(i4b), intent(in)  nlay,
integer(i4b), intent(in)  nval,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  k1,
integer(i4b), intent(in)  k2 
)
private

Definition at line 272 of file ArrayReaders.f90.

274  ! -- dummy
275  integer(I4B), intent(in) :: iu, iout
276  integer(I4B), intent(in) :: ncol, nrow, nlay, nval
277  integer(I4B), dimension(nval), intent(inout) :: iarr
278  character(len=*), intent(in) :: aname
279  integer(I4B), intent(in) :: ndim ! dis%ndim
280  integer(I4B), intent(in) :: k1, k2
281  ! -- local
282  !
283  call read_array_int3d(iu, iarr, aname, ndim, ncol, nrow, nlay, iout, k1, k2)

◆ read_array_int2d()

subroutine arrayreadersmodule::read_array_int2d ( integer(i4b), intent(in)  iu,
integer(i4b), dimension(jj, ii), intent(inout)  iarr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  jj,
integer(i4b), intent(in)  ii,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  k 
)
private

Definition at line 146 of file ArrayReaders.f90.

147  ! -- dummy
148  integer(I4B), intent(in) :: iu, iout
149  integer(I4B), intent(in) :: jj, ii
150  integer(I4B), dimension(jj, ii), intent(inout) :: iarr
151  character(len=*), intent(in) :: aname
152  integer(I4B), intent(in) :: ndim ! dis%ndim
153  integer(I4B), intent(in) :: k ! layer number; 0 to not print
154  ! -- local
155  logical(LGP) :: isok
156  integer(I4B) :: i, iclose, iconst, iprn, j, locat, ncpl, ndig
157  integer(I4B) :: nval
158  logical :: prowcolnum
159  character(len=100) :: prfmt
160  integer(I4B) :: istat
161  character(len=30) :: arrname
162  character(len=MAXCHARLEN) :: ermsgr
163  ! -- formats
164 2 format(/, 1x, a, ' = ', i0, ' FOR LAYER ', i0)
165 3 format(/, 1x, a, ' = ', i0)
166  !
167  ! -- Read array control record.
168  call read_control_int(iu, iout, aname, locat, iconst, iclose, iprn)
169  !
170  ! -- Read or assign array data.
171  if (locat == 0) then
172  ! -- Assign constant
173  do i = 1, ii
174  do j = 1, jj
175  iarr(j, i) = iconst
176  end do
177  end do
178  if (iout > 0) then
179  if (k > 0) then
180  write (iout, 2) trim(aname), iconst, k
181  else
182  write (iout, 3) trim(aname), iconst
183  end if
184  end if
185  elseif (locat > 0) then
186  ! -- Read data as text
187  do i = 1, ii
188  read (locat, *, iostat=istat, iomsg=ermsgr) (iarr(j, i), j=1, jj)
189  if (istat /= 0) then
190  arrname = adjustl(aname)
191  errmsg = "Error reading data for array '"//trim(arrname)// &
192  "'. "//trim(adjustl(ermsgr))
193  call store_error(errmsg)
194  call store_error_unit(locat)
195  end if
196  do j = 1, jj
197  iarr(j, i) = iarr(j, i) * iconst
198  end do
199  end do
200  if (iclose == 1) then
201  close (locat)
202  end if
203  else
204  ! -- Read data as binary
205  locat = -locat
206  call read_binary_header(locat, iout, aname, nval)
207  isok = check_binary_size(nval, 0, size(iarr), aname, locat)
208  if (isok) then
209  do i = 1, ii
210  read (locat, iostat=istat, iomsg=ermsgr) (iarr(j, i), j=1, jj)
211  if (istat /= 0) then
212  arrname = adjustl(aname)
213  errmsg = "Error reading data for array '"//trim(arrname)// &
214  "'. "//trim(adjustl(ermsgr))
215  call store_error(errmsg)
216  call store_error_unit(locat)
217  end if
218  do j = 1, jj
219  iarr(j, i) = iarr(j, i) * iconst
220  end do
221  end do
222  end if
223  if (iclose == 1) then
224  close (locat)
225  end if
226  end if
227  !
228  ! -- Print array if requested.
229  if (iprn >= 0 .and. locat /= 0) then
230  prowcolnum = (ndim == 3)
231  call build_format_int(iprn, prfmt, prowcolnum, ncpl, ndig)
232  call print_array_int(iarr, aname, iout, jj, ii, k, prfmt, ncpl, &
233  ndig, prowcolnum)
234  end if
Here is the caller graph for this function:

◆ read_array_int3d()

subroutine arrayreadersmodule::read_array_int3d ( integer(i4b), intent(in)  iu,
integer(i4b), dimension(ncol, nrow, nlay), intent(inout)  iarr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  ncol,
integer(i4b), intent(in)  nrow,
integer(i4b), intent(in)  nlay,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  k1,
integer(i4b), intent(in)  k2 
)
private

Definition at line 237 of file ArrayReaders.f90.

239  integer(I4B), intent(in) :: iu
240  integer(I4B), intent(in) :: iout
241  integer(I4B), intent(in) :: ndim
242  integer(I4B), intent(in) :: ncol
243  integer(I4B), intent(in) :: nrow
244  integer(I4B), intent(in) :: nlay
245  integer(I4B), intent(in) :: k1, k2
246  integer(I4B), dimension(ncol, nrow, nlay), intent(inout) :: iarr
247  character(len=*), intent(in) :: aname
248  ! -- local
249  integer(I4B) :: k, kk
250  do k = k1, k2
251  if (k <= 0) then
252  kk = 1
253  else
254  kk = k
255  end if
256  call read_array_int2d(iu, iarr(:, :, kk), aname, ndim, ncol, nrow, iout, k)
257  end do
Here is the caller graph for this function:

◆ read_array_int3d_all()

subroutine arrayreadersmodule::read_array_int3d_all ( integer(i4b), intent(in)  iu,
integer(i4b), dimension(nvals, 1, 1), intent(inout)  iarr,
character(len=*), intent(in)  aname,
integer(i4b), intent(in)  ndim,
integer(i4b), intent(in)  nvals,
integer(i4b), intent(in)  iout 
)
private

Definition at line 260 of file ArrayReaders.f90.

261  integer(I4B), intent(in) :: iu
262  integer(I4B), intent(in) :: iout
263  integer(I4B), intent(in) :: ndim
264  integer(I4B), intent(in) :: nvals
265  integer(I4B), dimension(nvals, 1, 1), intent(inout) :: iarr
266  character(len=*), intent(in) :: aname
267  ! -- local
268  !
269  call read_array_int1d(iu, iarr, aname, ndim, nvals, iout, 0)

◆ read_binary_header()

subroutine, public arrayreadersmodule::read_binary_header ( integer(i4b), intent(in)  locat,
integer(i4b), intent(in)  iout,
character(len=*), intent(in)  arrname,
integer, intent(out)  nval 
)

Definition at line 1016 of file ArrayReaders.f90.

1017  ! -- dummy
1018  integer(I4B), intent(in) :: locat
1019  integer(I4B), intent(in) :: iout
1020  character(len=*), intent(in) :: arrname
1021  integer, intent(out) :: nval
1022  ! -- local
1023  integer(I4B) :: istat
1024  integer(I4B) :: kstp, kper, m1, m2, m3
1025  real(DP) :: pertim, totim
1026  character(len=16) :: text
1027  character(len=MAXCHARLEN) :: ermsgr
1028  character(len=*), parameter :: fmthdr = &
1029  "(/,1X,'HEADER FROM BINARY FILE HAS FOLLOWING ENTRIES',&
1030  &/,4X,'KSTP: ',I0,' KPER: ',I0,&
1031  &/,4x,'PERTIM: ',G0,' TOTIM: ',G0,&
1032  &/,4X,'TEXT: ',A,&
1033  &/,4X,'MSIZE 1: ',I0,' MSIZE 2: ',I0,' MSIZE 3: ',I0)"
1034  !
1035  ! -- Read the header line from the binary file
1036  read (locat, iostat=istat, iomsg=ermsgr) kstp, kper, pertim, totim, text, &
1037  m1, m2, m3
1038  !
1039  ! -- Check for errors
1040  if (istat /= 0) then
1041  errmsg = "Error reading data for array '"//adjustl(trim(arrname))// &
1042  "'. "//trim(adjustl(ermsgr))
1043  call store_error(errmsg)
1044  call store_error_unit(locat)
1045  end if
1046  !
1047  ! -- Write message about the binary header
1048  if (iout > 0) then
1049  write (iout, fmthdr) kstp, kper, pertim, totim, text, m1, m2, m3
1050  end if
1051  !
1052  ! -- Assign the number of values that follow the header
1053  nval = m1 * m2
Here is the call graph for this function:
Here is the caller graph for this function:

◆ read_control_1()

subroutine arrayreadersmodule::read_control_1 ( integer(i4b), intent(in)  iu,
integer(i4b), intent(in)  iout,
character(len=*), intent(in)  aname,
integer(i4b), intent(out)  locat,
integer(i4b), intent(out)  iclose,
character(len=:), intent(inout), allocatable  line,
integer(i4b), intent(inout)  icol,
character(len=*), intent(inout)  fname 
)
private

Definition at line 622 of file ArrayReaders.f90.

623  use simmodule, only: ustop
624  ! -- Read CONSTANT, INTERNAL, or OPEN/CLOSE from array control record.
625  ! -- dummy
626  integer(I4B), intent(in) :: iu
627  integer(I4B), intent(in) :: iout
628  character(len=*), intent(in) :: aname
629  integer(I4B), intent(out) :: locat
630  integer(I4B), intent(out) :: iclose
631  character(len=:), allocatable, intent(inout) :: line
632  integer(I4B), intent(inout) :: icol
633  character(len=*), intent(inout) :: fname
634 
635  ! -- local
636  integer(I4B) :: istart, istop, n
637  integer(I4B) :: ierr
638  real(DP) :: r
639  !
640  ! -- Read array control record. Any future refactoring
641  ! should use the LongLineReader here instead of u9rdcom
642  call u9rdcom(iu, iout, line, ierr)
643  !
644  iclose = 0
645  icol = 1
646  ! -- Read first token of array control record.
647  call urword(line, icol, istart, istop, 1, n, r, iout, iu)
648  if (line(istart:istop) .eq. 'CONSTANT') then
649  locat = 0
650  elseif (line(istart:istop) .eq. 'INTERNAL') then
651  locat = iu
652  elseif (line(istart:istop) .eq. 'OPEN/CLOSE') then
653  call urword(line, icol, istart, istop, 0, n, r, iout, iu)
654  fname = line(istart:istop)
655  locat = -1
656  iclose = 1
657  else
658  errmsg = 'READING CONTROL RECORD FOR '// &
659  trim(adjustl(aname))//"'. "// &
660  'Use CONSTANT, INTERNAL, or OPEN/CLOSE.'
661  call store_error(errmsg)
662  call store_error_unit(iu)
663  end if
simmodule
This module contains simulation methods.
Definition: Sim.f90:10
simmodule::ustop
subroutine, public ustop(stopmess, ioutlocal)
Stop the simulation.
Definition: Sim.f90:312
Here is the call graph for this function:
Here is the caller graph for this function:

◆ read_control_2()

subroutine arrayreadersmodule::read_control_2 ( integer(i4b), intent(in)  iu,
integer(i4b), intent(in)  iout,
character(len=*), intent(in)  fname,
character(len=*), intent(inout)  line,
integer(i4b), intent(inout)  icol,
integer(i4b), intent(inout)  locat,
integer(i4b), intent(in)  iclose,
integer(i4b), intent(inout)  iprn 
)

Definition at line 666 of file ArrayReaders.f90.

668  ! -- Read (BINARY) and IPRN options from array control record,
669  ! and open an OPEN/CLOSE file if specified.
670  ! -- dummy
671  integer(I4B), intent(in) :: iu, iout, iclose
672  character(len=*), intent(in) :: fname
673  character(len=*), intent(inout) :: line
674  integer(I4B), intent(inout) :: icol, iprn, locat
675  ! -- local
676  integer(I4B) :: i, n, istart, istop, lenkey
677  real(DP) :: r
678  character(len=MAXCHARLEN) :: keyword
679  logical :: binary
680  !
681  iprn = -1 ! Printing is turned off by default
682  binary = .false.
683  !
684  if (locat .ne. 0) then
685  ! -- CONSTANT has not been specified; array data will be read.
686  ! -- Read at most two options.
687  do i = 1, 2
688  call urword(line, icol, istart, istop, 1, n, r, iout, iu)
689  keyword = line(istart:istop)
690  lenkey = len_trim(keyword)
691  select case (keyword)
692  case ('(BINARY)')
693  if (iclose == 0) then
694  errmsg = '"(BINARY)" option for array input is valid only if'// &
695  ' OPEN/CLOSE is also specified.'
696  call store_error(errmsg)
697  call store_error_unit(iu)
698  end if
699  binary = .true.
700  case ('IPRN')
701  ! -- Read IPRN value
702  call urword(line, icol, istart, istop, 2, iprn, r, iout, iu)
703  exit
704  case ('')
705  exit
706  case default
707  errmsg = 'Invalid option found in array-control record: "' &
708  //trim(keyword)//'"'
709  call store_error(errmsg)
710  call store_error_unit(iu)
711  end select
712  end do
713  !
714  if (iclose == 0) then
715  ! -- Array data will be read from current input file.
716  locat = iu
717  else
718  ! -- Open the OPEN\CLOSE file
719  if (binary) then
720  call openfile(locat, iout, fname, 'OPEN/CLOSE', fmtarg_opt=form, &
721  accarg_opt=access)
722  locat = -locat
723  else
724  call openfile(locat, iout, fname, 'OPEN/CLOSE')
725  end if
726  end if
727  end if
Here is the call graph for this function:
Here is the caller graph for this function:

◆ read_control_dbl()

subroutine arrayreadersmodule::read_control_dbl ( integer(i4b), intent(in)  iu,
integer(i4b), intent(in)  iout,
character(len=*), intent(in)  aname,
integer(i4b), intent(out)  locat,
real(dp), intent(out)  cnstnt,
integer(i4b), intent(out)  iclose,
integer(i4b), intent(out)  iprn 
)
private

Definition at line 574 of file ArrayReaders.f90.

576  ! Read an array-control record for a double-precision array.
577  ! Open an input file if needed.
578  ! If CONSTANT is specified in input, locat is returned as 0.
579  ! If (BINARY) is specified, locat is returned as the negative of
580  ! the unit number opened for binary read.
581  ! If OPEN/CLOSE is specified, iclose is returned as 1, otherwise 0.
582  ! -- dummy
583  integer(I4B), intent(in) :: iu
584  integer(I4B), intent(in) :: iout
585  character(len=*), intent(in) :: aname
586  integer(I4B), intent(out) :: locat
587  real(DP), intent(out) :: cnstnt
588  integer(I4B), intent(out) :: iclose
589  integer(I4B), intent(out) :: iprn
590  !
591  ! -- local
592  integer(I4B) :: icol, icol1, istart, istop, n
593  real(DP) :: r
594  character(len=MAXCHARLEN) :: fname
595  character(len=:), allocatable :: line
596  !
597  ! -- Read CONSTANT, INTERNAL, or OPEN/CLOSE from array control record.
598  call read_control_1(iu, iout, aname, locat, iclose, line, icol, fname)
599  if (locat == 0) then
600  ! CONSTANT was found -- read value and return
601  call urword(line, icol, istart, istop, 3, n, cnstnt, iout, iu)
602  iprn = -1
603  return
604  end if
605  icol1 = icol
606  cnstnt = done
607  !
608  ! -- Read FACTOR option from array control record.
609  call urword(line, icol, istart, istop, 1, n, r, iout, iu)
610  if (line(istart:istop) == 'FACTOR') then
611  call urword(line, icol, istart, istop, 3, n, cnstnt, iout, iu)
612  if (cnstnt == dzero) cnstnt = done
613  else
614  icol = icol1
615  end if
616  !
617  ! -- Read (BINARY) and IPRN options from array control record,
618  ! and open an OPEN/CLOSE file if specified.
619  call read_control_2(iu, iout, fname, line, icol, locat, iclose, iprn)
Here is the call graph for this function:
Here is the caller graph for this function:

◆ read_control_int()

subroutine arrayreadersmodule::read_control_int ( integer(i4b), intent(in)  iu,
integer(i4b), intent(in)  iout,
character(len=*), intent(in)  aname,
integer(i4b), intent(out)  locat,
integer(i4b), intent(out)  iconst,
integer(i4b), intent(out)  iclose,
integer(i4b), intent(out)  iprn 
)
private

Definition at line 527 of file ArrayReaders.f90.

529  ! Read an array-control record for an integer array.
530  ! Open an input file if needed.
531  ! If CONSTANT is specified in input, locat is returned as 0.
532  ! If (BINARY) is specified, locat is returned as the negative of
533  ! the unit number opened for binary read.
534  ! If OPEN/CLOSE is specified, iclose is returned as 1, otherwise 0.
535  ! -- dummy
536  integer(I4B), intent(in) :: iu
537  integer(I4B), intent(in) :: iout
538  character(len=*), intent(in) :: aname
539  integer(I4B), intent(out) :: locat
540  integer(I4B), intent(out) :: iconst
541  integer(I4B), intent(out) :: iclose
542  integer(I4B), intent(out) :: iprn
543  ! -- local
544  integer(I4B) :: icol, icol1, istart, istop, n
545  real(DP) :: r
546  character(len=MAXCHARLEN) :: fname
547  character(len=:), allocatable :: line
548  !
549  ! -- Read CONSTANT, INTERNAL, or OPEN/CLOSE from array control record.
550  call read_control_1(iu, iout, aname, locat, iclose, line, icol, fname)
551  if (locat == 0) then
552  ! CONSTANT was found -- read value and return
553  call urword(line, icol, istart, istop, 2, iconst, r, iout, iu)
554  iprn = -1
555  return
556  end if
557  icol1 = icol
558  iconst = 1
559  !
560  ! -- Read FACTOR option from array control record.
561  call urword(line, icol, istart, istop, 1, n, r, iout, iu)
562  if (line(istart:istop) == 'FACTOR') then
563  call urword(line, icol, istart, istop, 2, iconst, r, iout, iu)
564  if (iconst == 0) iconst = 1
565  else
566  icol = icol1
567  end if
568  !
569  ! -- Read (BINARY) and IPRN options from array control record,
570  ! and open an OPEN/CLOSE file if specified.
571  call read_control_2(iu, iout, fname, line, icol, locat, iclose, iprn)
Here is the call graph for this function:
Here is the caller graph for this function: