266 class(DisConnExchangeType) :: this
267 integer(I4B),
intent(in) :: iout
269 integer(I4B),
dimension(:, :),
contiguous,
pointer :: cellidm1
270 integer(I4B),
dimension(:, :),
contiguous,
pointer :: cellidm2
271 integer(I4B),
dimension(:),
contiguous,
pointer :: ihc
272 real(DP),
dimension(:),
contiguous,
pointer :: cl1
273 real(DP),
dimension(:),
contiguous,
pointer :: cl2
274 real(DP),
dimension(:),
contiguous,
pointer :: hwva
275 real(DP),
dimension(:, :),
contiguous,
pointer :: auxvar
276 type(CharacterStringType),
dimension(:),
contiguous,
pointer :: boundname
277 integer(I4B) :: ndim1, ndim2
278 character(len=20) :: cellstr1, cellstr2
279 character(len=2) :: cnfloat
280 integer(I4B) :: nerr, iaux
281 integer(I4B) :: iexg, nodem1, nodem2
283 character(len=*),
parameter :: fmtexglabel =
"(1x, 3a10, 50(a16))"
284 character(len=*),
parameter :: fmtexgdata = &
285 "(5x, a, 1x, a ,I10, 50(1pg16.6))"
286 character(len=40) :: fmtexgdata2
288 call mem_setptr(cellidm1,
'CELLIDM1', this%input_mempath)
289 call mem_setptr(cellidm2,
'CELLIDM2', this%input_mempath)
290 call mem_setptr(ihc,
'IHC', this%input_mempath)
291 call mem_setptr(cl1,
'CL1', this%input_mempath)
292 call mem_setptr(cl2,
'CL2', this%input_mempath)
293 call mem_setptr(hwva,
'HWVA', this%input_mempath)
294 call mem_setptr(auxvar,
'AUX', this%input_mempath)
295 call mem_setptr(boundname,
'BOUNDNAME', this%input_mempath)
296 ndim1 =
size(cellidm1, dim=1)
297 ndim2 =
size(cellidm2, dim=1)
299 write (iout,
'(1x,a)')
'PROCESSING EXCHANGEDATA'
301 if (this%iprpak /= 0)
then
302 if (this%inamedbound == 0)
then
303 write (iout, fmtexglabel)
'NODEM1',
'NODEM2',
'IHC', &
304 'CL1',
'CL2',
'HWVA', (adjustr(this%auxname(iaux)), &
307 write (iout, fmtexglabel)
'NODEM1',
'NODEM2',
'IHC',
'CL1',
'CL2', &
308 'HWVA', (adjustr(this%auxname(iaux)), iaux=1, this%naux), &
312 write (cnfloat,
'(i0)') 3 + this%naux
313 fmtexgdata2 =
'(5x, a, 1x, a, i10, '//trim(cnfloat)// &
318 do iexg = 1, this%nexg
320 if (
associated(this%model1))
then
323 nodem1 = this%noder(this%model1, cellidm1(:, iexg), iout)
324 this%nodem1(iexg) = nodem1
327 this%nodem1(iexg) = -1
330 if (
associated(this%model2))
then
333 nodem2 = this%noder(this%model2, cellidm2(:, iexg), iout)
334 this%nodem2(iexg) = nodem2
337 this%nodem2(iexg) = -1
341 this%ihc(iexg) = ihc(iexg)
342 this%cl1(iexg) = cl1(iexg)
343 this%cl2(iexg) = cl2(iexg)
344 this%hwva(iexg) = hwva(iexg)
345 do iaux = 1, this%naux
346 this%auxvar(iaux, iexg) = auxvar(iaux, iexg)
348 if (this%inamedbound == 1)
then
349 this%boundname(iexg) = boundname(iexg)
353 if (this%iprpak /= 0)
then
354 cellstr1 = this%cellstr(ndim1, cellidm1(:, iexg), iout)
355 cellstr2 = this%cellstr(ndim2, cellidm2(:, iexg), iout)
356 if (this%inamedbound == 0)
then
357 write (iout, fmtexgdata) trim(cellstr1), trim(cellstr2), &
358 this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), &
360 (this%auxvar(iaux, iexg), iaux=1, this%naux)
362 write (iout, fmtexgdata2) trim(cellstr1), trim(cellstr2), &
363 this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), &
365 (this%auxvar(iaux, iexg), iaux=1, this%naux), &
366 trim(this%boundname(iexg))
371 if (
associated(this%model1))
then
372 if (nodem1 <= 0)
then
373 cellstr1 = this%cellstr(ndim1, cellidm1(:, iexg), iout)
375 trim(adjustl(this%model1%name))// &
376 ' Cell is outside active grid domain ('// &
377 trim(adjustl(cellstr1))//
').'
378 call store_error(errmsg)
383 if (
associated(this%model2))
then
384 if (nodem2 <= 0)
then
385 cellstr2 = this%cellstr(ndim2, cellidm2(:, iexg), iout)
387 trim(adjustl(this%model2%name))// &
388 ' Cell is outside active grid domain ('// &
389 trim(adjustl(cellstr2))//
').'
390 call store_error(errmsg)
395 write (iout,
'(1x,a)')
'END OF EXCHANGEDATA'
398 nerr = count_errors()
400 call store_error(
'Errors encountered in exchange input file.')
401 call store_error_filename(this%filename)