46 character(len=8):: mode=
'off' 50 procedure,
private:: check0
51 procedure,
private:: check1
52 procedure,
private:: check2
53 procedure,
private:: check3
54 procedure,
private:: check4
55 procedure,
private:: check0t
56 procedure,
private:: check1t
57 procedure,
private:: check2t
58 procedure,
private:: check3t
59 procedure,
private:: check4t
60 generic,
public:: check => check0 , check1 , check2 , check3 , check4, &
61 check0t, check1t, check2t, check3t, check4t
69 SUBROUTINE init (self)
73 integer,
save:: verbose=0
74 logical,
save:: first_time=.true.
75 character(len=8),
save:: mode=
'off' 76 namelist /validate_params/ verbose, mode
77 character(len=120):: id = &
78 '$Id: 2260d0edb3dd0e8bc0db8bef9bb0eddb70e6ec7d $ io/validate_mod.f90' 80 call trace%begin (
'validate_t%init')
81 call trace%print_id (id)
86 read (io%input, validate_params, iostat=iostat)
87 write (io%output, validate_params)
91 self%verbose = verbose
98 SUBROUTINE set (self, mode1, verbose)
100 character(len=*):: mode1
101 integer,
optional:: verbose
104 if (
present(verbose))
then 105 self%verbose = verbose
112 SUBROUTINE check0 (self, patch, f1, label1)
116 character(len=*) :: label1
119 character(len=64) :: label0
120 integer :: id0, id1, sz, dims
123 if (self%verbose > 0) &
124 write (io_unit%output,
'(a,i6,2x,i1,20x,f12.6,2x,a)') &
125 ' validate:', patch%id, 1, patch%time, label1
126 if (self%mode==
'write')
then 129 write (io_unit%validate) id1, 0, label0
130 write (io_unit%validate) 1
131 write (io_unit%validate) f1
132 else if (self%mode==
'compare')
then 133 read (io_unit%validate) id0, sz, label0
135 if (id0 /= id1)
write (io_unit%output,*)
'WARNING: id differs', id0, id1
136 read (io_unit%validate) dims
137 read (io_unit%validate) f0
142 if (diff /= 0.0 .or. self%verbose > 0)
then 143 write (io_unit%output,1)
' patch ID =', id0, trim(label0)
144 write (io_unit%output,1)
' patch ID =', id1, trim(label1)
145 write (io_unit%output,2)
' value1 =', f0,
'value2 =', f1
146 write (io_unit%output,2)
' diff =', diff
149 2
format(a,1pe12.3,2x,a,1pe12.3)
151 END SUBROUTINE check0
156 SUBROUTINE check0t (self, link, f1, label1)
158 class(
link_t),
pointer :: link
160 character(len=*) :: label1
162 associate(patch => link%task)
165 call check0 (self, patch, f1, label1)
168 END SUBROUTINE check0t
173 SUBROUTINE check1 (self, patch, f1, label1)
175 class(patch_t) :: patch
178 character(len=*) :: label1
180 real,
allocatable :: f0(:), diff1(:)
181 logical,
allocatable :: inside(:)
182 character(len=64) :: label0
183 integer :: id0, sz, dims, iz, l(3), u(3)
184 real,
dimension(2) :: aver, averx, avery
185 real :: di_min, di_max, do_min, do_max, rms, diff
187 if (self%verbose > 0) &
188 write (io_unit%output,
'(a,i6,2x,i1,2x,i4,14x,f12.6,2x,a)') &
189 ' validate:', patch%id, 1, shape(f1), patch%time, label1
190 if (self%mode==
'write')
then 191 write (io_unit%validate) patch%id, 1, label1
192 write (io_unit%validate) shape(f1)
193 write (io_unit%validate) f1
194 else if (self%mode==
'compare')
then 195 read (io_unit%validate) id0, sz, label0
197 if (id0 /= id1)
write (io_unit%output,*)
'WARNING: id differs', id0, id1
198 if (sz /= 1)
write (io_unit%output,*)
'WARNING: sz differs', sz, 1
199 read (io_unit%validate) dims
200 if (any(dims /= shape(f1))) &
201 write (io_unit%output,
'(1x,a,2(2x,3i4))')
'WARNING: dims differ', dims, shape(f1)
203 allocate (inside(dims))
204 allocate ( diff1(dims))
205 read (io_unit%validate) f0
213 aver(1) = aver(1) + f0(iz)
214 aver(2) = aver(2) + f1(iz)
215 diff1(iz) = f1(iz)-f0(iz)
216 inside(iz) = (iz >= l(3) .and. iz <= u(3))
219 diff = aver(2)-aver(1)
220 rms = sqrt(sum(diff1)/dims)
221 di_min = minval(diff1,mask=inside)
222 di_max = maxval(diff1,mask=inside)
223 do_min = minval(diff1,mask=.not.inside)
224 do_max = maxval(diff1,mask=.not.inside)
225 deallocate (f0, inside, diff1)
229 if (rms > 0.0 .or. self%verbose > 1)
then 230 write (io_unit%output,1)
' patch ID =', id0, trim(label0)
231 write (io_unit%output,1)
' patch ID =', patch%id, trim(label1)
232 write (io_unit%output,2)
' aver1 =', aver(1),
'aver2 =', aver(2)
233 write (io_unit%output,2)
' diff =', diff,
' RMS =', rms
234 write (io_unit%output,2)
' inside: min =', di_min,
' max =', di_max
235 write (io_unit%output,2)
'outside: min =', do_min,
' max =', do_max
238 2
format(a,1pe12.3,3x,a,1pe12.3)
240 END SUBROUTINE check1
245 SUBROUTINE check1t (self, link, f1, label1)
247 class(link_t),
pointer :: link
249 character(len=*) :: label1
251 associate(patch => link%task)
254 call check1 (self, patch, f1, label1)
257 END SUBROUTINE check1t
262 SUBROUTINE check2 (self, patch, f1, label1)
264 class(patch_t) :: patch
267 character(len=*) :: label1
269 real,
allocatable :: f0(:,:), diff1(:), diff2(:,:)
270 logical,
allocatable :: inside(:,:)
271 character(len=64) :: label0
272 integer :: id0, sz, dims(2), ix, iy, l(3), u(3)
273 real,
dimension(2) :: aver, averx, avery
274 real :: di_min, di_max, do_min, do_max, rms, diff
276 call trace%begin (
'validate_t%check2')
277 if (self%verbose > 0) &
278 write (io_unit%output,
'(a,i6,2x,i1,2x,2i4,10x,f12.6,2x,a)') &
279 ' validate:', patch%id, 2, shape(f1), patch%time, label1
280 if (self%mode==
'write')
then 282 write (io_unit%validate) patch%id, 2, label0
283 write (io_unit%validate) shape(f1)
284 write (io_unit%validate) f1
285 else if (self%mode==
'compare')
then 286 read (io_unit%validate) id0, sz, label0
288 if (id0 /= id1)
write (io_unit%output,*)
'WARNING: id differs', id0, id1
289 if (sz /= 2)
write (io_unit%output,*)
'WARNING: sz differs', sz, 2
290 read (io_unit%validate) dims
291 if (any(dims /= shape(f1))) &
292 write (io_unit%output,
'(1x,a,2(2x,3i4))')
'WARNING: dims differ', dims, shape(f1)
293 allocate ( f0(dims(1),dims(2)))
294 allocate (inside(dims(1),dims(2)))
295 allocate ( diff2(dims(1),dims(2)))
296 allocate ( diff1(dims(2)))
297 read (io_unit%validate) f0
307 averx(1) = averx(1) + f0(ix,iy)
308 averx(2) = averx(2) + f1(ix,iy)
309 diff2(ix,iy) = f1(ix,iy)-f0(ix,iy)
310 inside(ix,iy) = (ix >= l(1) .and. ix <= u(1)) .and. &
311 (iy >= l(2) .and. iy <= u(2))
315 aver = aver/product(dims)
316 diff = aver(2)-aver(1)
317 diff1 = sum(diff2**2,1)
318 rms = sqrt(sum(diff1)/product(dims))
319 di_min = minval(diff2,mask=inside)
320 di_max = maxval(diff2,mask=inside)
321 do_min = minval(diff2,mask=.not.inside)
322 do_max = maxval(diff2,mask=.not.inside)
323 deallocate (f0, inside, diff1, diff2)
327 if (rms > 0.0 .or. self%verbose > 1)
then 328 write (io_unit%output,1)
' patch ID =', id0, trim(label0)
329 write (io_unit%output,1)
' patch ID =', patch%id, trim(label1)
330 write (io_unit%output,2)
' aver1 =', aver(1),
'aver2 =', aver(2)
331 write (io_unit%output,2)
' diff =', diff,
' RMS =', rms
332 write (io_unit%output,2)
' inside: min =', di_min,
' max =', di_max
333 write (io_unit%output,2)
'outside: min =', do_min,
' max =', do_max
336 2
format(a,1pe12.3,3x,a,1pe12.3)
339 END SUBROUTINE check2
344 SUBROUTINE check2t (self, link, f1, label1)
346 class(link_t),
pointer :: link
348 character(len=*) :: label1
350 associate(patch => link%task)
353 call check2 (self, patch, f1, label1)
356 END SUBROUTINE check2t
361 SUBROUTINE check3 (self, patch, f1, label1)
363 class(patch_t) :: patch
364 real(kind=KindScalarVar) :: f1(:,:,:)
365 character(len=*) :: label1
367 real,
allocatable :: f0(:,:,:), diff1(:), diff2(:,:), diff3(:,:,:)
368 logical,
allocatable :: inside(:,:,:)
369 character(len=64) :: label0
370 integer :: id0, id1, sz, dims(3), ix, iy, iz, l(3), u(3)
371 real,
dimension(2) :: aver, averx, avery
372 real :: di_min, di_max, do_min, do_max, rms, diff
374 call trace%begin (
'validate_t%check3')
375 if (self%verbose > 0) &
376 write (io_unit%output,
'(a,i6,2x,i1,2x,3i4,6x,f12.6,2x,a)') &
377 ' validate:', patch%id, 3, shape(f1), patch%time, label1
378 if (self%mode==
'write')
then 380 write (io_unit%validate) patch%id, 3, label0
381 write (io_unit%validate) shape(f1)
382 write (io_unit%validate) f1
383 else if (self%mode==
'compare')
then 384 read (io_unit%validate) id0, sz, label0
386 if (id0 /= id1)
write (io_unit%output,*)
'WARNING: id differs', id0, id1
387 if (sz /= 3)
write (io_unit%output,*)
'WARNING: sz differs', sz, 3
388 read (io_unit%validate) dims
389 if (any(dims /= shape(f1))) &
390 write (io_unit%output,
'(1x,a,2(2x,3i4))')
'WARNING: dims differ', dims, shape(f1)
391 allocate ( f0(dims(1),dims(2),dims(3)))
392 allocate (inside(dims(1),dims(2),dims(3)))
393 allocate ( diff3(dims(1),dims(2),dims(3)))
394 allocate ( diff2(dims(2),dims(3)))
395 allocate ( diff1(dims(3)))
396 read (io_unit%validate) f0
408 averx(1) = averx(1) + f0(ix,iy,iz)
409 averx(2) = averx(2) + f1(ix,iy,iz)
410 diff3(ix,iy,iz) = f1(ix,iy,iz)-f0(ix,iy,iz)
411 inside(ix,iy,iz) = (ix >= l(1) .and. ix <= u(1)) .and. &
412 (iy >= l(2) .and. iy <= u(2)) .and. &
413 (iz >= l(3) .and. iz <= u(3))
415 avery = avery + averx
419 aver = aver/product(dims)
420 diff2 = sum(diff3**2,1)
422 diff = aver(2)-aver(1)
423 rms = sqrt(sum(diff1)/product(dims))
424 di_min = minval(diff3,mask=inside)
425 di_max = maxval(diff3,mask=inside)
426 do_min = minval(diff3,mask=.not.inside)
427 do_max = maxval(diff3,mask=.not.inside)
428 deallocate (f0, inside, diff1, diff2, diff3)
432 if (rms > 0.0 .or. self%verbose > 1)
then 433 write (io_unit%output,1)
' patch ID =', id0, trim(label0)
434 write (io_unit%output,1)
' patch ID =', patch%id, trim(label1)
435 write (io_unit%output,2)
' aver1 =', aver(1),
'aver2 =', aver(2)
436 write (io_unit%output,2)
' diff =', diff,
' RMS =', rms
437 write (io_unit%output,2)
' inside: min =', di_min,
' max =', di_max
438 write (io_unit%output,2)
'outside: min =', do_min,
' max =', do_max
442 2
format(a,1pe12.3,3x,a,1pe12.3)
445 END SUBROUTINE check3
450 SUBROUTINE check3t (self, link, f1, label1)
452 class(link_t),
pointer :: link
453 real(kind=KindScalarVar) :: f1(:,:,:)
454 character(len=*) :: label1
456 associate(patch => link%task)
459 call check3 (self, patch, f1, label1)
462 END SUBROUTINE check3t
467 SUBROUTINE check4 (self, patch, f1, label1)
469 class(patch_t) :: patch
471 character(len=*) :: label1
473 real,
allocatable :: f0(:,:,:,:), diff1(:), diff2(:,:), diff3(:,:,:)
474 logical,
allocatable :: inside(:,:,:)
475 character(len=64) :: label0
476 integer :: id0, id1, sz, dims(4), ix, iy, iz, iv, l(3), u(3)
477 real,
dimension(2) :: aver, averx, avery
478 real :: di_min, di_max, do_min, do_max, rms, diff
480 call trace%begin (
'validate_t%check4')
481 if (self%verbose > 0) &
482 write (io_unit%output,
'(a,i6,2x,i1,2x,4i4,2x,f12.6,2x,a)') &
483 ' validate:', patch%id, 4, shape(f1), patch%time, label1
484 if (self%mode==
'write')
then 486 write (io_unit%validate) patch%id, 4, label0
487 write (io_unit%validate) shape(f1)
488 write (io_unit%validate) f1
489 else if (self%mode==
'compare')
then 490 read (io_unit%validate) id0, sz, label0
492 if (id0 /= id1)
write (io_unit%output,*)
'WARNING: id differs', id0, id1
493 if (sz /= 4)
write (io_unit%output,*)
'WARNING: sz differs', sz, 4
494 read (io_unit%validate) dims
495 if (any(dims /= shape(f1))) &
496 write (io_unit%output,
'(1x,a,2(2x,4i4))')
'WARNING: dims differ', dims, shape(f1)
497 allocate (f0(dims(1),dims(2),dims(3),dims(4)))
498 allocate (inside(dims(1),dims(2),dims(3)))
499 allocate (diff3(dims(1),dims(2),dims(3)))
500 allocate (diff2(dims(2),dims(3)))
501 allocate (diff1(dims(3)))
502 read (io_unit%validate) f0
515 averx(1) = averx(1) + f0(ix,iy,iz,iv)
516 averx(2) = averx(2) + f1(ix,iy,iz,iv)
517 diff3(ix,iy,iz) = f1(ix,iy,iz,iv)-f0(ix,iy,iz,iv)
518 inside(ix,iy,iz) = (ix >= l(1) .and. ix <= u(1)) .and. &
519 (iy >= l(2) .and. iy <= u(2)) .and. &
520 (iz >= l(3) .and. iz <= u(3))
522 avery = avery + averx
526 aver = aver/product(dims)
527 diff2 = sum(diff3**2,1)
529 diff = aver(2)-aver(1)
530 rms = sqrt(sum(diff1)/product(dims))
531 di_min = minval(diff3,mask=inside)
532 di_max = maxval(diff3,mask=inside)
533 do_min = minval(diff3,mask=.not.inside)
534 do_max = maxval(diff3,mask=.not.inside)
538 if (rms > 0.0 .or. self%verbose > 1)
then 539 write (io_unit%output,1)
' patch ID =', id0, iv, trim(label0)
540 write (io_unit%output,1)
' patch ID =', patch%id, iv, trim(label1)
541 write (io_unit%output,2)
' aver1 =', aver(1),
'aver2 =', aver(2)
542 write (io_unit%output,2)
' diff =', diff,
' RMS =', rms
543 write (io_unit%output,2)
' inside: min =', di_min,
' max =', di_max
544 write (io_unit%output,2)
'outside: min =', do_min,
' max =', do_max
548 deallocate (f0, inside, diff1, diff2, diff3)
549 1
format(a,i12,i4,3x,a)
550 2
format(a,1pe12.3,3x,a,1pe12.3)
553 END SUBROUTINE check4
558 SUBROUTINE check4t (self, link, f1, label1)
560 class(link_t),
pointer :: link
562 character(len=*) :: label1
564 associate(patch => link%task)
567 call check4 (self, patch, f1, label1)
570 END SUBROUTINE check4t
Generic validation module. The general idea is to be able to compare two runs at critical points in t...
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...
Module with list handling for generic class task_t objects.