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.