378 class(ListReaderType) :: this
380 integer(I4B) :: mxlist, ldim, naux
381 integer(I4B) :: ii, jj, idum, nod, istat, increment
383 integer(I4B),
dimension(:),
allocatable :: cellid
384 character(len=LINELENGTH) :: fname
386 character(len=*),
parameter :: fmtmxlsterronly = &
387 "('Error reading list. The number of records encountered exceeds &
388 &the maximum number of records. Number of records found is ',I0,&
389 &' but MAXBOUND is ', I0, '. Try increasing MAXBOUND for this list. &
390 &Error occurred reading the following line: ', a, 5x, '>>> ', a)"
393 mxlist =
size(this%rlist, 2)
394 ldim =
size(this%rlist, 1)
395 naux =
size(this%auxvar, 1)
400 allocate (cellid(this%ndim))
407 call this%line_reader%rdcom(this%inlist, 0, this%line, this%ierr)
411 if (this%nlist < 0)
then
413 call urword(this%line, this%lloc, this%istart, this%istop, 1, idum, r, &
414 this%iout, this%inlist)
415 if (this%line(this%istart:this%istop) ==
'END' .or. this%ierr < 0)
then
418 if (this%ierr == 0)
then
419 call this%line_reader%bkspc(this%inlist)
427 if (ii > mxlist)
then
428 inquire (unit=this%inlist, name=fname)
429 write (errmsg, fmtmxlsterronly) &
430 ii, mxlist, new_line(
"A"), trim(this%line)
431 call store_error(errmsg)
432 call store_error_unit(this%inlist)
439 call urword(this%line, this%lloc, this%istart, this%istop, 2, &
440 cellid(1), r, this%iout, this%inlist)
441 if (this%ndim > 1)
then
442 call urword(this%line, this%lloc, this%istart, this%istop, 2, &
443 cellid(2), r, this%iout, this%inlist)
445 if (this%ndim > 2)
then
446 call urword(this%line, this%lloc, this%istart, this%istop, 2, &
447 cellid(3), r, this%iout, this%inlist)
451 call check_cellid(ii, cellid, this%mshape, this%ndim)
454 if (this%ndim == 3)
then
455 nod = get_node(cellid(1), cellid(2), cellid(3), &
456 this%mshape(1), this%mshape(2), this%mshape(3))
457 elseif (this%ndim == 2)
then
458 nod = get_node(cellid(1), 1, cellid(2), &
459 this%mshape(1), 1, this%mshape(2))
465 this%nodelist(ii) = nod
469 call urword(this%line, this%lloc, this%istart, this%istop, 0, idum, &
470 r, this%iout, this%inlist)
471 read (this%line(this%istart:this%istop), *, iostat=istat) r
476 this%rlist(jj, ii) = r
478 this%rlist(jj, ii) =
dzero
479 this%ntxtrlist = this%ntxtrlist + 1
480 if (this%ntxtrlist >
size(this%txtrlist))
then
481 increment = int(
size(this%txtrlist) * 0.2)
482 increment = max(100, increment)
487 this%txtrlist(this%ntxtrlist) = this%line(this%istart:this%istop)
488 this%idxtxtrow(this%ntxtrlist) = ii
489 this%idxtxtcol(this%ntxtrlist) = jj
496 call urword(this%line, this%lloc, this%istart, this%istop, 0, idum, &
497 r, this%iout, this%inlist)
498 read (this%line(this%istart:this%istop), *, iostat=istat) r
503 this%auxvar(jj, ii) = r
505 this%auxvar(jj, ii) =
dzero
506 this%ntxtauxvar = this%ntxtauxvar + 1
507 if (this%ntxtauxvar >
size(this%txtauxvar))
then
508 increment = int(
size(this%txtauxvar) * 0.2)
509 increment = max(100, increment)
514 this%txtauxvar(this%ntxtauxvar) = this%line(this%istart:this%istop)
515 this%idxtxtauxrow(this%ntxtauxvar) = ii
516 this%idxtxtauxcol(this%ntxtauxvar) = jj
517 if (len_trim(this%txtauxvar(this%ntxtauxvar)) == 0)
then
518 write (errmsg,
'(a,i0,a)')
'Auxiliary data or time series name &
519 &expected but not found in period &
520 &block "',
kper,
'".'
521 call store_error(errmsg)
522 call store_error_unit(this%inlist)
529 if (this%inamedbound > 0)
then
530 call urword(this%line, this%lloc, this%istart, this%istop, 1, idum, r, &
531 this%iout, this%inlist)
532 this%boundname(ii) = this%line(this%istart:this%istop)
536 if (this%nlist > 0)
then
537 if (ii == this%nlist)
exit readloop
546 if (count_errors() > 0)
then
547 call store_error_unit(this%inlist)
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenboundname
maximum length of a bound name
real(dp), parameter dzero
real constant zero
integer(i4b), pointer, public kper
current stress period number