ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
error_analysis.f90
Go to the documentation of this file.
1 
18 
19 module error_analysis
20 
21  use itm_types
22 
23  implicit none
24 
25  interface are_identical
26  module procedure &
27  are_identical_float_type, &
28  are_identical_vecflt_type, &
29  are_identical_matflt_type, &
30  are_identical_array3dflt_type, &
31  are_identical_array4dflt_type, &
32  are_identical_array5dflt_type, &
33  are_identical_array6dflt_type, &
34  are_identical_array7dflt_type
35  end interface
36 
37  interface average_relative_error
38  module procedure &
39  average_relative_error_float_type, &
40  average_relative_error_vecflt_type, &
41  average_relative_error_matflt_type, &
42  average_relative_error_array3dflt_type, &
43  average_relative_error_array4dflt_type, &
44  average_relative_error_array5dflt_type, &
45  average_relative_error_array6dflt_type, &
46  average_relative_error_array7dflt_type
47  end interface
48 
49  interface maximum_relative_error
50  module procedure &
51  maximum_relative_error_float_type, &
52  maximum_relative_error_vecflt_type, &
53  maximum_relative_error_matflt_type, &
54  maximum_relative_error_array3dflt_type, &
55  maximum_relative_error_array4dflt_type, &
56  maximum_relative_error_array5dflt_type, &
57  maximum_relative_error_array6dflt_type, &
58  maximum_relative_error_array7dflt_type
59  end interface
60 
61  interface chi_square
62  module procedure &
63  chi_square_float_type, &
64  chi_square_vecflt_type, &
65  chi_square_matflt_type, &
66  chi_square_array3dflt_type, &
67  chi_square_array4dflt_type, &
68  chi_square_array5dflt_type, &
69  chi_square_array6dflt_type, &
70  chi_square_array7dflt_type
71  end interface
72 
73 contains
74 
75  function are_identical_float(diff_counter, error_level, &
76  reference_field_float, new_field_float, &
77  reference_field_array3dflt_type, new_field_array3dflt_type, &
78  reference_field_array4dflt_type, new_field_array4dflt_type, &
79  reference_field_array5dflt_type, new_field_array5dflt_type, &
80  reference_field_array6dflt_type, new_field_array6dflt_type, &
81  reference_field_array7dflt_type, new_field_array7dflt_type, &
82  reference_field_matflt_type, new_field_matflt_type, &
83  reference_field_vecflt_type, new_field_vecflt_type) &
84  result(f_identical)
85 
86  implicit none
87 
88  real(r8), intent(in), optional :: reference_field_float, new_field_float
89  real(r8), dimension(:, :, :), pointer, optional :: reference_field_array3dflt_type, new_field_array3dflt_type
90  real(r8), dimension(:, :, :, :), pointer, optional :: reference_field_array4dflt_type, new_field_array4dflt_type
91  real(r8), dimension(:, :, :, :, :), pointer, optional :: reference_field_array5dflt_type, new_field_array5dflt_type
92  real(r8), dimension(:, :, :, :, :, :), pointer, optional :: reference_field_array6dflt_type, new_field_array6dflt_type
93  real(r8), dimension(:, :, :, :, :, :, :), pointer, optional :: reference_field_array7dflt_type, new_field_array7dflt_type
94  real(r8), dimension(:, :), pointer, optional :: reference_field_matflt_type, new_field_matflt_type
95  real(r8), dimension(:), pointer, optional :: reference_field_vecflt_type, new_field_vecflt_type
96  integer(itm_i4) :: diff_counter
97  real(r8) :: error_level
98 
99  character(len = 132) :: f_identical
100 
101  if (present(reference_field_vecflt_type)) then
102  f_identical = are_identical(reference_field_vecflt_type, new_field_vecflt_type, diff_counter, error_level)
103  else if (present(reference_field_matflt_type)) then
104  f_identical = are_identical(reference_field_matflt_type, new_field_matflt_type, diff_counter, error_level)
105  else if (present(reference_field_array3dflt_type)) then
106  f_identical = are_identical(reference_field_array3dflt_type, new_field_array3dflt_type, diff_counter, error_level)
107  else if (present(reference_field_array4dflt_type)) then
108  f_identical = are_identical(reference_field_array4dflt_type, new_field_array4dflt_type, diff_counter, error_level)
109  else if (present(reference_field_array5dflt_type)) then
110  f_identical = are_identical(reference_field_array5dflt_type, new_field_array5dflt_type, diff_counter, error_level)
111  else if (present(reference_field_array6dflt_type)) then
112  f_identical = are_identical(reference_field_array6dflt_type, new_field_array6dflt_type, diff_counter, error_level)
113  else if (present(reference_field_array7dflt_type)) then
114  f_identical = are_identical(reference_field_array7dflt_type, new_field_array7dflt_type, diff_counter, error_level)
115  else
116  f_identical = are_identical(reference_field_float, new_field_float, diff_counter, error_level)
117  end if
118 
119  end function are_identical_float
120 
121  function are_identical_float_type(reference_field, new_field, &
122  diff_counter, error_level) result(f_identical)
123 
124  implicit none
125 
126  real(r8), intent(in) :: reference_field, new_field
127  integer(itm_i4) :: diff_counter
128  real(r8) :: error_level
129 
130  character(len = 132) :: f_identical
131 
132  if (reference_field /= new_field) then
133  diff_counter = diff_counter + 1
134  write(f_identical, '(a132)') 'differ'
135  else
136  write(f_identical, '(a132)') 'are identical'
137  end if
138 
139  end function are_identical_float_type
140 
141  function are_identical_vecflt_type(reference_field, new_field, &
142  diff_counter, error_level) result(f_identical)
143 
144  implicit none
145 
146  real(r8), dimension(:), pointer :: reference_field, new_field
147  integer(itm_i4) :: diff_counter
148  real(r8) :: error_level
149 
150  character(len = 132) :: f_identical
151 
152  if (size(reference_field) /= size(new_field)) then
153  write(f_identical, '(a132)') 'ERROR: field sizes differ'
154  else
155  if (any(reference_field /= new_field)) then
156  diff_counter = diff_counter + 1
157  write(f_identical, '(a132)') 'differ'
158  else
159  write(f_identical, '(a132)') 'are identical'
160  end if
161  end if
162 
163  end function are_identical_vecflt_type
164 
165  function are_identical_matflt_type(reference_field, new_field, &
166  diff_counter, error_level) result(f_identical)
167 
168  implicit none
169 
170  real(r8), dimension(:, :), pointer :: reference_field, new_field
171  integer(itm_i4) :: diff_counter
172  real(r8) :: error_level
173 
174  character(len = 132) :: f_identical
175 
176  if (size(reference_field) /= size(new_field)) then
177  write(f_identical, '(a132)') 'ERROR: field sizes differ'
178  else
179  if (any(reference_field /= new_field)) then
180  diff_counter = diff_counter + 1
181  write(f_identical, '(a132)') 'differ'
182  else
183  write(f_identical, '(a132)') 'are identical'
184  end if
185  end if
186 
187  end function are_identical_matflt_type
188 
189  function are_identical_array3dflt_type(reference_field, new_field, &
190  diff_counter, error_level) result(f_identical)
191 
192  implicit none
193 
194  real(r8), dimension(:, :, :), pointer :: reference_field, new_field
195  integer(itm_i4) :: diff_counter
196  real(r8) :: error_level
197 
198  character(len = 132) :: f_identical
199 
200  if (size(reference_field) /= size(new_field)) then
201  write(f_identical, '(a132)') 'ERROR: field sizes differ'
202  else
203  if (any(reference_field /= new_field)) then
204  diff_counter = diff_counter + 1
205  write(f_identical, '(a132)') 'differ'
206  else
207  write(f_identical, '(a132)') 'are identical'
208  end if
209  end if
210 
211  end function are_identical_array3dflt_type
212 
213  function are_identical_array4dflt_type(reference_field, new_field, &
214  diff_counter, error_level) result(f_identical)
215 
216  implicit none
217 
218  real(r8), dimension(:, :, :, :), pointer :: reference_field, new_field
219  integer(itm_i4) :: diff_counter
220  real(r8) :: error_level
221 
222  character(len = 132) :: f_identical
223 
224  if (size(reference_field) /= size(new_field)) then
225  write(f_identical, '(a132)') 'ERROR: field sizes differ'
226  else
227  if (any(reference_field /= new_field)) then
228  diff_counter = diff_counter + 1
229  write(f_identical, '(a132)') 'differ'
230  else
231  write(f_identical, '(a132)') 'are identical'
232  end if
233  end if
234 
235  end function are_identical_array4dflt_type
236 
237  function are_identical_array5dflt_type(reference_field, new_field, &
238  diff_counter, error_level) result(f_identical)
239 
240  implicit none
241 
242  real(r8), dimension(:, :, :, :, :), pointer :: reference_field, new_field
243  integer(itm_i4) :: diff_counter
244  real(r8) :: error_level
245 
246  character(len = 132) :: f_identical
247 
248  if (size(reference_field) /= size(new_field)) then
249  write(f_identical, '(a132)') 'ERROR: field sizes differ'
250  else
251  if (any(reference_field /= new_field)) then
252  diff_counter = diff_counter + 1
253  write(f_identical, '(a132)') 'differ'
254  else
255  write(f_identical, '(a132)') 'are identical'
256  end if
257  end if
258 
259  end function are_identical_array5dflt_type
260 
261  function are_identical_array6dflt_type(reference_field, new_field, &
262  diff_counter, error_level) result(f_identical)
263 
264  implicit none
265 
266  real(r8), dimension(:, :, :, :, :, :), pointer :: reference_field, new_field
267  integer(itm_i4) :: diff_counter
268  real(r8) :: error_level
269 
270  character(len = 132) :: f_identical
271 
272  if (size(reference_field) /= size(new_field)) then
273  write(f_identical, '(a132)') 'ERROR: field sizes differ'
274  else
275  if (any(reference_field /= new_field)) then
276  diff_counter = diff_counter + 1
277  write(f_identical, '(a132)') 'differ'
278  else
279  write(f_identical, '(a132)') 'are identical'
280  end if
281  end if
282 
283  end function are_identical_array6dflt_type
284 
285  function are_identical_array7dflt_type(reference_field, new_field, &
286  diff_counter, error_level) result(f_identical)
287 
288  implicit none
289 
290  real(r8), dimension(:, :, :, :, :, :, :), pointer :: reference_field, new_field
291  integer(itm_i4) :: diff_counter
292  real(r8) :: error_level
293 
294  character(len = 132) :: f_identical
295 
296  if (size(reference_field) /= size(new_field)) then
297  write(f_identical, '(a132)') 'ERROR: field sizes differ'
298  else
299  if (any(reference_field /= new_field)) then
300  diff_counter = diff_counter + 1
301  write(f_identical, '(a132)') 'differ'
302  else
303  write(f_identical, '(a132)') 'are identical'
304  end if
305  end if
306 
307  end function are_identical_array7dflt_type
308 
309  function average_relative_error_float(diff_counter, error_level, &
310  reference_field_float, new_field_float, &
311  reference_field_array3dflt_type, new_field_array3dflt_type, &
312  reference_field_array4dflt_type, new_field_array4dflt_type, &
313  reference_field_array5dflt_type, new_field_array5dflt_type, &
314  reference_field_array6dflt_type, new_field_array6dflt_type, &
315  reference_field_array7dflt_type, new_field_array7dflt_type, &
316  reference_field_matflt_type, new_field_matflt_type, &
317  reference_field_vecflt_type, new_field_vecflt_type) &
318  result(f_average)
319 
320  implicit none
321 
322  real(r8), intent(in), optional :: reference_field_float, new_field_float
323  real(r8), dimension(:, :, :), pointer, optional :: reference_field_array3dflt_type, new_field_array3dflt_type
324  real(r8), dimension(:, :, :, :), pointer, optional :: reference_field_array4dflt_type, new_field_array4dflt_type
325  real(r8), dimension(:, :, :, :, :), pointer, optional :: reference_field_array5dflt_type, new_field_array5dflt_type
326  real(r8), dimension(:, :, :, :, :, :), pointer, optional :: reference_field_array6dflt_type, new_field_array6dflt_type
327  real(r8), dimension(:, :, :, :, :, :, :), pointer, optional :: reference_field_array7dflt_type, new_field_array7dflt_type
328  real(r8), dimension(:, :), pointer, optional :: reference_field_matflt_type, new_field_matflt_type
329  real(r8), dimension(:), pointer, optional :: reference_field_vecflt_type, new_field_vecflt_type
330  integer(itm_i4) :: diff_counter
331  real(r8) :: error_level
332 
333  character(len = 132) :: f_average
334 
335  if (present(reference_field_vecflt_type)) then
336  f_average = average_relative_error(reference_field_vecflt_type, new_field_vecflt_type, diff_counter, error_level)
337  else if (present(reference_field_matflt_type)) then
338  f_average = average_relative_error(reference_field_matflt_type, new_field_matflt_type, diff_counter, error_level)
339  else if (present(reference_field_array3dflt_type)) then
340  f_average = average_relative_error(reference_field_array3dflt_type, new_field_array3dflt_type, diff_counter, error_level)
341  else if (present(reference_field_array4dflt_type)) then
342  f_average = average_relative_error(reference_field_array4dflt_type, new_field_array4dflt_type, diff_counter, error_level)
343  else if (present(reference_field_array5dflt_type)) then
344  f_average = average_relative_error(reference_field_array5dflt_type, new_field_array5dflt_type, diff_counter, error_level)
345  else if (present(reference_field_array6dflt_type)) then
346  f_average = average_relative_error(reference_field_array6dflt_type, new_field_array6dflt_type, diff_counter, error_level)
347  else if (present(reference_field_array7dflt_type)) then
348  f_average = average_relative_error(reference_field_array7dflt_type, new_field_array7dflt_type, diff_counter, error_level)
349  else
350  f_average = average_relative_error(reference_field_float, new_field_float, diff_counter, error_level)
351  end if
352 
353  end function average_relative_error_float
354 
355  function average_relative_error_float_type(reference_field, new_field, &
356  diff_counter, error_level) result(f_average)
357 
358  implicit none
359 
360  real(r8), parameter :: eps = 1.e-8
361  real(r8), intent(in) :: reference_field, new_field
362  integer(itm_i4) :: diff_counter
363  real(r8) :: error_level
364  real(r8) :: av_rel_error
365 
366  character(len = 132) :: f_average
367 
368  av_rel_error = abs(new_field - reference_field) / (abs(new_field &
369  + reference_field) / 2._r8 + abs(eps))
370 
371  if (reference_field /= new_field) then
372  diff_counter = diff_counter + 1
373  end if
374 
375  write(f_average, 1) av_rel_error
376 
377  error_level = (error_level + av_rel_error) / 2._r8
378 
379  1 format(' ---> average relative error: ', e9.2)
380 
381  end function average_relative_error_float_type
382 
383  function average_relative_error_vecflt_type(reference_field, new_field, &
384  diff_counter, error_level) result(f_average)
385 
386  implicit none
387 
388  real(r8), parameter :: eps = 1.e-8
389  real(r8), dimension(:), pointer :: reference_field, new_field
390  integer(itm_i4) :: diff_counter
391  real(r8) :: error_level
392  real(r8) :: av_rel_error
393  integer(itm_i4) :: i1
394 
395  character(len = 132) :: f_average
396 
397  if (size(reference_field) /= size(new_field)) then
398 
399  write(f_average, '(a132)') 'ERROR: field sizes differ'
400 
401  else
402 
403  if (any(reference_field /= new_field)) then
404  diff_counter = diff_counter + 1
405  end if
406 
407  av_rel_error = 0._r8
408 
409  do i1 = 1, size(reference_field, 1)
410  av_rel_error = av_rel_error + abs(new_field(i1) - reference_field(i1)) &
411  / (abs(new_field(i1) + reference_field(i1)) / 2._r8 + abs(eps))
412  end do
413 
414  av_rel_error = av_rel_error / size(reference_field, 1)
415 
416  write(f_average, 1) av_rel_error
417 
418  error_level = (error_level + av_rel_error) / 2._r8
419 
420  end if
421 
422  1 format(' ---> average relative error: ', e9.2)
423 
424  end function average_relative_error_vecflt_type
425 
426  function average_relative_error_matflt_type(reference_field, new_field, &
427  diff_counter, error_level) result(f_average)
428 
429  implicit none
430 
431  real(r8), parameter :: eps = 1.e-8
432  real(r8), dimension(:, :), pointer :: reference_field, new_field
433  integer(itm_i4) :: diff_counter
434  real(r8) :: error_level
435  real(r8) :: av_rel_error
436  integer(itm_i4) :: i1, i2
437 
438  character(len = 132) :: f_average
439 
440  if (size(reference_field) /= size(new_field)) then
441 
442  write(f_average, '(a132)') 'ERROR: field sizes differ'
443 
444  else
445 
446  if (any(reference_field /= new_field)) then
447  diff_counter = diff_counter + 1
448  end if
449 
450  av_rel_error = 0._r8
451 
452  do i1 = 1, size(reference_field, 1)
453  do i2 = 1, size(reference_field, 2)
454  av_rel_error = av_rel_error + abs(new_field(i1, i2) - reference_field(i1, i2)) &
455  / (abs(new_field(i1, i2) + reference_field(i1, i2)) / 2._r8 + abs(eps))
456  end do
457  end do
458 
459  av_rel_error = av_rel_error / (size(reference_field, 1) &
460  * size(reference_field, 2))
461 
462  write(f_average, 1) av_rel_error
463 
464  error_level = (error_level + av_rel_error) / 2._r8
465 
466  end if
467 
468  1 format(' ---> average relative error: ', e9.2)
469 
470  end function average_relative_error_matflt_type
471 
472  function average_relative_error_array3dflt_type(reference_field, new_field, &
473  diff_counter, error_level) result(f_average)
474 
475  implicit none
476 
477  real(r8), parameter :: eps = 1.e-8
478  real(r8), dimension(:, :, :), pointer :: reference_field, new_field
479  integer(itm_i4) :: diff_counter
480  real(r8) :: error_level
481  real(r8) :: av_rel_error
482  integer(itm_i4) :: i1, i2, i3
483 
484  character(len = 132) :: f_average
485 
486  if (size(reference_field) /= size(new_field)) then
487 
488  write(f_average, '(a132)') 'ERROR: field sizes differ'
489 
490  else
491 
492  if (any(reference_field /= new_field)) then
493  diff_counter = diff_counter + 1
494  end if
495 
496  av_rel_error = 0._r8
497 
498  do i1 = 1, size(reference_field, 1)
499  do i2 = 1, size(reference_field, 2)
500  do i3 = 1, size(reference_field, 3)
501  av_rel_error = av_rel_error + abs(new_field(i1, i2, i3) - reference_field(i1, i2, i3)) &
502  / (abs(new_field(i1, i2, i3) + reference_field(i1, i2, i3)) / 2._r8 + abs(eps))
503  end do
504  end do
505  end do
506 
507  av_rel_error = av_rel_error / (size(reference_field, 1) &
508  * size(reference_field, 2) * size(reference_field, 3))
509 
510  write(f_average, 1) av_rel_error
511 
512  error_level = (error_level + av_rel_error) / 2._r8
513 
514  end if
515 
516  1 format(' ---> average relative error: ', e9.2)
517 
518  end function average_relative_error_array3dflt_type
519 
520  function average_relative_error_array4dflt_type(reference_field, new_field, &
521  diff_counter, error_level) result(f_average)
522 
523  implicit none
524 
525  real(r8), parameter :: eps = 1.e-8
526  real(r8), dimension(:, :, :, :), pointer :: reference_field, new_field
527  integer(itm_i4) :: diff_counter
528  real(r8) :: error_level
529  real(r8) :: av_rel_error
530  integer(itm_i4) :: i1, i2, i3, i4
531 
532  character(len = 132) :: f_average
533 
534  if (size(reference_field) /= size(new_field)) then
535 
536  write(f_average, '(a132)') 'ERROR: field sizes differ'
537 
538  else
539 
540  if (any(reference_field /= new_field)) then
541  diff_counter = diff_counter + 1
542  end if
543 
544  av_rel_error = 0._r8
545 
546  do i1 = 1, size(reference_field, 1)
547  do i2 = 1, size(reference_field, 2)
548  do i3 = 1, size(reference_field, 3)
549  do i4 = 1, size(reference_field, 4)
550  av_rel_error = av_rel_error + abs(new_field(i1, i2, i3, i4) - reference_field(i1, i2, i3, i4)) &
551  / (abs(new_field(i1, i2, i3, i4) + reference_field(i1, i2, i3, i4)) / 2._r8 + abs(eps))
552  end do
553  end do
554  end do
555  end do
556 
557  av_rel_error = av_rel_error / (size(reference_field, 1) &
558  * size(reference_field, 2) * size(reference_field, 3) * size(reference_field, 4))
559 
560  write(f_average, 1) av_rel_error
561 
562  error_level = (error_level + av_rel_error) / 2._r8
563 
564  end if
565 
566  1 format(' ---> average relative error: ', e9.2)
567 
568  end function average_relative_error_array4dflt_type
569 
570  function average_relative_error_array5dflt_type(reference_field, new_field, &
571  diff_counter, error_level) result(f_average)
572 
573  implicit none
574 
575  real(r8), parameter :: eps = 1.e-8
576  real(r8), dimension(:, :, :, :, :), pointer :: reference_field, new_field
577  integer(itm_i4) :: diff_counter
578  real(r8) :: error_level
579  real(r8) :: av_rel_error
580  integer(itm_i4) :: i1, i2, i3, i4, i5
581 
582  character(len = 132) :: f_average
583 
584  if (size(reference_field) /= size(new_field)) then
585 
586  write(f_average, '(a132)') 'ERROR: field sizes differ'
587 
588  else
589 
590  if (any(reference_field /= new_field)) then
591  diff_counter = diff_counter + 1
592  end if
593 
594  av_rel_error = 0._r8
595 
596  do i1 = 1, size(reference_field, 1)
597  do i2 = 1, size(reference_field, 2)
598  do i3 = 1, size(reference_field, 3)
599  do i4 = 1, size(reference_field, 4)
600  do i5 = 1, size(reference_field, 5)
601  av_rel_error = av_rel_error + abs(new_field(i1, i2, i3, i4, i5) - reference_field(i1, i2, i3, i4, i5)) &
602  / (abs(new_field(i1, i2, i3, i4, i5) + reference_field(i1, i2, i3, i4, i5)) / 2._r8 + abs(eps))
603  end do
604  end do
605  end do
606  end do
607  end do
608 
609  av_rel_error = av_rel_error / (size(reference_field, 1) &
610  * size(reference_field, 2) * size(reference_field, 3) * size(reference_field, 4) * size(reference_field, 5))
611 
612  write(f_average, 1) av_rel_error
613 
614  error_level = (error_level + av_rel_error) / 2._r8
615 
616  end if
617 
618  1 format(' ---> average relative error: ', e9.2)
619 
620  end function average_relative_error_array5dflt_type
621 
622  function average_relative_error_array6dflt_type(reference_field, new_field, &
623  diff_counter, error_level) result(f_average)
624 
625  implicit none
626 
627  real(r8), parameter :: eps = 1.e-8
628  real(r8), dimension(:, :, :, :, :, :), pointer :: reference_field, new_field
629  integer(itm_i4) :: diff_counter
630  real(r8) :: error_level
631  real(r8) :: av_rel_error
632  integer(itm_i4) :: i1, i2, i3, i4, i5, i6
633 
634  character(len = 132) :: f_average
635 
636  if (size(reference_field) /= size(new_field)) then
637 
638  write(f_average, '(a132)') 'ERROR: field sizes differ'
639 
640  else
641 
642  if (any(reference_field /= new_field)) then
643  diff_counter = diff_counter + 1
644  end if
645 
646  av_rel_error = 0._r8
647 
648  do i1 = 1, size(reference_field, 1)
649  do i2 = 1, size(reference_field, 2)
650  do i3 = 1, size(reference_field, 3)
651  do i4 = 1, size(reference_field, 4)
652  do i5 = 1, size(reference_field, 5)
653  do i6 = 1, size(reference_field, 6)
654  av_rel_error = av_rel_error + abs(new_field(i1, i2, i3, i4, i5, i6) &
655  - reference_field(i1, i2, i3, i4, i5, i6)) &
656  / (abs(new_field(i1, i2, i3, i4, i5, i6) + reference_field(i1, i2, i3, i4, i5, i6)) &
657  / 2._r8 + abs(eps))
658  end do
659  end do
660  end do
661  end do
662  end do
663  end do
664 
665  av_rel_error = av_rel_error / (size(reference_field, 1) &
666  * size(reference_field, 2) * size(reference_field, 3) * size(reference_field, 4) &
667  * size(reference_field, 5) * size(reference_field, 6))
668 
669  write(f_average, 1) av_rel_error
670 
671  error_level = (error_level + av_rel_error) / 2._r8
672 
673  end if
674 
675  1 format(' ---> average relative error: ', e9.2)
676 
677  end function average_relative_error_array6dflt_type
678 
679  function average_relative_error_array7dflt_type(reference_field, new_field, &
680  diff_counter, error_level) result(f_average)
681 
682  implicit none
683 
684  real(r8), parameter :: eps = 1.e-8
685  real(r8), dimension(:, :, :, :, :, :, :), pointer :: reference_field, new_field
686  integer(itm_i4) :: diff_counter
687  real(r8) :: error_level
688  real(r8) :: av_rel_error
689  integer(itm_i4) :: i1, i2, i3, i4, i5, i6, i7
690 
691  character(len = 132) :: f_average
692 
693  if (size(reference_field) /= size(new_field)) then
694 
695  write(f_average, '(a132)') 'ERROR: field sizes differ'
696 
697  else
698 
699  if (any(reference_field /= new_field)) then
700  diff_counter = diff_counter + 1
701  end if
702 
703  av_rel_error = 0._r8
704 
705  do i1 = 1, size(reference_field, 1)
706  do i2 = 1, size(reference_field, 2)
707  do i3 = 1, size(reference_field, 3)
708  do i4 = 1, size(reference_field, 4)
709  do i5 = 1, size(reference_field, 5)
710  do i6 = 1, size(reference_field, 6)
711  do i7 = 1, size(reference_field, 7)
712  av_rel_error = av_rel_error + abs(new_field(i1, i2, i3, i4, i5, i6, i7) &
713  - reference_field(i1, i2, i3, i4, i5, i6, i7)) &
714  / (abs(new_field(i1, i2, i3, i4, i5, i6, i7) + reference_field(i1, i2, i3, i4, i5, i6, i7)) &
715  / 2._r8 + abs(eps))
716  end do
717  end do
718  end do
719  end do
720  end do
721  end do
722  end do
723 
724  av_rel_error = av_rel_error / (size(reference_field, 1) &
725  * size(reference_field, 2) * size(reference_field, 3) * size(reference_field, 4) &
726  * size(reference_field, 5) * size(reference_field, 6) * size(reference_field, 7))
727 
728  write(f_average, 1) av_rel_error
729 
730  error_level = (error_level + av_rel_error) / 2._r8
731 
732  end if
733 
734  1 format(' ---> average relative error: ', e9.2)
735 
736  end function average_relative_error_array7dflt_type
737 
738  function maximum_relative_error_float(diff_counter, error_level, &
739  reference_field_float, new_field_float, &
740  reference_field_array3dflt_type, new_field_array3dflt_type, &
741  reference_field_array4dflt_type, new_field_array4dflt_type, &
742  reference_field_array5dflt_type, new_field_array5dflt_type, &
743  reference_field_array6dflt_type, new_field_array6dflt_type, &
744  reference_field_array7dflt_type, new_field_array7dflt_type, &
745  reference_field_matflt_type, new_field_matflt_type, &
746  reference_field_vecflt_type, new_field_vecflt_type) &
747  result(f_maximum)
748 
749  implicit none
750 
751  real(r8), intent(in), optional :: reference_field_float, new_field_float
752  real(r8), dimension(:, :, :), pointer, optional :: reference_field_array3dflt_type, new_field_array3dflt_type
753  real(r8), dimension(:, :, :, :), pointer, optional :: reference_field_array4dflt_type, new_field_array4dflt_type
754  real(r8), dimension(:, :, :, :, :), pointer, optional :: reference_field_array5dflt_type, new_field_array5dflt_type
755  real(r8), dimension(:, :, :, :, :, :), pointer, optional :: reference_field_array6dflt_type, new_field_array6dflt_type
756  real(r8), dimension(:, :, :, :, :, :, :), pointer, optional :: reference_field_array7dflt_type, new_field_array7dflt_type
757  real(r8), dimension(:, :), pointer, optional :: reference_field_matflt_type, new_field_matflt_type
758  real(r8), dimension(:), pointer, optional :: reference_field_vecflt_type, new_field_vecflt_type
759  integer(itm_i4) :: diff_counter
760  real(r8) :: error_level
761 
762  character(len = 132) :: f_maximum
763 
764  if (present(reference_field_vecflt_type)) then
765  f_maximum = maximum_relative_error(reference_field_vecflt_type, new_field_vecflt_type, diff_counter, error_level)
766  else if (present(reference_field_matflt_type)) then
767  f_maximum = maximum_relative_error(reference_field_matflt_type, new_field_matflt_type, diff_counter, error_level)
768  else if (present(reference_field_array3dflt_type)) then
769  f_maximum = maximum_relative_error(reference_field_array3dflt_type, new_field_array3dflt_type, diff_counter, error_level)
770  else if (present(reference_field_array4dflt_type)) then
771  f_maximum = maximum_relative_error(reference_field_array4dflt_type, new_field_array4dflt_type, diff_counter, error_level)
772  else if (present(reference_field_array5dflt_type)) then
773  f_maximum = maximum_relative_error(reference_field_array5dflt_type, new_field_array5dflt_type, diff_counter, error_level)
774  else if (present(reference_field_array6dflt_type)) then
775  f_maximum = maximum_relative_error(reference_field_array6dflt_type, new_field_array6dflt_type, diff_counter, error_level)
776  else if (present(reference_field_array7dflt_type)) then
777  f_maximum = maximum_relative_error(reference_field_array7dflt_type, new_field_array7dflt_type, diff_counter, error_level)
778  else
779  f_maximum = maximum_relative_error(reference_field_float, new_field_float, diff_counter, error_level)
780  end if
781 
782  end function maximum_relative_error_float
783 
784  function maximum_relative_error_float_type(reference_field, new_field, &
785  diff_counter, error_level) result(f_maximum)
786 
787  implicit none
788 
789  real(r8), parameter :: eps = 1.e-8
790  real(r8), intent(in) :: reference_field, new_field
791  integer(itm_i4) :: diff_counter
792  real(r8) :: error_level
793  real(r8) :: max_rel_error, value
794 
795  character(len = 132) :: f_maximum
796 
797  max_rel_error = abs(new_field - reference_field) / (abs(new_field &
798  + reference_field) / 2._r8 + abs(eps))
799  value = new_field
800 
801  if (reference_field /= new_field) then
802  diff_counter = diff_counter + 1
803  end if
804 
805  write(f_maximum, 1) max_rel_error, value
806 
807  error_level = max(error_level, max_rel_error)
808 
809  1 format(' ---> maximum relative error: ', e9.2, ' --- value at maximum relative error: ', e9.2)
810 
811  end function maximum_relative_error_float_type
812 
813  function maximum_relative_error_vecflt_type(reference_field, new_field, &
814  diff_counter, error_level) result(f_maximum)
815 
816  implicit none
817 
818  real(r8), parameter :: eps = 1.e-8
819  real(r8), dimension(:), pointer :: reference_field, new_field
820  integer(itm_i4) :: diff_counter
821  real(r8) :: error_level
822  real(r8) :: max_rel_error, rel_error, value
823  integer(itm_i4) :: i1
824 
825  character(len = 132) :: f_maximum
826 
827  if (size(reference_field) /= size(new_field)) then
828 
829  write(f_maximum, '(a132)') 'ERROR: field sizes differ'
830 
831  else
832 
833  if (any(reference_field /= new_field)) then
834  diff_counter = diff_counter + 1
835  end if
836 
837  max_rel_error = 0._r8
838  value = 0._r8
839 
840  do i1 = 1, size(reference_field, 1)
841  rel_error = abs(new_field(i1) - reference_field(i1)) &
842  / (abs(new_field(i1) + reference_field(i1)) / 2._r8 + abs(eps))
843  if (rel_error > max_rel_error) then
844  max_rel_error = rel_error
845  value = new_field(i1)
846  end if
847  end do
848 
849  write(f_maximum, 1) max_rel_error, value
850 
851  error_level = max(error_level, max_rel_error)
852 
853  end if
854 
855  1 format(' ---> maximum relative error: ', e9.2, ' --- value at maximum relative error: ', e9.2)
856 
857  end function maximum_relative_error_vecflt_type
858 
859  function maximum_relative_error_matflt_type(reference_field, new_field, &
860  diff_counter, error_level) result(f_maximum)
861 
862  implicit none
863 
864  real(r8), parameter :: eps = 1.e-8
865  real(r8), dimension(:, :), pointer :: reference_field, new_field
866  integer(itm_i4) :: diff_counter
867  real(r8) :: error_level
868  real(r8) :: max_rel_error, rel_error, value
869  integer(itm_i4) :: i1, i2
870 
871  character(len = 132) :: f_maximum
872 
873  if (size(reference_field) /= size(new_field)) then
874 
875  write(f_maximum, '(a132)') 'ERROR: field sizes differ'
876 
877  else
878 
879  if (any(reference_field /= new_field)) then
880  diff_counter = diff_counter + 1
881  end if
882 
883  max_rel_error = 0._r8
884  value = 0._r8
885 
886  do i1 = 1, size(reference_field, 1)
887  do i2 = 1, size(reference_field, 2)
888  rel_error = abs(new_field(i1, i2) - reference_field(i1, i2)) &
889  / (abs(new_field(i1, i2) + reference_field(i1, i2)) / 2._r8 + abs(eps))
890  if (rel_error > max_rel_error) then
891  max_rel_error = rel_error
892  value = new_field(i1, i2)
893  end if
894  end do
895  end do
896 
897  write(f_maximum, 1) max_rel_error, value
898 
899  error_level = max(error_level, max_rel_error)
900 
901  end if
902 
903  1 format(' ---> maximum relative error: ', e9.2, ' --- value at maximum relative error: ', e9.2)
904 
905  end function maximum_relative_error_matflt_type
906 
907  function maximum_relative_error_array3dflt_type(reference_field, new_field, &
908  diff_counter, error_level) result(f_maximum)
909 
910  implicit none
911 
912  real(r8), parameter :: eps = 1.e-8
913  real(r8), dimension(:, :, :), pointer :: reference_field, new_field
914  integer(itm_i4) :: diff_counter
915  real(r8) :: error_level
916  real(r8) :: max_rel_error, rel_error, value
917  integer(itm_i4) :: i1, i2, i3
918 
919  character(len = 132) :: f_maximum
920 
921  if (size(reference_field) /= size(new_field)) then
922 
923  write(f_maximum, '(a132)') 'ERROR: field sizes differ'
924 
925  else
926 
927  if (any(reference_field /= new_field)) then
928  diff_counter = diff_counter + 1
929  end if
930 
931  max_rel_error = 0._r8
932  value = 0._r8
933 
934  do i1 = 1, size(reference_field, 1)
935  do i2 = 1, size(reference_field, 2)
936  do i3 = 1, size(reference_field, 3)
937  rel_error = abs(new_field(i1, i2, i3) - reference_field(i1, i2, i3)) &
938  / (abs(new_field(i1, i2, i3) + reference_field(i1, i2, i3)) / 2._r8 + abs(eps))
939  if (rel_error > max_rel_error) then
940  max_rel_error = rel_error
941  value = new_field(i1, i2, i3)
942  end if
943  end do
944  end do
945  end do
946 
947  write(f_maximum, 1) max_rel_error, value
948 
949  error_level = max(error_level, max_rel_error)
950 
951  end if
952 
953  1 format(' ---> maximum relative error: ', e9.2, ' --- value at maximum relative error: ', e9.2)
954 
955  end function maximum_relative_error_array3dflt_type
956 
957  function maximum_relative_error_array4dflt_type(reference_field, new_field, &
958  diff_counter, error_level) result(f_maximum)
959 
960  implicit none
961 
962  real(r8), parameter :: eps = 1.e-8
963  real(r8), dimension(:, :, :, :), pointer :: reference_field, new_field
964  integer(itm_i4) :: diff_counter
965  real(r8) :: error_level
966  real(r8) :: max_rel_error, rel_error, value
967  integer(itm_i4) :: i1, i2, i3, i4
968 
969  character(len = 132) :: f_maximum
970 
971  if (size(reference_field) /= size(new_field)) then
972 
973  write(f_maximum, '(a132)') 'ERROR: field sizes differ'
974 
975  else
976 
977  if (any(reference_field /= new_field)) then
978  diff_counter = diff_counter + 1
979  end if
980 
981  max_rel_error = 0._r8
982  value = 0._r8
983 
984  do i1 = 1, size(reference_field, 1)
985  do i2 = 1, size(reference_field, 2)
986  do i3 = 1, size(reference_field, 3)
987  do i4 = 1, size(reference_field, 4)
988  rel_error = abs(new_field(i1, i2, i3, i4) - reference_field(i1, i2, i3, i4)) &
989  / (abs(new_field(i1, i2, i3, i4) + reference_field(i1, i2, i3, i4)) / 2._r8 + abs(eps))
990  if (rel_error > max_rel_error) then
991  max_rel_error = rel_error
992  value = new_field(i1, i2, i3, i4)
993  end if
994  end do
995  end do
996  end do
997  end do
998 
999  write(f_maximum, 1) max_rel_error, value
1000 
1001  error_level = max(error_level, max_rel_error)
1002 
1003  end if
1004 
1005  1 format(' ---> maximum relative error: ', e9.2, ' --- value at maximum relative error: ', e9.2)
1006 
1007  end function maximum_relative_error_array4dflt_type
1008 
1009  function maximum_relative_error_array5dflt_type(reference_field, new_field, &
1010  diff_counter, error_level) result(f_maximum)
1011 
1012  implicit none
1013 
1014  real(r8), parameter :: eps = 1.e-8
1015  real(r8), dimension(:, :, :, :, :), pointer :: reference_field, new_field
1016  integer(itm_i4) :: diff_counter
1017  real(r8) :: error_level
1018  real(r8) :: max_rel_error, rel_error, value
1019  integer(itm_i4) :: i1, i2, i3, i4, i5
1020 
1021  character(len = 132) :: f_maximum
1022 
1023  if (size(reference_field) /= size(new_field)) then
1024 
1025  write(f_maximum, '(a132)') 'ERROR: field sizes differ'
1026 
1027  else
1028 
1029  if (any(reference_field /= new_field)) then
1030  diff_counter = diff_counter + 1
1031  end if
1032 
1033  max_rel_error = 0._r8
1034  value = 0._r8
1035 
1036  do i1 = 1, size(reference_field, 1)
1037  do i2 = 1, size(reference_field, 2)
1038  do i3 = 1, size(reference_field, 3)
1039  do i4 = 1, size(reference_field, 4)
1040  do i5 = 1, size(reference_field, 5)
1041  rel_error = abs(new_field(i1, i2, i3, i4, i5) - reference_field(i1, i2, i3, i4, i5)) &
1042  / (abs(new_field(i1, i2, i3, i4, i5) + reference_field(i1, i2, i3, i4, i5)) / 2._r8 + abs(eps))
1043  if (rel_error > max_rel_error) then
1044  max_rel_error = rel_error
1045  value = new_field(i1, i2, i3, i4, i5)
1046  end if
1047  end do
1048  end do
1049  end do
1050  end do
1051  end do
1052 
1053  write(f_maximum, 1) max_rel_error, value
1054 
1055  error_level = max(error_level, max_rel_error)
1056 
1057  end if
1058 
1059  1 format(' ---> maximum relative error: ', e9.2, ' --- value at maximum relative error: ', e9.2)
1060 
1061  end function maximum_relative_error_array5dflt_type
1062 
1063  function maximum_relative_error_array6dflt_type(reference_field, new_field, &
1064  diff_counter, error_level) result(f_maximum)
1065 
1066  implicit none
1067 
1068  real(r8), parameter :: eps = 1.e-8
1069  real(r8), dimension(:, :, :, :, :, :), pointer :: reference_field, new_field
1070  integer(itm_i4) :: diff_counter
1071  real(r8) :: error_level
1072  real(r8) :: max_rel_error, rel_error, value
1073  integer(itm_i4) :: i1, i2, i3, i4, i5, i6
1074 
1075  character(len = 132) :: f_maximum
1076 
1077  if (size(reference_field) /= size(new_field)) then
1078 
1079  write(f_maximum, '(a132)') 'ERROR: field sizes differ'
1080 
1081  else
1082 
1083  if (any(reference_field /= new_field)) then
1084  diff_counter = diff_counter + 1
1085  end if
1086 
1087  max_rel_error = 0._r8
1088  value = 0._r8
1089 
1090  do i1 = 1, size(reference_field, 1)
1091  do i2 = 1, size(reference_field, 2)
1092  do i3 = 1, size(reference_field, 3)
1093  do i4 = 1, size(reference_field, 4)
1094  do i5 = 1, size(reference_field, 5)
1095  do i6 = 1, size(reference_field, 6)
1096  rel_error = abs(new_field(i1, i2, i3, i4, i5, i6) - reference_field(i1, i2, i3, i4, i5, i6)) &
1097  / (abs(new_field(i1, i2, i3, i4, i5, i6) + reference_field(i1, i2, i3, i4, i5, i6)) / 2._r8 + abs(eps))
1098  if (rel_error > max_rel_error) then
1099  max_rel_error = rel_error
1100  value = new_field(i1, i2, i3, i4, i5, i6)
1101  end if
1102  end do
1103  end do
1104  end do
1105  end do
1106  end do
1107  end do
1108 
1109  write(f_maximum, 1) max_rel_error, value
1110 
1111  error_level = max(error_level, max_rel_error)
1112 
1113  end if
1114 
1115  1 format(' ---> maximum relative error: ', e9.2, ' --- value at maximum relative error: ', e9.2)
1116 
1117  end function maximum_relative_error_array6dflt_type
1118 
1119  function maximum_relative_error_array7dflt_type(reference_field, new_field, &
1120  diff_counter, error_level) result(f_maximum)
1121 
1122  implicit none
1123 
1124  real(r8), parameter :: eps = 1.e-8
1125  real(r8), dimension(:, :, :, :, :, :, :), pointer :: reference_field, new_field
1126  integer(itm_i4) :: diff_counter
1127  real(r8) :: error_level
1128  real(r8) :: max_rel_error, rel_error, value
1129  integer(itm_i4) :: i1, i2, i3, i4, i5, i6, i7
1130 
1131  character(len = 132) :: f_maximum
1132 
1133  if (size(reference_field) /= size(new_field)) then
1134 
1135  write(f_maximum, '(a132)') 'ERROR: field sizes differ'
1136 
1137  else
1138 
1139  if (any(reference_field /= new_field)) then
1140  diff_counter = diff_counter + 1
1141  end if
1142 
1143  max_rel_error = 0._r8
1144  value = 0._r8
1145 
1146  do i1 = 1, size(reference_field, 1)
1147  do i2 = 1, size(reference_field, 2)
1148  do i3 = 1, size(reference_field, 3)
1149  do i4 = 1, size(reference_field, 4)
1150  do i5 = 1, size(reference_field, 5)
1151  do i6 = 1, size(reference_field, 6)
1152  do i7 = 1, size(reference_field, 7)
1153  rel_error = abs(new_field(i1, i2, i3, i4, i5, i6, i7) - reference_field(i1, i2, i3, i4, i5, i6, i7)) &
1154  / (abs(new_field(i1, i2, i3, i4, i5, i6, i7) + reference_field(i1, i2, i3, i4, i5, i6, i7)) / 2._r8 + abs(eps))
1155  if (rel_error > max_rel_error) then
1156  max_rel_error = rel_error
1157  value = new_field(i1, i2, i3, i4, i5, i6, i7)
1158  end if
1159  end do
1160  end do
1161  end do
1162  end do
1163  end do
1164  end do
1165  end do
1166 
1167  write(f_maximum, 1) max_rel_error, value
1168 
1169  error_level = max(error_level, max_rel_error)
1170 
1171  end if
1172 
1173  1 format(' ---> maximum relative error: ', e9.2, ' --- value at maximum relative error: ', e9.2)
1174 
1175  end function maximum_relative_error_array7dflt_type
1176 
1177  function chi_square_float(diff_counter, error_level, &
1178  reference_field_float, new_field_float, &
1179  reference_field_array3dflt_type, new_field_array3dflt_type, &
1180  reference_field_array4dflt_type, new_field_array4dflt_type, &
1181  reference_field_array5dflt_type, new_field_array5dflt_type, &
1182  reference_field_array6dflt_type, new_field_array6dflt_type, &
1183  reference_field_array7dflt_type, new_field_array7dflt_type, &
1184  reference_field_matflt_type, new_field_matflt_type, &
1185  reference_field_vecflt_type, new_field_vecflt_type) &
1186  result(f_chi2)
1187 
1188  implicit none
1189 
1190  real(r8), intent(in), optional :: reference_field_float, new_field_float
1191  real(r8), dimension(:, :, :), pointer, optional :: reference_field_array3dflt_type, new_field_array3dflt_type
1192  real(r8), dimension(:, :, :, :), pointer, optional :: reference_field_array4dflt_type, new_field_array4dflt_type
1193  real(r8), dimension(:, :, :, :, :), pointer, optional :: reference_field_array5dflt_type, new_field_array5dflt_type
1194  real(r8), dimension(:, :, :, :, :, :), pointer, optional :: reference_field_array6dflt_type, new_field_array6dflt_type
1195  real(r8), dimension(:, :, :, :, :, :, :), pointer, optional :: reference_field_array7dflt_type, new_field_array7dflt_type
1196  real(r8), dimension(:, :), pointer, optional :: reference_field_matflt_type, new_field_matflt_type
1197  real(r8), dimension(:), pointer, optional :: reference_field_vecflt_type, new_field_vecflt_type
1198  integer(itm_i4) :: diff_counter
1199  real(r8) :: error_level
1200 
1201  character(len = 132) :: f_chi2
1202 
1203  if (present(reference_field_vecflt_type)) then
1204  f_chi2 = chi_square(reference_field_vecflt_type, new_field_vecflt_type, diff_counter, error_level)
1205  else if (present(reference_field_matflt_type)) then
1206  f_chi2 = chi_square(reference_field_matflt_type, new_field_matflt_type, diff_counter, error_level)
1207  else if (present(reference_field_array3dflt_type)) then
1208  f_chi2 = chi_square(reference_field_array3dflt_type, new_field_array3dflt_type, diff_counter, error_level)
1209  else if (present(reference_field_array4dflt_type)) then
1210  f_chi2 = chi_square(reference_field_array4dflt_type, new_field_array4dflt_type, diff_counter, error_level)
1211  else if (present(reference_field_array5dflt_type)) then
1212  f_chi2 = chi_square(reference_field_array5dflt_type, new_field_array5dflt_type, diff_counter, error_level)
1213  else if (present(reference_field_array6dflt_type)) then
1214  f_chi2 = chi_square(reference_field_array6dflt_type, new_field_array6dflt_type, diff_counter, error_level)
1215  else if (present(reference_field_array7dflt_type)) then
1216  f_chi2 = chi_square(reference_field_array7dflt_type, new_field_array7dflt_type, diff_counter, error_level)
1217  else
1218  f_chi2 = chi_square(reference_field_float, new_field_float, diff_counter, error_level)
1219  end if
1220 
1221  end function chi_square_float
1222 
1223  function chi_square_float_type(reference_field, new_field, &
1224  diff_counter, error_level) result(f_chi2)
1225 
1226  implicit none
1227 
1228  real(r8), intent(in) :: reference_field, new_field
1229  integer(itm_i4) :: diff_counter
1230  real(r8) :: error_level
1231  real(r8) :: chi2
1232 
1233  character(len = 132) :: f_chi2
1234 
1235  chi2 = (new_field - reference_field)**2
1236 
1237  if (reference_field /= new_field) then
1238  diff_counter = diff_counter + 1
1239  end if
1240 
1241  write(f_chi2, 1) chi2
1242 
1243  error_level = error_level + chi2
1244 
1245  1 format(' ---> chi^2 : ', e9.2)
1246 
1247  end function chi_square_float_type
1248 
1249  function chi_square_vecflt_type(reference_field, new_field, &
1250  diff_counter, error_level) result(f_chi2)
1251 
1252  implicit none
1253 
1254  real(r8), dimension(:), pointer :: reference_field, new_field
1255  integer(itm_i4) :: diff_counter
1256  real(r8) :: error_level
1257  real(r8) :: chi2
1258  integer(itm_i4) :: i1
1259 
1260  character(len = 132) :: f_chi2
1261 
1262  if (size(reference_field) /= size(new_field)) then
1263 
1264  write(f_chi2, '(a132)') 'ERROR: field sizes differ'
1265 
1266  else
1267 
1268  if (any(reference_field /= new_field)) then
1269  diff_counter = diff_counter + 1
1270  end if
1271 
1272  chi2 = 0._r8
1273 
1274  do i1 = 1, size(reference_field, 1)
1275  chi2 = chi2 + (new_field(i1) - reference_field(i1))**2
1276  end do
1277 
1278  write(f_chi2, 1) chi2
1279 
1280  error_level = error_level + chi2
1281 
1282  end if
1283 
1284  1 format(' ---> chi^2 : ', e9.2)
1285 
1286  end function chi_square_vecflt_type
1287 
1288  function chi_square_matflt_type(reference_field, new_field, &
1289  diff_counter, error_level) result(f_chi2)
1290 
1291  implicit none
1292 
1293  real(r8), dimension(:, :), pointer :: reference_field, new_field
1294  integer(itm_i4) :: diff_counter
1295  real(r8) :: error_level
1296  real(r8) :: chi2
1297  integer(itm_i4) :: i1, i2
1298 
1299  character(len = 132) :: f_chi2
1300 
1301  if (size(reference_field) /= size(new_field)) then
1302 
1303  write(f_chi2, '(a132)') 'ERROR: field sizes differ'
1304 
1305  else
1306 
1307  if (any(reference_field /= new_field)) then
1308  diff_counter = diff_counter + 1
1309  end if
1310 
1311  chi2 = 0._r8
1312 
1313  do i1 = 1, size(reference_field, 1)
1314  do i2 = 1, size(reference_field, 2)
1315  chi2 = chi2 + (new_field(i1, i2) - reference_field(i1, i2))**2
1316  end do
1317  end do
1318 
1319  write(f_chi2, 1) chi2
1320 
1321  error_level = error_level + chi2
1322 
1323  end if
1324 
1325  1 format(' ---> chi^2 : ', e9.2)
1326 
1327  end function chi_square_matflt_type
1328 
1329  function chi_square_array3dflt_type(reference_field, new_field, &
1330  diff_counter, error_level) result(f_chi2)
1331 
1332  implicit none
1333 
1334  real(r8), dimension(:, :, :), pointer :: reference_field, new_field
1335  integer(itm_i4) :: diff_counter
1336  real(r8) :: error_level
1337  real(r8) :: chi2
1338  integer(itm_i4) :: i1, i2, i3
1339 
1340  character(len = 132) :: f_chi2
1341 
1342  if (size(reference_field) /= size(new_field)) then
1343 
1344  write(f_chi2, '(a132)') 'ERROR: field sizes differ'
1345 
1346  else
1347 
1348  if (any(reference_field /= new_field)) then
1349  diff_counter = diff_counter + 1
1350  end if
1351 
1352  chi2 = 0._r8
1353 
1354  do i1 = 1, size(reference_field, 1)
1355  do i2 = 1, size(reference_field, 2)
1356  do i3 = 1, size(reference_field, 3)
1357  chi2 = chi2 + (new_field(i1, i2, i3) - reference_field(i1, i2, i3))**2
1358  end do
1359  end do
1360  end do
1361 
1362  write(f_chi2, 1) chi2
1363 
1364  error_level = error_level + chi2
1365 
1366  end if
1367 
1368  1 format(' ---> chi^2 : ', e9.2)
1369 
1370  end function chi_square_array3dflt_type
1371 
1372  function chi_square_array4dflt_type(reference_field, new_field, &
1373  diff_counter, error_level) result(f_chi2)
1374 
1375  implicit none
1376 
1377  real(r8), dimension(:, :, :, :), pointer :: reference_field, new_field
1378  integer(itm_i4) :: diff_counter
1379  real(r8) :: error_level
1380  real(r8) :: chi2
1381  integer(itm_i4) :: i1, i2, i3, i4
1382 
1383  character(len = 132) :: f_chi2
1384 
1385  if (size(reference_field) /= size(new_field)) then
1386 
1387  write(f_chi2, '(a132)') 'ERROR: field sizes differ'
1388 
1389  else
1390 
1391  if (any(reference_field /= new_field)) then
1392  diff_counter = diff_counter + 1
1393  end if
1394 
1395  chi2 = 0._r8
1396 
1397  do i1 = 1, size(reference_field, 1)
1398  do i2 = 1, size(reference_field, 2)
1399  do i3 = 1, size(reference_field, 3)
1400  do i4 = 1, size(reference_field, 4)
1401  chi2 = chi2 + (new_field(i1, i2, i3, i4) - reference_field(i1, i2, i3, i4))**2
1402  end do
1403  end do
1404  end do
1405  end do
1406 
1407  write(f_chi2, 1) chi2
1408 
1409  error_level = error_level + chi2
1410 
1411  end if
1412 
1413  1 format(' ---> chi^2 : ', e9.2)
1414 
1415  end function chi_square_array4dflt_type
1416 
1417  function chi_square_array5dflt_type(reference_field, new_field, &
1418  diff_counter, error_level) result(f_chi2)
1419 
1420  implicit none
1421 
1422  real(r8), dimension(:, :, :, :, :), pointer :: reference_field, new_field
1423  integer(itm_i4) :: diff_counter
1424  real(r8) :: error_level
1425  real(r8) :: chi2
1426  integer(itm_i4) :: i1, i2, i3, i4, i5
1427 
1428  character(len = 132) :: f_chi2
1429 
1430  if (size(reference_field) /= size(new_field)) then
1431 
1432  write(f_chi2, '(a132)') 'ERROR: field sizes differ'
1433 
1434  else
1435 
1436  if (any(reference_field /= new_field)) then
1437  diff_counter = diff_counter + 1
1438  end if
1439 
1440  chi2 = 0._r8
1441 
1442  do i1 = 1, size(reference_field, 1)
1443  do i2 = 1, size(reference_field, 2)
1444  do i3 = 1, size(reference_field, 3)
1445  do i4 = 1, size(reference_field, 4)
1446  do i5 = 1, size(reference_field, 5)
1447  chi2 = chi2 + (new_field(i1, i2, i3, i4, i5) - reference_field(i1, i2, i3, i4, i5))**2
1448  end do
1449  end do
1450  end do
1451  end do
1452  end do
1453 
1454  write(f_chi2, 1) chi2
1455 
1456  error_level = error_level + chi2
1457 
1458  end if
1459 
1460  1 format(' ---> chi^2 : ', e9.2)
1461 
1462  end function chi_square_array5dflt_type
1463 
1464  function chi_square_array6dflt_type(reference_field, new_field, &
1465  diff_counter, error_level) result(f_chi2)
1466 
1467  implicit none
1468 
1469  real(r8), dimension(:, :, :, :, :, :), pointer :: reference_field, new_field
1470  integer(itm_i4) :: diff_counter
1471  real(r8) :: error_level
1472  real(r8) :: chi2
1473  integer(itm_i4) :: i1, i2, i3, i4, i5, i6
1474 
1475  character(len = 132) :: f_chi2
1476 
1477  if (size(reference_field) /= size(new_field)) then
1478 
1479  write(f_chi2, '(a132)') 'ERROR: field sizes differ'
1480 
1481  else
1482 
1483  if (any(reference_field /= new_field)) then
1484  diff_counter = diff_counter + 1
1485  end if
1486 
1487  chi2 = 0._r8
1488 
1489  do i1 = 1, size(reference_field, 1)
1490  do i2 = 1, size(reference_field, 2)
1491  do i3 = 1, size(reference_field, 3)
1492  do i4 = 1, size(reference_field, 4)
1493  do i5 = 1, size(reference_field, 5)
1494  do i6 = 1, size(reference_field, 6)
1495  chi2 = chi2 + (new_field(i1, i2, i3, i4, i5, i6) - reference_field(i1, i2, i3, i4, i5, i6))**2
1496  end do
1497  end do
1498  end do
1499  end do
1500  end do
1501  end do
1502 
1503  write(f_chi2, 1) chi2
1504 
1505  error_level = error_level + chi2
1506 
1507  end if
1508 
1509  1 format(' ---> chi^2 : ', e9.2)
1510 
1511  end function chi_square_array6dflt_type
1512 
1513  function chi_square_array7dflt_type(reference_field, new_field, &
1514  diff_counter, error_level) result(f_chi2)
1515 
1516  implicit none
1517 
1518  real(r8), dimension(:, :, :, :, :, :, :), pointer :: reference_field, new_field
1519  integer(itm_i4) :: diff_counter
1520  real(r8) :: error_level
1521  real(r8) :: chi2
1522  integer(itm_i4) :: i1, i2, i3, i4, i5, i6, i7
1523 
1524  character(len = 132) :: f_chi2
1525 
1526  if (size(reference_field) /= size(new_field)) then
1527 
1528  write(f_chi2, '(a132)') 'ERROR: field sizes differ'
1529 
1530  else
1531 
1532  if (any(reference_field /= new_field)) then
1533  diff_counter = diff_counter + 1
1534  end if
1535 
1536  chi2 = 0._r8
1537 
1538  do i1 = 1, size(reference_field, 1)
1539  do i2 = 1, size(reference_field, 2)
1540  do i3 = 1, size(reference_field, 3)
1541  do i4 = 1, size(reference_field, 4)
1542  do i5 = 1, size(reference_field, 5)
1543  do i6 = 1, size(reference_field, 6)
1544  do i7 = 1, size(reference_field, 7)
1545  chi2 = chi2 + (new_field(i1, i2, i3, i4, i5, i6, i7) - reference_field(i1, i2, i3, i4, i5, i6, i7))**2
1546  end do
1547  end do
1548  end do
1549  end do
1550  end do
1551  end do
1552  end do
1553 
1554  write(f_chi2, 1) chi2
1555 
1556  error_level = error_level + chi2
1557 
1558  end if
1559 
1560  1 format(' ---> chi^2 : ', e9.2)
1561 
1562  end function chi_square_array7dflt_type
1563 
1564 end module error_analysis
error_analysis::maximum_relative_error_float
character(len=132) function maximum_relative_error_float(diff_counter, error_level, reference_field_float, new_field_float, reference_field_array3dflt_type, new_field_array3dflt_type, reference_field_array4dflt_type, new_field_array4dflt_type, reference_field_array5dflt_type, new_field_array5dflt_type, reference_field_array6dflt_type, new_field_array6dflt_type, reference_field_array7dflt_type, new_field_array7dflt_type, reference_field_matflt_type, new_field_matflt_type, reference_field_vecflt_type, new_field_vecflt_type)
Definition: error_analysis.f90:738
error_analysis::average_relative_error::average_relative_error_array4dflt_type
character(len=132) function average_relative_error_array4dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:520
error_analysis::maximum_relative_error::maximum_relative_error_array3dflt_type
character(len=132) function maximum_relative_error_array3dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:907
error_analysis::are_identical::are_identical_array5dflt_type
character(len=132) function are_identical_array5dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:237
error_analysis::chi_square::chi_square_array3dflt_type
character(len=132) function chi_square_array3dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1329
error_analysis::maximum_relative_error
Definition: error_analysis.f90:49
error_analysis::are_identical_float
character(len=132) function are_identical_float(diff_counter, error_level, reference_field_float, new_field_float, reference_field_array3dflt_type, new_field_array3dflt_type, reference_field_array4dflt_type, new_field_array4dflt_type, reference_field_array5dflt_type, new_field_array5dflt_type, reference_field_array6dflt_type, new_field_array6dflt_type, reference_field_array7dflt_type, new_field_array7dflt_type, reference_field_matflt_type, new_field_matflt_type, reference_field_vecflt_type, new_field_vecflt_type)
Definition: error_analysis.f90:75
error_analysis::are_identical::are_identical_array7dflt_type
character(len=132) function are_identical_array7dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:285
error_analysis::maximum_relative_error::maximum_relative_error_vecflt_type
character(len=132) function maximum_relative_error_vecflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:813
error_analysis::average_relative_error::average_relative_error_array6dflt_type
character(len=132) function average_relative_error_array6dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:622
error_analysis::maximum_relative_error::maximum_relative_error_matflt_type
character(len=132) function maximum_relative_error_matflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:859
error_analysis::average_relative_error::average_relative_error_matflt_type
character(len=132) function average_relative_error_matflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:426
error_analysis::chi_square_float
character(len=132) function chi_square_float(diff_counter, error_level, reference_field_float, new_field_float, reference_field_array3dflt_type, new_field_array3dflt_type, reference_field_array4dflt_type, new_field_array4dflt_type, reference_field_array5dflt_type, new_field_array5dflt_type, reference_field_array6dflt_type, new_field_array6dflt_type, reference_field_array7dflt_type, new_field_array7dflt_type, reference_field_matflt_type, new_field_matflt_type, reference_field_vecflt_type, new_field_vecflt_type)
Definition: error_analysis.f90:1177
error_analysis::average_relative_error::average_relative_error_array7dflt_type
character(len=132) function average_relative_error_array7dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:679
error_analysis::chi_square
Definition: error_analysis.f90:61
error_analysis::maximum_relative_error::maximum_relative_error_array7dflt_type
character(len=132) function maximum_relative_error_array7dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1119
error_analysis::average_relative_error::average_relative_error_array3dflt_type
character(len=132) function average_relative_error_array3dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:472
error_analysis::maximum_relative_error::maximum_relative_error_array6dflt_type
character(len=132) function maximum_relative_error_array6dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1063
error_analysis::are_identical::are_identical_array4dflt_type
character(len=132) function are_identical_array4dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:213
error_analysis::chi_square::chi_square_float_type
character(len=132) function chi_square_float_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1223
error_analysis::average_relative_error::average_relative_error_vecflt_type
character(len=132) function average_relative_error_vecflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:383
error_analysis::are_identical
Definition: error_analysis.f90:25
error_analysis::chi_square::chi_square_vecflt_type
character(len=132) function chi_square_vecflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1249
error_analysis::average_relative_error::average_relative_error_float_type
character(len=132) function average_relative_error_float_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:355
error_analysis::chi_square::chi_square_array7dflt_type
character(len=132) function chi_square_array7dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1513
error_analysis::chi_square::chi_square_matflt_type
character(len=132) function chi_square_matflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1288
error_analysis::maximum_relative_error::maximum_relative_error_float_type
character(len=132) function maximum_relative_error_float_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:784
error_analysis::chi_square::chi_square_array4dflt_type
character(len=132) function chi_square_array4dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1372
error_analysis::average_relative_error::average_relative_error_array5dflt_type
character(len=132) function average_relative_error_array5dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:570
error_analysis::are_identical::are_identical_array6dflt_type
character(len=132) function are_identical_array6dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:261
error_analysis::average_relative_error
Definition: error_analysis.f90:37
error_analysis::average_relative_error_float
character(len=132) function average_relative_error_float(diff_counter, error_level, reference_field_float, new_field_float, reference_field_array3dflt_type, new_field_array3dflt_type, reference_field_array4dflt_type, new_field_array4dflt_type, reference_field_array5dflt_type, new_field_array5dflt_type, reference_field_array6dflt_type, new_field_array6dflt_type, reference_field_array7dflt_type, new_field_array7dflt_type, reference_field_matflt_type, new_field_matflt_type, reference_field_vecflt_type, new_field_vecflt_type)
Definition: error_analysis.f90:309
error_analysis::maximum_relative_error::maximum_relative_error_array4dflt_type
character(len=132) function maximum_relative_error_array4dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:957
error_analysis::are_identical::are_identical_array3dflt_type
character(len=132) function are_identical_array3dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:189
error_analysis
This module is an example for the error_analysis module which shall hold the user defined error analy...
Definition: error_analysis.f90:19
error_analysis::chi_square::chi_square_array5dflt_type
character(len=132) function chi_square_array5dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1417
error_analysis::are_identical::are_identical_vecflt_type
character(len=132) function are_identical_vecflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:141
error_analysis::chi_square::chi_square_array6dflt_type
character(len=132) function chi_square_array6dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1464
error_analysis::are_identical::are_identical_float_type
character(len=132) function are_identical_float_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:121
error_analysis::maximum_relative_error::maximum_relative_error_array5dflt_type
character(len=132) function maximum_relative_error_array5dflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:1009
error_analysis::are_identical::are_identical_matflt_type
character(len=132) function are_identical_matflt_type(reference_field, new_field, diff_counter, error_level)
Definition: error_analysis.f90:165