DISPATCH
validate_mod.f90
1 !===============================================================================
2 !> Generic validation module. The general idea is to be able to compare two runs
3 !> at critical points in the sequence of evaluation, by having the first run
4 !> write to files, which the 2nd job reads from, and then compare the contents.
5 !>
6 !> For now, the data are stored in a single file per rank, which implies that
7 !> comparisons only work as long as the updates occur in exactly the same order,
8 !> allowing
9 !>
10 !> 1. Runs that use a single core, and which are therefore updating patches in
11 !> exactly the same order, allowing bit-wise match for unchanged code.
12 !>
13 !> However, since this functionality is primarily intended for testing and
14 !> validation of small runs, having one file per patch would not be a problem.
15 !> This would allow also the kinds of tests below:
16 !>
17 !> 2. Runs that use several core on a single MPI rank, where results are not
18 !> expected to be bit-wise identical, but where one can get useful information
19 !> about the magnitudes of differences, separately in guard zones and the
20 !> interior.
21 !> 3. The same, but withe several ranks. Assuming patch IDs are identical in
22 !> two runs, the same type of quantitative comparisons as in item 2 can be
23 !> made.
24 !>
25 !> Syntax:
26 !> call validate%check (patch%link, scalar, 'label string')
27 !> call validate%check (patch%link, array, 'label string')
28 !>
29 !> where 'array' may be 1-D, 2-D, 3-D, or 4-D.
30 !===============================================================================
32  USE io_mod
33  USE io_unit_mod
34  USE trace_mod
35  USE patch_mod
36  USE link_mod
37  USE kinds_mod
38  implicit none
39  private
40  type, public:: validate_t
41  integer:: id
42  integer:: irec=0
43  integer:: iout=0
44  integer:: verbose=0
45  logical:: ok=.true.
46  character(len=8):: mode='off'
47  contains
48  procedure:: init
49  procedure:: set
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
62  end type
63  type(validate_t), public:: validate
64 CONTAINS
65 
66 !===============================================================================
67 !> Initialize the dump & compare process
68 !===============================================================================
69 SUBROUTINE init (self)
70  class(validate_t):: self
71  !.............................................................................
72  integer:: iostat
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'
79  !.............................................................................
80  call trace%begin ('validate_t%init')
81  call trace%print_id (id)
82  !$omp critical (input_cr)
83  if (first_time) then
84  first_time = .false.
85  rewind(io%input)
86  read (io%input, validate_params, iostat=iostat)
87  write (io%output, validate_params)
88  end if
89  !$omp end critical (input_cr)
90  self%mode = mode
91  self%verbose = verbose
92  call trace%end()
93 END SUBROUTINE init
94 
95 !===============================================================================
96 !> Change mode of the dump process
97 !===============================================================================
98 SUBROUTINE set (self, mode1, verbose)
99  class(validate_t):: self
100  character(len=*):: mode1
101  integer, optional:: verbose
102  !.............................................................................
103  self%mode = mode1
104  if (present(verbose)) then
105  self%verbose = verbose
106  end if
107 END SUBROUTINE set
108 
109 !===============================================================================
110 !> Switch
111 !===============================================================================
112 SUBROUTINE check0 (self, patch, f1, label1)
113  class(validate_t) :: self
114  class(patch_t) :: patch
115  real :: f1
116  character(len=*) :: label1
117  !.............................................................................
118  real :: f0
119  character(len=64) :: label0
120  integer :: id0, id1, sz, dims
121  real :: diff
122  !-----------------------------------------------------------------------------
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
127  id1 = patch%id
128  label0 = label1
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
134  id1 = patch%id
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
138  diff = f0-f1
139  !---------------------------------------------------------------------------
140  ! Write out summary of differences, if there are any
141  !---------------------------------------------------------------------------
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
147  end if
148  1 format(a,i12,3x,a)
149  2 format(a,1pe12.3,2x,a,1pe12.3)
150  end if
151 END SUBROUTINE check0
152 
153 !===============================================================================
154 !> Scalar comparison
155 !===============================================================================
156 SUBROUTINE check0t (self, link, f1, label1)
157  class(validate_t) :: self
158  class(link_t), pointer :: link
159  real :: f1
160  character(len=*) :: label1
161  !.............................................................................
162  associate(patch => link%task)
163  select type (patch)
164  class is (patch_t)
165  call check0 (self, patch, f1, label1)
166  end select
167  end associate
168 END SUBROUTINE check0t
169 
170 !===============================================================================
171 !> Switch
172 !===============================================================================
173 SUBROUTINE check1 (self, patch, f1, label1)
174  class(validate_t) :: self
175  class(patch_t) :: patch
176  integer :: id1
177  real :: f1(:)
178  character(len=*) :: label1
179  !.............................................................................
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
186  !-----------------------------------------------------------------------------
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
196  id1 = patch%id
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)
202  allocate ( f0(dims))
203  allocate (inside(dims))
204  allocate ( diff1(dims))
205  read (io_unit%validate) f0
206  !---------------------------------------------------------------------------
207  ! Compute averages and differences
208  !---------------------------------------------------------------------------
209  l = patch%mesh%li
210  u = patch%mesh%ui
211  aver = 0.0
212  do iz=1,dims
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))
217  end do
218  aver = aver/dims
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)
226  !---------------------------------------------------------------------------
227  ! Write out summary of differences, if there are any
228  !---------------------------------------------------------------------------
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
236  end if
237  1 format(a,i12,3x,a)
238  2 format(a,1pe12.3,3x,a,1pe12.3)
239  end if
240 END SUBROUTINE check1
241 
242 !===============================================================================
243 !> 3-D comparison
244 !===============================================================================
245 SUBROUTINE check1t (self, link, f1, label1)
246  class(validate_t) :: self
247  class(link_t), pointer :: link
248  real :: f1(:)
249  character(len=*) :: label1
250  !.............................................................................
251  associate(patch => link%task)
252  select type (patch)
253  class is (patch_t)
254  call check1 (self, patch, f1, label1)
255  end select
256  end associate
257 END SUBROUTINE check1t
258 
259 !===============================================================================
260 !> Switch
261 !===============================================================================
262 SUBROUTINE check2 (self, patch, f1, label1)
263  class(validate_t) :: self
264  class(patch_t) :: patch
265  integer :: id1
266  real :: f1(:,:)
267  character(len=*) :: label1
268  !.............................................................................
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
275  !-----------------------------------------------------------------------------
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
281  label0 = label1
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
287  id1 = patch%id
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
298  !---------------------------------------------------------------------------
299  ! Compute averages and differences
300  !---------------------------------------------------------------------------
301  l = patch%mesh%li
302  u = patch%mesh%ui
303  aver = 0.0
304  do iy=1,dims(2)
305  averx = 0.0
306  do ix=1,dims(1)
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))
312  end do
313  aver = aver + averx
314  end do
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)
324  !---------------------------------------------------------------------------
325  ! Write out summary of differences, if there are any
326  !---------------------------------------------------------------------------
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
334  end if
335  1 format(a,i12,3x,a)
336  2 format(a,1pe12.3,3x,a,1pe12.3)
337  end if
338  call trace%end()
339 END SUBROUTINE check2
340 
341 !===============================================================================
342 !> 2-D comparison
343 !===============================================================================
344 SUBROUTINE check2t (self, link, f1, label1)
345  class(validate_t) :: self
346  class(link_t), pointer :: link
347  real :: f1(:,:)
348  character(len=*) :: label1
349  !.............................................................................
350  associate(patch => link%task)
351  select type (patch)
352  class is (patch_t)
353  call check2 (self, patch, f1, label1)
354  end select
355  end associate
356 END SUBROUTINE check2t
357 
358 !===============================================================================
359 !> 3-D comparison
360 !===============================================================================
361 SUBROUTINE check3 (self, patch, f1, label1)
362  class(validate_t) :: self
363  class(patch_t) :: patch
364  real(kind=KindScalarVar) :: f1(:,:,:)
365  character(len=*) :: label1
366  !.............................................................................
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
373  !-----------------------------------------------------------------------------
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
379  label0 = label1
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
385  id1 = patch%id
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
397  !---------------------------------------------------------------------------
398  ! Compute averages and differences
399  !---------------------------------------------------------------------------
400  l = patch%mesh%li
401  u = patch%mesh%ui
402  aver = 0.0
403  do iz=1,dims(3)
404  avery = 0.0
405  do iy=1,dims(2)
406  averx = 0.0
407  do ix=1,dims(1)
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))
414  end do
415  avery = avery + averx
416  end do
417  aver = aver + avery
418  end do
419  aver = aver/product(dims)
420  diff2 = sum(diff3**2,1)
421  diff1 = sum(diff2,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)
429  !---------------------------------------------------------------------------
430  ! Write out summary of differences, if there are any
431  !---------------------------------------------------------------------------
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
439  self%ok = .false.
440  end if
441  1 format(a,i12,3x,a)
442  2 format(a,1pe12.3,3x,a,1pe12.3)
443  end if
444  call trace%end()
445 END SUBROUTINE check3
446 
447 !===============================================================================
448 !> 3-D comparison
449 !===============================================================================
450 SUBROUTINE check3t (self, link, f1, label1)
451  class(validate_t) :: self
452  class(link_t), pointer :: link
453  real(kind=KindScalarVar) :: f1(:,:,:)
454  character(len=*) :: label1
455  !.............................................................................
456  associate(patch => link%task)
457  select type (patch)
458  class is (patch_t)
459  call check3 (self, patch, f1, label1)
460  end select
461  end associate
462 END SUBROUTINE check3t
463 
464 !===============================================================================
465 !> 3-D comparison
466 !===============================================================================
467 SUBROUTINE check4 (self, patch, f1, label1)
468  class(validate_t) :: self
469  class(patch_t) :: patch
470  real :: f1(:,:,:,:)
471  character(len=*) :: label1
472  !.............................................................................
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
479  !-----------------------------------------------------------------------------
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
485  label0 = label1
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
491  id1 = patch%id
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
503  !---------------------------------------------------------------------------
504  ! Compute averages and differences
505  !---------------------------------------------------------------------------
506  l = patch%mesh%li
507  u = patch%mesh%ui
508  do iv=1,dims(4)
509  aver = 0.0
510  do iz=1,dims(3)
511  avery = 0.0
512  do iy=1,dims(2)
513  averx = 0.0
514  do ix=1,dims(1)
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))
521  end do
522  avery = avery + averx
523  end do
524  aver = aver + avery
525  end do
526  aver = aver/product(dims)
527  diff2 = sum(diff3**2,1)
528  diff1 = sum(diff2,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)
535  !---------------------------------------------------------------------------
536  ! Write out summary of differences, if there are any
537  !---------------------------------------------------------------------------
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
545  self%ok = .false.
546  end if
547  end do
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)
551  end if
552  call trace%end()
553 END SUBROUTINE check4
554 
555 !===============================================================================
556 !> 3-D comparison
557 !===============================================================================
558 SUBROUTINE check4t (self, link, f1, label1)
559  class(validate_t) :: self
560  class(link_t), pointer :: link
561  real :: f1(:,:,:,:)
562  character(len=*) :: label1
563  !.............................................................................
564  associate(patch => link%task)
565  select type (patch)
566  class is (patch_t)
567  call check4 (self, patch, f1, label1)
568  end select
569  end associate
570 END SUBROUTINE check4t
571 
572 END MODULE validate_mod
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...
Definition: patch_mod.f90:6
Definition: io_mod.f90:4