40 intrinsic log,exp,tiny
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 /)
57 6.313479104896471d-15, 6.034774383818398d-15, &
58 4.631473573509119d-15, 3.143444136405398d-15, 1.744077658482620d-15, &
60 1.229920711197272d-16, 1.857264485174120d-12, &
61 2.944795004910767d-08, 1.073462933550498d-07, 7.992508213267738d-08, &
63 2.064031139307574d-08, 2.084428058191167d-08, &
64 2.582052648196180d-08, 4.420072796238867d-08, 8.043311877821200d-08, &
66 1.865302180435326d-19, 4.904897322289924d-14, &
67 9.954471496437615d-09, 4.738209685016329d-08, 2.907993073331902d-08, &
69 1.320141447945264d-18, 9.051595057476462d-14, &
70 2.966866133652682d-08, 1.909445571151299d-07, 1.391314913417069d-07 /), &
79 if(err /= 310)
goto 100
80 call eiram_load(
"input/",
"HYDHEL.corrupted", err)
81 if(err /= 300)
goto 100
86 100 print *,
"ERROR in eiram_test_wrong_file: unexpected error code ", err
94 real(eiram_dp) :: tmp(1),b(9,1)
98 if(err /= 50)
goto 150
100 if(err /= 50)
goto 150
102 if(err /= 50)
goto 150
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
108 if(err /= 50)
goto 150
110 if(err /= 0)
goto 150
113 150 print *,
"ERROR in eiram_test_used_uninitialized: unexpected error code ", err
123 if(err /= 0)
goto 100
126 print *,
"ERROR detected in eiram_test_load: "
127 print *,
" unexpected number of loaded reactions for HYDHEL"
128 print *,
" expected ",208,
" loaded ",n
133 if(err /= 0)
goto 100
136 print *,
"ERROR detected in eiram_test_load: "
137 print *,
" unexpected number of loaded reactions for HYDHELvk"
138 print *,
" expected ",197,
" loaded ",n
143 if(err /= 0)
goto 100
146 print *,
"ERROR detected in eiram_test_load: "
147 print *,
" unexpected number of loaded reactions for AMJUELvk"
148 print *,
" expected ",207,
" loaded ",n
153 if(err /= 0)
goto 100
156 print *,
"ERROR detected in eiram_test_load: "
157 print *,
" unexpected number of loaded reactions for AMJUEL"
158 print *,
" expected ",269,
" loaded ",n
163 if(err /= 0)
goto 100
166 print *,
"ERROR detected in eiram_test_load: "
167 print *,
" unexpected number of loaded reactions for METHANE"
168 print *,
" expected ",91,
" loaded ",n
173 if(err /= 0)
goto 100
176 print *,
"ERROR detected in eiram_test_load: "
177 print *,
" unexpected number of loaded reactions for H2VIBR"
178 print *,
" expected ",112,
" loaded ",n
183 if(err /= 0)
goto 100
186 print *,
"ERROR detected in eiram_test_load: "
187 print *,
" unexpected number of loaded reactions for METHANEvk"
188 print *,
" expected ",64,
" loaded ",n
192 if(err /= 0)
goto 100
195 print *,
"ERROR detected in eiram_test_load: "
196 print *,
" unexpected number of loaded reactions for H2VIBRvk"
197 print *,
" expected ",161,
" loaded ",n
202 if(err /= 0)
goto 100
207 100 print *,
"ERROR in eiram_test_load: unexpected error code ", err
215 real(kind=EIRAM_DP) :: tmp(1),b(9,1)
218 if(err /= 0)
goto 200
220 if(err /= 100)
goto 200
222 if(err /= 100)
goto 200
224 if(err /= 100)
goto 200
226 if(err /= 100)
goto 200
228 if(err /= 100)
goto 200
230 if(err /= 100)
goto 200
232 if(err /= 0)
goto 200
235 200 print *,
"ERROR in eiram_test_wrong_ids: unexpected error code ", err
245 if(err /= 0)
goto 300
247 if(err /= 110)
goto 300
249 if(err /= 110)
goto 300
251 if(err /= 110)
goto 300
253 if(err /= 110)
goto 300
255 if(err /= 0 .or. id < 1)
goto 300
257 if(err /= 0)
goto 300
260 300 print *,
"ERROR in eiram_test_unknown_reaction: unexpected error code ", err
269 real(eiram_dp) :: tmp(1),b(9,1)
272 if(err /= 0)
goto 100
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
278 if(err /= 120)
goto 100
280 if(err /= 0)
goto 100
282 if(err /= 130)
goto 100
284 if(err /= 0)
goto 100
287 100 print *,
"ERROR in eiram_test_wrong_type: unexpected error code ", err
295 real(eiram_dp) :: tmp(3),b(8,3),x1(2),x2(1),x(3),xx(1)
298 if(err /= 0)
goto 100
300 if(err /= 100)
goto 100
302 if(err /= 100)
goto 100
305 if(err /= 100)
goto 100
307 if(err /= 100)
goto 100
309 if(err /= 100)
goto 100
311 if(err /= 100)
goto 100
313 if(err /= 100)
goto 100
315 if(err /= 0)
goto 100
318 100 print *,
"ERROR in eiram_test_wrong_length: unexpected error code ", err
325 integer :: reactionId, r, err
326 real(EIRAM_DP) :: calculatedValues(
n_energy)
327 logical,
dimension(N_ENERGY) :: passed
335 if(err /= 0)
goto 1000
337 if(err /= 0)
goto 1000
339 if(err /= 0)
goto 1000
343 if(err /= 0)
goto 1000
346 if(err /= 0)
goto 1000
349 if(err /= 0)
goto 1000
353 if(.not.all(passed))
goto 1001
360 1000 print *,
"ERROR in eiram_test_calculation: unexpected err code ", err
363 1001 print *,
"ERROR in eiram_test_calculation: calculated values do not match pre-calculated values"
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)
379 if(err /= 0)
goto 100
382 if(err /= 0)
goto 100
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
389 if(err /= 0)
goto 100
391 if(err /= 0)
goto 100
396 passed = ispassed(y1,y2)
397 call printfailed(y1,y2, passed)
398 if(.not.all(passed))
goto 101
404 100 print *,
"ERROR in eiram_test_calc12: unexpected err code ", err
407 101 print *,
"ERROR in eiram_test_calc12: mismatch between eiram_calc2 and eiram_calc12"
420 if(err /= 0)
goto 100
422 if(err /= 0)
goto 100
424 if(err /= 0)
goto 100
427 if(err /= 0)
goto 100
432 deallocate(
data(i)%creac,stat=err)
433 if(err /= 0)
goto 100
435 deallocate(
data,stat=err)
436 if(err /= 0)
goto 100
442 100 print *,
"ERROR in eiram_test_image: unexpected err code ", err
450 logical elemental function ispassed(expected, calculated)
451 real(kind=EIRAM_DP),
intent(in) :: expected, calculated
453 real(kind=EIRAM_DP) :: eps
454 eps=10.*tiny(expected)
455 ispassed = abs(calculated - expected) <
rel_tolerance*expected + eps
456 end function ispassed
462 subroutine printfailed(expected, calculated, passed)
463 real(kind=EIRAM_DP),
dimension(:),
intent(in) :: expected, calculated
464 logical,
dimension(size(expected)),
intent(in) :: passed
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),
"%"
472 end subroutine printfailed
493 print *,
"EIRAM_TEST COMPLETED"
character(6), dimension(n_reactions), parameter types
real(eiram_dp), dimension(n_energy, n_reactions), parameter reference_values
Reference values for regression tests in eiram_test_calculation.
integer, public eiram_unit
Unit to which messages are written.
logical function, public eiram_test_load()
Technical test which shows that expected number of reactions is loaded from each input file...
subroutine, public eiram_load(filePath, fileName, err)
Initialization of the module from input files (data sets)
character(9), dimension(n_reactions), parameter files
logical function, public eiram_test_wrong_file()
Test for correct error codes if the input file does not exist or is malformed.
integer, parameter n_reactions
subroutine, public eiram_deallocate(err)
Deallocate dynamic arrays used by this module.
logical function, public eiram_test_wrong_ids()
Test for correct error codes if reaction ID is invalid.
subroutine, public eiram_get_order(N, M, Id, err)
Return order of the polynomial for both variables.
real(eiram_dp), dimension(n_reactions), parameter x1
external, public eiram_fit
real(eiram_dp), dimension(n_energy), parameter energy
real(eiram_dp), parameter rel_tolerance
Maximum relative error, parameter which is used to compare two values.
logical function, public eiram_test_image()
Technical test of eiram_create_image.
character(*), parameter data_file_path
integer function, public eiram_get_id(fileName, reactionType, reactionIndex, err)
Return the ID-index of the given reaction in the arrays of the module.
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...
logical function, public eiram_test_unknown_reaction()
Test for correct error code when querying id for an unknown reaction.
logical function, public eiram_test_calculation()
Regression tests: compare calculated values with references.
integer, public eiram_nreact
current number of loaded reactions
subroutine, public eiram_calc12(B, Id, lnX, err)
Reduce double polynomial fit to single polynomials for given values of the second variable...
logical function, public eiram_test_calc12()
Regression test for subroutines _calc12 and _get_order compare _calc12 with subsequent call of _fit w...
logical function, public eiram_test_used_uninitialized()
Test for correct error codes if eiram is used without initialization.
subroutine, public eiram_calc2(Y, Id, LnX1, LnX2, err)
Calculate double polynomial fit.
character(8), dimension(n_reactions), parameter indices
logical function, public eiram_test_wrong_size()
Test for correct error codes in case of mismatch of the array lengths.
integer, parameter n_energy
subroutine, public eiram_create_image(data, err)
Create a copy (image) of the reactions array stored in the module.
subroutine, public eiram_calc1(Y, Id, lnX, err)
Calculate single polynomial fit.