EIRAM
atomic and molecular data in form of polynomial fits
eiram_test.f90
Go to the documentation of this file.
1 
6 
7 ! Copyright (c) 2016 Forschungszentrum Juelich GmbH
8 ! Markus Brenneis, Vladislav Kotov
9 !
10 ! This file is part of EIRAM.
11 !
12 ! EIRAM is free software: you can redistribute it and/or modify
13 ! it under the terms of the GNU General Public License as published by
14 ! the Free Software Foundation, either version 3 of the License, or
15 ! (at your option) any later version.
16 !
17 ! EIRAM is distributed in the hope that it will be useful,
18 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ! GNU General Public License for more details.
21 !
22 ! You should have received a copy of the GNU General Public License
23 ! along with EIRAM. If not, see <http://www.gnu.org/licenses/>.
24 !
25 
26 module eiram_test
27  use eiram
28  implicit none
29 
32  public eiram_test_load
38  public eiram_test_calc12
39  public eiram_test_image
40  intrinsic log,exp,tiny
41 
42  private
44  real(EIRAM_DP), parameter :: rel_tolerance = 1e-7
45  character(*), parameter :: data_file_path = "../data/"
46  integer, parameter :: n_reactions = 5
47  integer, parameter :: n_energy = 5
48  character(9),parameter :: files(n_reactions) = (/ "HYDHELvk " , "AMJUELvk " , "HYDHELvk " , "AMJUELvk ", "METHANEvk" /)
49  character(6),parameter :: types(n_reactions) = (/ "H.1" , "H.2" , "H.3" , "H.4", "H.2" /)
50  character(8),parameter :: indices(n_reactions) = (/ "3.1.8 ", "2.4B0 ", "3.1.8 " , "2.1.5 ", "2.23 "/)
51  real(EIRAM_DP),parameter :: energy(n_energy) = (/ 5e-1, 1e0, 1e1, 1e2, 1e3 /)
52  real(EIRAM_DP), parameter :: x1(n_reactions) = (/ -1e0, -1e0, 1e1, 1e6, -1e0 /)
54  real(EIRAM_DP),parameter :: reference_values(n_energy,n_reactions)= &
55  reshape( (/ &
56  ! HYDHEL H.1 3.1.8
57  6.313479104896471d-15, 6.034774383818398d-15, &
58  4.631473573509119d-15, 3.143444136405398d-15, 1.744077658482620d-15, &
59  ! AMJUEL H.2 2.4B0
60  1.229920711197272d-16, 1.857264485174120d-12, &
61  2.944795004910767d-08, 1.073462933550498d-07, 7.992508213267738d-08, &
62  ! HYDHEL H.3 3.1.8
63  2.064031139307574d-08, 2.084428058191167d-08, &
64  2.582052648196180d-08, 4.420072796238867d-08, 8.043311877821200d-08, &
65  ! AMJUEL H.4 2.1.5
66  1.865302180435326d-19, 4.904897322289924d-14, &
67  9.954471496437615d-09, 4.738209685016329d-08, 2.907993073331902d-08, &
68  ! METHANE H.2 2.23
69  1.320141447945264d-18, 9.051595057476462d-14, &
70  2.966866133652682d-08, 1.909445571151299d-07, 1.391314913417069d-07 /), &
71  (/n_energy,n_reactions/))
72  contains
73 
75  logical function eiram_test_wrong_file()
76  integer :: err
77  eiram_test_wrong_file = .false.
78  call eiram_load(data_file_path, "AMJUELxx", err)
79  if(err /= 310) goto 100
80  call eiram_load("input/", "HYDHEL.corrupted", err)
81  if(err /= 300) goto 100
82  call eiram_deallocate(err)
83  if(err /= 0) goto 100
84  eiram_test_wrong_file = .true.
85  return
86 100 print *, "ERROR in eiram_test_wrong_file: unexpected error code ", err
87  call eiram_deallocate(err)
88  return
89  end function eiram_test_wrong_file
90 
92  logical function eiram_test_used_uninitialized()
93  integer :: err,id,n,m
94  real(eiram_dp) :: tmp(1),b(9,1)
95  type(eiram_data),allocatable :: data(:)
97  id = eiram_get_id("HYDHEL", "H.1", "3.1.8", err)
98  if(err /= 50) goto 150
99  call eiram_get_order(n,m,1, err)
100  if(err /= 50) goto 150
101  call eiram_calc1(tmp,1,(/1._eiram_dp/),err)
102  if(err /= 50) goto 150
103  call eiram_calc12(b,1,(/2._eiram_dp/),err)
104  if(err /= 50) goto 150
105  call eiram_calc2(tmp,1,(/1._eiram_dp/),(/1._eiram_dp/),err)
106  if(err /= 50) goto 150
107  call eiram_create_image(data,err)
108  if(err /= 50) goto 150
109  call eiram_deallocate(err)
110  if(err /= 0) goto 150
112  return
113 150 print *, "ERROR in eiram_test_used_uninitialized: unexpected error code ", err
114  call eiram_deallocate(err)
115  return
116  end function eiram_test_used_uninitialized
117 
119  logical function eiram_test_load()
120  integer :: err,N,N0
121  eiram_test_load=.false.
122  call eiram_load(data_file_path, "HYDHEL", err)
123  if(err /= 0) goto 100
124  n=eiram_nreact
125  if(n/=208) then
126  print *, "ERROR detected in eiram_test_load: "
127  print *, " unexpected number of loaded reactions for HYDHEL"
128  print *, " expected ",208," loaded ",n
129  return
130  end if
131  n0=eiram_nreact
132  call eiram_load(data_file_path, "HYDHELvk", err)
133  if(err /= 0) goto 100
134  n=eiram_nreact-n0
135  if(n/=197) then
136  print *, "ERROR detected in eiram_test_load: "
137  print *, " unexpected number of loaded reactions for HYDHELvk"
138  print *, " expected ",197," loaded ",n
139  return
140  end if
141  n0=eiram_nreact
142  call eiram_load(data_file_path, "AMJUELvk", err)
143  if(err /= 0) goto 100
144  n=eiram_nreact-n0
145  if(n/=207) then
146  print *, "ERROR detected in eiram_test_load: "
147  print *, " unexpected number of loaded reactions for AMJUELvk"
148  print *, " expected ",207," loaded ",n
149  return
150  end if
151  n0=eiram_nreact
152  call eiram_load(data_file_path, "AMJUEL", err)
153  if(err /= 0) goto 100
154  n=eiram_nreact-n0
155  if(n/=269) then
156  print *, "ERROR detected in eiram_test_load: "
157  print *, " unexpected number of loaded reactions for AMJUEL"
158  print *, " expected ",269," loaded ",n
159  return
160  end if
161  n0=eiram_nreact
162  call eiram_load(data_file_path, "METHANE", err)
163  if(err /= 0) goto 100
164  n=eiram_nreact-n0
165  if(n/=91) then
166  print *, "ERROR detected in eiram_test_load: "
167  print *, " unexpected number of loaded reactions for METHANE"
168  print *, " expected ",91," loaded ",n
169  return
170  end if
171  n0=eiram_nreact
172  call eiram_load(data_file_path, "H2VIBR", err)
173  if(err /= 0) goto 100
174  n=eiram_nreact-n0
175  if(n/=112) then
176  print *, "ERROR detected in eiram_test_load: "
177  print *, " unexpected number of loaded reactions for H2VIBR"
178  print *, " expected ",112," loaded ",n
179  return
180  end if
181  n0=eiram_nreact
182  call eiram_load(data_file_path, "METHANEvk", err)
183  if(err /= 0) goto 100
184  n=eiram_nreact-n0
185  if(n/=64) then
186  print *, "ERROR detected in eiram_test_load: "
187  print *, " unexpected number of loaded reactions for METHANEvk"
188  print *, " expected ",64," loaded ",n
189  return
190  end if
191  call eiram_load(data_file_path, "H2VIBRvk", err)
192  if(err /= 0) goto 100
193  n=eiram_nreact-n0
194  if(n/=161) then
195  print *, "ERROR detected in eiram_test_load: "
196  print *, " unexpected number of loaded reactions for H2VIBRvk"
197  print *, " expected ",161," loaded ",n
198  return
199  end if
200 
201  call eiram_deallocate(err)
202  if(err /= 0) goto 100
203 
204  eiram_test_load = .true.
205  return
206 
207 100 print *, "ERROR in eiram_test_load: unexpected error code ", err
208  call eiram_deallocate(err)
209  return
210  end function eiram_test_load
211 
213  logical function eiram_test_wrong_ids()
214  integer :: err
215  real(kind=EIRAM_DP) :: tmp(1),b(9,1)
216  eiram_test_wrong_ids = .false.
217  call eiram_load(data_file_path, "HYDHEL", err)
218  if(err /= 0) goto 200
219  call eiram_calc1(tmp,-1, (/1d0/),err)
220  if(err /= 100) goto 200
221  call eiram_calc1(tmp,100000,(/1d0/),err)
222  if(err /= 100) goto 200
223  call eiram_calc12(b,-1, (/2d0/),err)
224  if(err /= 100) goto 200
225  call eiram_calc12(b,100000,(/2d0/),err)
226  if(err /= 100) goto 200
227  call eiram_calc2(tmp,-1,(/1d0/),(/2d0/),err)
228  if(err /= 100) goto 200
229  call eiram_calc2(tmp,100000,(/1d0/),(/2d0/),err)
230  if(err /= 100) goto 200
231  call eiram_deallocate(err)
232  if(err /= 0) goto 200
233  eiram_test_wrong_ids = .true.
234  return
235 200 print *, "ERROR in eiram_test_wrong_ids: unexpected error code ", err
236  call eiram_deallocate(err)
237  return
238  end function eiram_test_wrong_ids
239 
241  logical function eiram_test_unknown_reaction()
242  integer :: err, id
244  call eiram_load(data_file_path, "HYDHEL", err)
245  if(err /= 0) goto 300
246  id = eiram_get_id("HYDHEL", "H.1", "3.18", err)
247  if(err /= 110) goto 300
248  id = eiram_get_id("HYDHEL", "H1", "3.1.8", err)
249  if(err /= 110) goto 300
250  id = eiram_get_id("AMJUEL", "H.1", "3.1.8", err)
251  if(err /= 110) goto 300
252  id = eiram_get_id("AMMMJUEL", "H.1", "3.1.8", err)
253  if(err /= 110) goto 300
254  id = eiram_get_id("HYDHEL", "H.1", "3.1.8", err)
255  if(err /= 0 .or. id < 1) goto 300
256  call eiram_deallocate(err)
257  if(err /= 0) goto 300
259  return
260 300 print *, "ERROR in eiram_test_unknown_reaction: unexpected error code ", err
261  call eiram_deallocate(err)
262  return
263  end function eiram_test_unknown_reaction
264 
267  logical function eiram_test_wrong_type()
268  integer :: err, id
269  real(eiram_dp) :: tmp(1),b(9,1)
270  eiram_test_wrong_type = .false.
271  call eiram_load(data_file_path, "AMJUEL", err)
272  if(err /= 0) goto 100
273  id = eiram_get_id("AMJUEL","H.2","3.2.3",err)
274  if(err /= 0) goto 100
275  call eiram_calc2(tmp,id,(/1._eiram_dp/),(/2._eiram_dp/),err)
276  if(err /= 120) goto 100
277  call eiram_calc12(b,id,(/2._eiram_dp/),err)
278  if(err /= 120) goto 100
279  id = eiram_get_id("AMJUEL","H.4","2.1.5",err)
280  if(err /= 0) goto 100
281  call eiram_calc1(tmp,id,(/1._eiram_dp/),err)
282  if(err /= 130) goto 100
283  call eiram_deallocate(err)
284  if(err /= 0) goto 100
285  eiram_test_wrong_type = .true.
286  return
287 100 print *, "ERROR in eiram_test_wrong_type: unexpected error code ", err
288  call eiram_deallocate(err)
289  return
290  end function eiram_test_wrong_type
291 
293  logical function eiram_test_wrong_size()
294  integer :: err, id
295  real(eiram_dp) :: tmp(3),b(8,3),x1(2),x2(1),x(3),xx(1)
296  eiram_test_wrong_size = .false.
297  call eiram_load(data_file_path, "AMJUEL", err)
298  if(err /= 0) goto 100
299  call eiram_calc1(tmp,1,x1,err)
300  if(err /= 100) goto 100
301  call eiram_calc12(b,1,x1,err)
302  if(err /= 100) goto 100
303  id = eiram_get_id("AMJUEL","H.4","2.2.5g",err)
304  call eiram_calc12(b,id,x,err)
305  if(err /= 100) goto 100
306  call eiram_calc2(tmp,1,x1,x2,err)
307  if(err /= 100) goto 100
308  call eiram_calc2(tmp,1,x,x2,err)
309  if(err /= 100) goto 100
310  call eiram_calc2(tmp,1,x1,x,err)
311  if(err /= 100) goto 100
312  call eiram_calc2(tmp,1,xx,x2,err)
313  if(err /= 100) goto 100
314  call eiram_deallocate(err)
315  if(err /= 0) goto 100
316  eiram_test_wrong_size = .true.
317  return
318 100 print *, "ERROR in eiram_test_wrong_length: unexpected error code ", err
319  call eiram_deallocate(err)
320  return
321  end function eiram_test_wrong_size
322 
324  logical function eiram_test_calculation()
325  integer :: reactionId, r, err
326  real(EIRAM_DP) :: calculatedValues(n_energy)
327  logical, dimension(N_ENERGY) :: passed
328 
329  intrinsic log
330 
331  eiram_test_calculation = .false.
332  err = 0
333 
334  call eiram_load(data_file_path, "AMJUELvk", err)
335  if(err /= 0) goto 1000
336  call eiram_load(data_file_path, "HYDHELvk", err)
337  if(err /= 0) goto 1000
338  call eiram_load(data_file_path, "METHANEvk", err)
339  if(err /= 0) goto 1000
340 
341  do r = 1, n_reactions
342  reactionid = eiram_get_id(files(r), types(r), indices(r), err)
343  if(err /= 0) goto 1000
344  if(x1(r) < 0) then
345  call eiram_calc1(calculatedvalues,reactionid,log(energy),err)
346  if(err /= 0) goto 1000
347  else
348  call eiram_calc2(calculatedvalues,reactionid,(/log(x1(r))/),log(energy),err)
349  if(err /= 0) goto 1000
350  end if
351  passed = ispassed(reference_values(:,r), calculatedvalues)
352  call printfailed(reference_values(:,r), calculatedvalues, passed)
353  if(.not.all(passed)) goto 1001
354  end do
355 
356  eiram_test_calculation = .true.
357  call eiram_deallocate(err)
358  return
359 
360 1000 print *, "ERROR in eiram_test_calculation: unexpected err code ", err
361  call eiram_deallocate(err)
362  return
363 1001 print *, "ERROR in eiram_test_calculation: calculated values do not match pre-calculated values"
364  call eiram_deallocate(err)
365  return
366  end function eiram_test_calculation
367 
370  logical function eiram_test_calc12()
371  integer :: N,M,err,ID,k
372  integer,parameter :: NCELL=4
373  real(eiram_dp) :: T(ncell)=(/0.1,1.0,10.0,100.0/), &
374  e(ncell)=(/1.0,1.0,10.0,10.0/)
375  real(eiram_dp) :: b(9,ncell),Y1(ncell),Y2(ncell)
376  logical :: passed(ncell)
377 
378  call eiram_load(data_file_path, "AMJUEL", err)
379  if(err /= 0) goto 100
380  eiram_test_calc12 = .false.
381  id=eiram_get_id("AMJUEL","H.3","0.3D",err)
382  if(err /= 0) goto 100
383  call eiram_get_order(n,m,id,err)
384  if(err /= 0) goto 100
385  if(n /= 8 .or. m /= 8) then
386  print *, "ERROR: wrong values returned by eiram_get_order, N,M ",n,m
387  end if
388  call eiram_calc2(y1,id,log(e),log(t),err)
389  if(err /= 0) goto 100
390  call eiram_calc12(b,id,log(t),err)
391  if(err /= 0) goto 100
392  do k=1,ncell
393  y2(k)=exp(eiram_fit(b(:,k),m,log(e(k))))
394  end do
395 
396  passed = ispassed(y1,y2)
397  call printfailed(y1,y2, passed)
398  if(.not.all(passed)) goto 101
399 
400  eiram_test_calc12 = .true.
401  call eiram_deallocate(err)
402  return
403 
404 100 print *, "ERROR in eiram_test_calc12: unexpected err code ", err
405  call eiram_deallocate(err)
406  return
407 101 print *, "ERROR in eiram_test_calc12: mismatch between eiram_calc2 and eiram_calc12"
408  call eiram_deallocate(err)
409  return
410 
411  end function eiram_test_calc12
412 
414  logical function eiram_test_image()
415  integer :: N,i,err
416  type(eiram_data),allocatable :: data(:)
417 
418  eiram_test_image=.false.
419  call eiram_load(data_file_path, "HYDHEL", err)
420  if(err /= 0) goto 100
421  call eiram_load(data_file_path, "AMJUEL", err)
422  if(err /= 0) goto 100
423  call eiram_load(data_file_path, "METHANEvk", err)
424  if(err /= 0) goto 100
425 
426  call eiram_create_image(data,err)
427  if(err /= 0) goto 100
428 
429  n=size(data)
430 
431  do i=1,n
432  deallocate(data(i)%creac,stat=err)
433  if(err /= 0) goto 100
434  end do
435  deallocate(data,stat=err)
436  if(err /= 0) goto 100
437 
438  eiram_test_image = .true.
439  call eiram_deallocate(err)
440  return
441 
442 100 print *, "ERROR in eiram_test_image: unexpected err code ", err
443  call eiram_deallocate(err)
444  return
445  end function eiram_test_image
446 
447 
450  logical elemental function ispassed(expected, calculated)
451  real(kind=EIRAM_DP), intent(in) :: expected, calculated
452  intrinsic tiny
453  real(kind=EIRAM_DP) :: eps
454  eps=10.*tiny(expected)
455  ispassed = abs(calculated - expected) < rel_tolerance*expected + eps
456  end function ispassed
457 
462  subroutine printfailed(expected, calculated, passed)
463  real(kind=EIRAM_DP), dimension(:), intent(in) :: expected, calculated
464  logical, dimension(size(expected)), intent(in) :: passed
465  integer :: i
466  do i = 1, size(expected)
467  if(.not. passed(i)) then
468  print *, " Expected", expected(i), ", got", calculated(i)
469  print *, " Relative Error", abs(calculated(i) - expected(i))*100/expected(i), "%"
470  end if
471  end do
472  end subroutine printfailed
473 
474 
475 end module eiram_test
476 
477 
478 program test
479  use eiram_test
480  use eiram
481  implicit none
482 
483  eiram_unit = 0
484  if(.not.eiram_test_wrong_file()) stop "ERROR detected in eiram_test_wrong_file"
485  if(.not.eiram_test_used_uninitialized()) stop "ERROR detected in eiram_test_used_uninitialized"
486  if(.not.eiram_test_load()) stop "ERROR detected in eiram_test_load"
487  if(.not.eiram_test_wrong_ids()) stop "ERROR detected in eiram_test_wrong_ids"
488  if(.not.eiram_test_unknown_reaction()) stop "ERROR detected in eiram_test_unknown_reaction"
489  if(.not.eiram_test_wrong_type()) stop "ERROR detected in eiram_test_wrong_type"
490  if(.not.eiram_test_calculation()) stop "ERROR detected in eiram_test_calculation"
491  if(.not.eiram_test_calc12()) stop "ERROR detected in eiram_test_calc12"
492  if(.not.eiram_test_image()) stop "ERROR detected in eiram_test_image"
493  print *, "EIRAM_TEST COMPLETED"
494 end program
character(6), dimension(n_reactions), parameter types
Definition: eiram_test.f90:49
real(eiram_dp), dimension(n_energy, n_reactions), parameter reference_values
Reference values for regression tests in eiram_test_calculation.
Definition: eiram_test.f90:54
integer, public eiram_unit
Unit to which messages are written.
Definition: eiram.f90:112
logical function, public eiram_test_load()
Technical test which shows that expected number of reactions is loaded from each input file...
Definition: eiram_test.f90:120
subroutine, public eiram_load(filePath, fileName, err)
Initialization of the module from input files (data sets)
Definition: eiram.f90:206
character(9), dimension(n_reactions), parameter files
Definition: eiram_test.f90:48
logical function, public eiram_test_wrong_file()
Test for correct error codes if the input file does not exist or is malformed.
Definition: eiram_test.f90:76
integer, parameter n_reactions
Definition: eiram_test.f90:46
subroutine, public eiram_deallocate(err)
Deallocate dynamic arrays used by this module.
Definition: eiram.f90:585
logical function, public eiram_test_wrong_ids()
Test for correct error codes if reaction ID is invalid.
Definition: eiram_test.f90:214
subroutine, public eiram_get_order(N, M, Id, err)
Return order of the polynomial for both variables.
Definition: eiram.f90:895
Data for one reaction.
Definition: eiram.f90:142
real(eiram_dp), dimension(n_reactions), parameter x1
Definition: eiram_test.f90:52
external, public eiram_fit
Definition: eiram.f90:133
real(eiram_dp), dimension(n_energy), parameter energy
Definition: eiram_test.f90:51
real(eiram_dp), parameter rel_tolerance
Maximum relative error, parameter which is used to compare two values.
Definition: eiram_test.f90:44
logical function, public eiram_test_image()
Technical test of eiram_create_image.
Definition: eiram_test.f90:415
character(*), parameter data_file_path
Definition: eiram_test.f90:45
integer function, public eiram_get_id(fileName, reactionType, reactionIndex, err)
Return the ID-index of the given reaction in the arrays of the module.
Definition: eiram.f90:857
logical function, public eiram_test_wrong_type()
Test for correct error codes if _calc1 is called for double polynomial or _calc2, _calc12 is called f...
Definition: eiram_test.f90:268
logical function, public eiram_test_unknown_reaction()
Test for correct error code when querying id for an unknown reaction.
Definition: eiram_test.f90:242
logical function, public eiram_test_calculation()
Regression tests: compare calculated values with references.
Definition: eiram_test.f90:325
integer, public eiram_nreact
current number of loaded reactions
Definition: eiram.f90:187
subroutine, public eiram_calc12(B, Id, lnX, err)
Reduce double polynomial fit to single polynomials for given values of the second variable...
Definition: eiram.f90:1142
logical function, public eiram_test_calc12()
Regression test for subroutines _calc12 and _get_order compare _calc12 with subsequent call of _fit w...
Definition: eiram_test.f90:371
logical function, public eiram_test_used_uninitialized()
Test for correct error codes if eiram is used without initialization.
Definition: eiram_test.f90:93
subroutine, public eiram_calc2(Y, Id, LnX1, LnX2, err)
Calculate double polynomial fit.
Definition: eiram.f90:1219
character(8), dimension(n_reactions), parameter indices
Definition: eiram_test.f90:50
logical function, public eiram_test_wrong_size()
Test for correct error codes in case of mismatch of the array lengths.
Definition: eiram_test.f90:294
integer, parameter n_energy
Definition: eiram_test.f90:47
Definition: eiram.f90:96
subroutine, public eiram_create_image(data, err)
Create a copy (image) of the reactions array stored in the module.
Definition: eiram.f90:931
subroutine, public eiram_calc1(Y, Id, lnX, err)
Calculate single polynomial fit.
Definition: eiram.f90:1060
program test
Definition: eiram_test.f90:478